mirror of
https://github.com/KevinMidboe/linguist.git
synced 2025-10-29 17:50:22 +00:00
Merge pull request #1085 from github/pr-826-updated
Add Frege Language, part deux (replaces #826)
This commit is contained in:
Rick Bradley
@@ -626,6 +626,12 @@ Forth:
|
|||||||
extensions:
|
extensions:
|
||||||
- .4th
|
- .4th
|
||||||
|
|
||||||
|
Frege:
|
||||||
|
type: programming
|
||||||
|
color: "#00cafe"
|
||||||
|
lexer: Haskell
|
||||||
|
primary_extension: .fr
|
||||||
|
|
||||||
Game Maker Language:
|
Game Maker Language:
|
||||||
type: programming
|
type: programming
|
||||||
lexer: JavaScript
|
lexer: JavaScript
|
||||||
|
|||||||
@@ -132,6 +132,9 @@
|
|||||||
".forth",
|
".forth",
|
||||||
".fth"
|
".fth"
|
||||||
],
|
],
|
||||||
|
"Frege": [
|
||||||
|
".fr"
|
||||||
|
],
|
||||||
"Game Maker Language": [
|
"Game Maker Language": [
|
||||||
".gml"
|
".gml"
|
||||||
],
|
],
|
||||||
@@ -581,8 +584,8 @@
|
|||||||
".gemrc"
|
".gemrc"
|
||||||
]
|
]
|
||||||
},
|
},
|
||||||
"tokens_total": 471133,
|
"tokens_total": 476697,
|
||||||
"languages_total": 584,
|
"languages_total": 588,
|
||||||
"tokens": {
|
"tokens": {
|
||||||
"ABAP": {
|
"ABAP": {
|
||||||
"*/**": 1,
|
"*/**": 1,
|
||||||
@@ -18140,6 +18143,787 @@
|
|||||||
"/cell": 2,
|
"/cell": 2,
|
||||||
"cell": 2
|
"cell": 2
|
||||||
},
|
},
|
||||||
|
"Frege": {
|
||||||
|
"module": 2,
|
||||||
|
"examples.CommandLineClock": 1,
|
||||||
|
"where": 39,
|
||||||
|
"data": 3,
|
||||||
|
"Date": 5,
|
||||||
|
"native": 4,
|
||||||
|
"java.util.Date": 1,
|
||||||
|
"new": 9,
|
||||||
|
"(": 339,
|
||||||
|
")": 345,
|
||||||
|
"-": 730,
|
||||||
|
"IO": 13,
|
||||||
|
"MutableIO": 1,
|
||||||
|
"toString": 2,
|
||||||
|
"Mutable": 1,
|
||||||
|
"s": 21,
|
||||||
|
"ST": 1,
|
||||||
|
"String": 9,
|
||||||
|
"d.toString": 1,
|
||||||
|
"action": 2,
|
||||||
|
"to": 13,
|
||||||
|
"give": 2,
|
||||||
|
"us": 1,
|
||||||
|
"the": 20,
|
||||||
|
"current": 4,
|
||||||
|
"time": 1,
|
||||||
|
"as": 33,
|
||||||
|
"do": 38,
|
||||||
|
"d": 3,
|
||||||
|
"<->": 35,
|
||||||
|
"java": 5,
|
||||||
|
"lang": 2,
|
||||||
|
"Thread": 2,
|
||||||
|
"sleep": 4,
|
||||||
|
"takes": 1,
|
||||||
|
"a": 99,
|
||||||
|
"long": 4,
|
||||||
|
"and": 14,
|
||||||
|
"returns": 2,
|
||||||
|
"nothing": 2,
|
||||||
|
"but": 2,
|
||||||
|
"may": 1,
|
||||||
|
"throw": 1,
|
||||||
|
"an": 6,
|
||||||
|
"InterruptedException": 4,
|
||||||
|
"This": 2,
|
||||||
|
"is": 24,
|
||||||
|
"without": 1,
|
||||||
|
"doubt": 1,
|
||||||
|
"public": 1,
|
||||||
|
"static": 1,
|
||||||
|
"void": 2,
|
||||||
|
"millis": 1,
|
||||||
|
"throws": 4,
|
||||||
|
"Encoded": 1,
|
||||||
|
"in": 22,
|
||||||
|
"Frege": 1,
|
||||||
|
"argument": 1,
|
||||||
|
"type": 8,
|
||||||
|
"Long": 3,
|
||||||
|
"result": 11,
|
||||||
|
"does": 2,
|
||||||
|
"defined": 1,
|
||||||
|
"frege": 1,
|
||||||
|
"Lang": 1,
|
||||||
|
"main": 11,
|
||||||
|
"args": 2,
|
||||||
|
"forever": 1,
|
||||||
|
"print": 25,
|
||||||
|
"stdout.flush": 1,
|
||||||
|
"Thread.sleep": 4,
|
||||||
|
"examples.Concurrent": 1,
|
||||||
|
"import": 7,
|
||||||
|
"System.Random": 1,
|
||||||
|
"Java.Net": 1,
|
||||||
|
"URL": 2,
|
||||||
|
"Control.Concurrent": 1,
|
||||||
|
"C": 6,
|
||||||
|
"main2": 1,
|
||||||
|
"m": 2,
|
||||||
|
"<": 84,
|
||||||
|
"newEmptyMVar": 1,
|
||||||
|
"forkIO": 11,
|
||||||
|
"m.put": 3,
|
||||||
|
"replicateM_": 3,
|
||||||
|
"c": 33,
|
||||||
|
"m.take": 1,
|
||||||
|
"println": 25,
|
||||||
|
"example1": 1,
|
||||||
|
"putChar": 2,
|
||||||
|
"example2": 2,
|
||||||
|
"getLine": 2,
|
||||||
|
"case": 6,
|
||||||
|
"of": 32,
|
||||||
|
"Right": 6,
|
||||||
|
"n": 38,
|
||||||
|
"setReminder": 3,
|
||||||
|
"Left": 5,
|
||||||
|
"_": 60,
|
||||||
|
"+": 200,
|
||||||
|
"show": 24,
|
||||||
|
"L*n": 1,
|
||||||
|
"table": 1,
|
||||||
|
"mainPhil": 2,
|
||||||
|
"[": 120,
|
||||||
|
"fork1": 3,
|
||||||
|
"fork2": 3,
|
||||||
|
"fork3": 3,
|
||||||
|
"fork4": 3,
|
||||||
|
"fork5": 3,
|
||||||
|
"]": 116,
|
||||||
|
"mapM": 3,
|
||||||
|
"MVar": 3,
|
||||||
|
"1": 2,
|
||||||
|
"5": 1,
|
||||||
|
"philosopher": 7,
|
||||||
|
"Kant": 1,
|
||||||
|
"Locke": 1,
|
||||||
|
"Wittgenstein": 1,
|
||||||
|
"Nozick": 1,
|
||||||
|
"Mises": 1,
|
||||||
|
"return": 17,
|
||||||
|
"Int": 6,
|
||||||
|
"me": 13,
|
||||||
|
"left": 4,
|
||||||
|
"right": 4,
|
||||||
|
"g": 4,
|
||||||
|
"Random.newStdGen": 1,
|
||||||
|
"let": 8,
|
||||||
|
"phil": 4,
|
||||||
|
"tT": 2,
|
||||||
|
"g1": 2,
|
||||||
|
"Random.randomR": 2,
|
||||||
|
"L": 6,
|
||||||
|
"eT": 2,
|
||||||
|
"g2": 3,
|
||||||
|
"thinkTime": 3,
|
||||||
|
"*": 5,
|
||||||
|
"eatTime": 3,
|
||||||
|
"fl": 4,
|
||||||
|
"left.take": 1,
|
||||||
|
"rFork": 2,
|
||||||
|
"poll": 1,
|
||||||
|
"Just": 2,
|
||||||
|
"fr": 3,
|
||||||
|
"right.put": 1,
|
||||||
|
"left.put": 2,
|
||||||
|
"table.notifyAll": 2,
|
||||||
|
"Nothing": 2,
|
||||||
|
"table.wait": 1,
|
||||||
|
"inter": 3,
|
||||||
|
"catch": 2,
|
||||||
|
"getURL": 4,
|
||||||
|
"xx": 2,
|
||||||
|
"url": 1,
|
||||||
|
"URL.new": 1,
|
||||||
|
"con": 3,
|
||||||
|
"url.openConnection": 1,
|
||||||
|
"con.connect": 1,
|
||||||
|
"con.getInputStream": 1,
|
||||||
|
"typ": 5,
|
||||||
|
"con.getContentType": 1,
|
||||||
|
"stderr.println": 3,
|
||||||
|
"ir": 2,
|
||||||
|
"InputStreamReader.new": 2,
|
||||||
|
"fromMaybe": 1,
|
||||||
|
"charset": 2,
|
||||||
|
"unsupportedEncoding": 3,
|
||||||
|
"br": 4,
|
||||||
|
"BufferedReader": 1,
|
||||||
|
"getLines": 1,
|
||||||
|
"InputStream": 1,
|
||||||
|
"UnsupportedEncodingException": 1,
|
||||||
|
"InputStreamReader": 1,
|
||||||
|
"x": 45,
|
||||||
|
"x.catched": 1,
|
||||||
|
"ctyp": 2,
|
||||||
|
"charset=": 1,
|
||||||
|
"m.group": 1,
|
||||||
|
"SomeException": 2,
|
||||||
|
"Throwable": 1,
|
||||||
|
"m1": 1,
|
||||||
|
"MVar.newEmpty": 3,
|
||||||
|
"m2": 1,
|
||||||
|
"m3": 2,
|
||||||
|
"r": 7,
|
||||||
|
"catchAll": 3,
|
||||||
|
".": 41,
|
||||||
|
"m1.put": 1,
|
||||||
|
"m2.put": 1,
|
||||||
|
"m3.put": 1,
|
||||||
|
"r1": 2,
|
||||||
|
"m1.take": 1,
|
||||||
|
"r2": 3,
|
||||||
|
"m2.take": 1,
|
||||||
|
"r3": 3,
|
||||||
|
"take": 13,
|
||||||
|
"ss": 8,
|
||||||
|
"mapM_": 5,
|
||||||
|
"putStrLn": 2,
|
||||||
|
"|": 62,
|
||||||
|
"x.getClass.getName": 1,
|
||||||
|
"y": 15,
|
||||||
|
"sum": 2,
|
||||||
|
"map": 49,
|
||||||
|
"length": 20,
|
||||||
|
"package": 2,
|
||||||
|
"examples.Sudoku": 1,
|
||||||
|
"Data.TreeMap": 1,
|
||||||
|
"Tree": 4,
|
||||||
|
"keys": 2,
|
||||||
|
"Data.List": 1,
|
||||||
|
"DL": 1,
|
||||||
|
"hiding": 1,
|
||||||
|
"find": 20,
|
||||||
|
"union": 10,
|
||||||
|
"Element": 6,
|
||||||
|
"Zelle": 8,
|
||||||
|
"set": 4,
|
||||||
|
"candidates": 18,
|
||||||
|
"Position": 22,
|
||||||
|
"Feld": 3,
|
||||||
|
"Brett": 13,
|
||||||
|
"for": 25,
|
||||||
|
"assumptions": 10,
|
||||||
|
"conclusions": 2,
|
||||||
|
"Assumption": 21,
|
||||||
|
"ISNOT": 14,
|
||||||
|
"IS": 16,
|
||||||
|
"derive": 2,
|
||||||
|
"Eq": 1,
|
||||||
|
"Ord": 1,
|
||||||
|
"instance": 1,
|
||||||
|
"Show": 1,
|
||||||
|
"p": 72,
|
||||||
|
"e": 15,
|
||||||
|
"pname": 10,
|
||||||
|
"e.show": 2,
|
||||||
|
"showcs": 5,
|
||||||
|
"cs": 27,
|
||||||
|
"joined": 4,
|
||||||
|
"Assumption.show": 1,
|
||||||
|
"elements": 12,
|
||||||
|
"all": 22,
|
||||||
|
"possible": 2,
|
||||||
|
"..": 1,
|
||||||
|
"positions": 16,
|
||||||
|
"rowstarts": 4,
|
||||||
|
"row": 20,
|
||||||
|
"starting": 3,
|
||||||
|
"colstarts": 3,
|
||||||
|
"column": 2,
|
||||||
|
"boxstarts": 3,
|
||||||
|
"box": 15,
|
||||||
|
"boxmuster": 3,
|
||||||
|
"pattern": 1,
|
||||||
|
"by": 3,
|
||||||
|
"adding": 1,
|
||||||
|
"upper": 2,
|
||||||
|
"position": 9,
|
||||||
|
"results": 1,
|
||||||
|
"real": 1,
|
||||||
|
"extract": 2,
|
||||||
|
"field": 9,
|
||||||
|
"getf": 16,
|
||||||
|
"f": 19,
|
||||||
|
"fs": 22,
|
||||||
|
"fst": 9,
|
||||||
|
"otherwise": 8,
|
||||||
|
"cell": 24,
|
||||||
|
"getc": 12,
|
||||||
|
"b": 113,
|
||||||
|
"snd": 20,
|
||||||
|
"compute": 5,
|
||||||
|
"list": 7,
|
||||||
|
"that": 18,
|
||||||
|
"belong": 3,
|
||||||
|
"same": 8,
|
||||||
|
"given": 3,
|
||||||
|
"z..": 1,
|
||||||
|
"z": 12,
|
||||||
|
"quot": 1,
|
||||||
|
"col": 17,
|
||||||
|
"mod": 3,
|
||||||
|
"ri": 2,
|
||||||
|
"div": 3,
|
||||||
|
"or": 15,
|
||||||
|
"depending": 1,
|
||||||
|
"on": 4,
|
||||||
|
"ci": 3,
|
||||||
|
"index": 3,
|
||||||
|
"middle": 2,
|
||||||
|
"check": 2,
|
||||||
|
"if": 5,
|
||||||
|
"candidate": 10,
|
||||||
|
"has": 2,
|
||||||
|
"exactly": 2,
|
||||||
|
"one": 2,
|
||||||
|
"member": 1,
|
||||||
|
"i.e.": 1,
|
||||||
|
"been": 1,
|
||||||
|
"solved": 1,
|
||||||
|
"single": 9,
|
||||||
|
"Bool": 2,
|
||||||
|
"true": 16,
|
||||||
|
"false": 13,
|
||||||
|
"unsolved": 10,
|
||||||
|
"rows": 4,
|
||||||
|
"cols": 6,
|
||||||
|
"boxes": 1,
|
||||||
|
"allrows": 8,
|
||||||
|
"allcols": 5,
|
||||||
|
"allboxs": 5,
|
||||||
|
"allrcb": 5,
|
||||||
|
"zip": 7,
|
||||||
|
"repeat": 3,
|
||||||
|
"containers": 6,
|
||||||
|
"PRINTING": 1,
|
||||||
|
"printable": 1,
|
||||||
|
"coordinate": 1,
|
||||||
|
"a1": 3,
|
||||||
|
"lower": 1,
|
||||||
|
"i9": 1,
|
||||||
|
"packed": 1,
|
||||||
|
"chr": 2,
|
||||||
|
"ord": 6,
|
||||||
|
"board": 41,
|
||||||
|
"printb": 4,
|
||||||
|
"p1line": 2,
|
||||||
|
"pfld": 4,
|
||||||
|
"line": 2,
|
||||||
|
"brief": 1,
|
||||||
|
"no": 4,
|
||||||
|
"some": 2,
|
||||||
|
"zs": 1,
|
||||||
|
"initial/final": 1,
|
||||||
|
"msg": 6,
|
||||||
|
"res012": 2,
|
||||||
|
"concatMap": 1,
|
||||||
|
"a*100": 1,
|
||||||
|
"b*10": 1,
|
||||||
|
"BOARD": 1,
|
||||||
|
"ALTERATION": 1,
|
||||||
|
"ACTIONS": 1,
|
||||||
|
"message": 1,
|
||||||
|
"about": 1,
|
||||||
|
"what": 1,
|
||||||
|
"done": 1,
|
||||||
|
"turnoff1": 3,
|
||||||
|
"i": 16,
|
||||||
|
"off": 11,
|
||||||
|
"nc": 7,
|
||||||
|
"head": 19,
|
||||||
|
"newb": 7,
|
||||||
|
"filter": 26,
|
||||||
|
"notElem": 7,
|
||||||
|
"turnoff": 11,
|
||||||
|
"turnoffh": 1,
|
||||||
|
"ps": 8,
|
||||||
|
"foldM": 2,
|
||||||
|
"toh": 2,
|
||||||
|
"setto": 3,
|
||||||
|
"cname": 4,
|
||||||
|
"nf": 2,
|
||||||
|
"SOLVING": 1,
|
||||||
|
"STRATEGIES": 1,
|
||||||
|
"reduce": 3,
|
||||||
|
"sets": 2,
|
||||||
|
"contains": 1,
|
||||||
|
"numbers": 1,
|
||||||
|
"already": 1,
|
||||||
|
"finds": 1,
|
||||||
|
"logs": 1,
|
||||||
|
"NAKED": 5,
|
||||||
|
"SINGLEs": 1,
|
||||||
|
"passing.": 1,
|
||||||
|
"sss": 3,
|
||||||
|
"each": 2,
|
||||||
|
"with": 15,
|
||||||
|
"more": 2,
|
||||||
|
"than": 2,
|
||||||
|
"fields": 6,
|
||||||
|
"are": 6,
|
||||||
|
"rcb": 16,
|
||||||
|
"elem": 16,
|
||||||
|
"collect": 1,
|
||||||
|
"remove": 3,
|
||||||
|
"from": 7,
|
||||||
|
"look": 10,
|
||||||
|
"number": 4,
|
||||||
|
"appears": 1,
|
||||||
|
"container": 9,
|
||||||
|
"this": 2,
|
||||||
|
"can": 9,
|
||||||
|
"go": 1,
|
||||||
|
"other": 2,
|
||||||
|
"place": 1,
|
||||||
|
"HIDDEN": 6,
|
||||||
|
"SINGLE": 1,
|
||||||
|
"hiddenSingle": 2,
|
||||||
|
"select": 1,
|
||||||
|
"containername": 1,
|
||||||
|
"FOR": 11,
|
||||||
|
"IN": 9,
|
||||||
|
"occurs": 5,
|
||||||
|
"PAIRS": 8,
|
||||||
|
"TRIPLES": 8,
|
||||||
|
"QUADS": 2,
|
||||||
|
"nakedPair": 4,
|
||||||
|
"t": 14,
|
||||||
|
"nm": 6,
|
||||||
|
"SELECT": 3,
|
||||||
|
"pos": 5,
|
||||||
|
"tuple": 2,
|
||||||
|
"name": 2,
|
||||||
|
"//": 8,
|
||||||
|
"u": 6,
|
||||||
|
"fold": 7,
|
||||||
|
"non": 2,
|
||||||
|
"outof": 6,
|
||||||
|
"tuples": 2,
|
||||||
|
"hit": 7,
|
||||||
|
"subset": 3,
|
||||||
|
"any": 3,
|
||||||
|
"hiddenPair": 4,
|
||||||
|
"minus": 2,
|
||||||
|
"uniq": 4,
|
||||||
|
"sort": 4,
|
||||||
|
"common": 4,
|
||||||
|
"bs": 7,
|
||||||
|
"undefined": 1,
|
||||||
|
"cannot": 1,
|
||||||
|
"happen": 1,
|
||||||
|
"because": 1,
|
||||||
|
"either": 1,
|
||||||
|
"empty": 4,
|
||||||
|
"not": 5,
|
||||||
|
"intersectionlist": 2,
|
||||||
|
"intersections": 2,
|
||||||
|
"reason": 8,
|
||||||
|
"reson": 1,
|
||||||
|
"cpos": 7,
|
||||||
|
"WHERE": 2,
|
||||||
|
"tail": 2,
|
||||||
|
"intersection": 1,
|
||||||
|
"we": 5,
|
||||||
|
"occurences": 1,
|
||||||
|
"XY": 2,
|
||||||
|
"Wing": 2,
|
||||||
|
"there": 6,
|
||||||
|
"exists": 6,
|
||||||
|
"A": 7,
|
||||||
|
"X": 5,
|
||||||
|
"Y": 4,
|
||||||
|
"B": 5,
|
||||||
|
"Z": 6,
|
||||||
|
"shares": 2,
|
||||||
|
"reasoning": 1,
|
||||||
|
"will": 4,
|
||||||
|
"be": 9,
|
||||||
|
"since": 1,
|
||||||
|
"indeed": 1,
|
||||||
|
"thus": 1,
|
||||||
|
"see": 1,
|
||||||
|
"xyWing": 2,
|
||||||
|
"rcba": 4,
|
||||||
|
"share": 1,
|
||||||
|
"b1": 11,
|
||||||
|
"b2": 10,
|
||||||
|
"&&": 9,
|
||||||
|
"||": 2,
|
||||||
|
"then": 1,
|
||||||
|
"else": 1,
|
||||||
|
"c1": 4,
|
||||||
|
"c2": 3,
|
||||||
|
"N": 5,
|
||||||
|
"Fish": 1,
|
||||||
|
"Swordfish": 1,
|
||||||
|
"Jellyfish": 1,
|
||||||
|
"When": 2,
|
||||||
|
"particular": 1,
|
||||||
|
"digit": 1,
|
||||||
|
"located": 2,
|
||||||
|
"only": 1,
|
||||||
|
"columns": 2,
|
||||||
|
"eliminate": 1,
|
||||||
|
"those": 2,
|
||||||
|
"which": 2,
|
||||||
|
"fish": 7,
|
||||||
|
"fishname": 5,
|
||||||
|
"rset": 4,
|
||||||
|
"certain": 1,
|
||||||
|
"rflds": 2,
|
||||||
|
"rowset": 1,
|
||||||
|
"colss": 3,
|
||||||
|
"must": 4,
|
||||||
|
"appear": 1,
|
||||||
|
"at": 3,
|
||||||
|
"least": 3,
|
||||||
|
"cstart": 2,
|
||||||
|
"immediate": 1,
|
||||||
|
"consequences": 6,
|
||||||
|
"assumption": 8,
|
||||||
|
"form": 1,
|
||||||
|
"conseq": 3,
|
||||||
|
"cp": 3,
|
||||||
|
"two": 1,
|
||||||
|
"contradict": 2,
|
||||||
|
"contradicts": 7,
|
||||||
|
"get": 3,
|
||||||
|
"aPos": 5,
|
||||||
|
"List": 1,
|
||||||
|
"turned": 1,
|
||||||
|
"when": 2,
|
||||||
|
"true/false": 1,
|
||||||
|
"toClear": 7,
|
||||||
|
"whose": 1,
|
||||||
|
"implications": 5,
|
||||||
|
"themself": 1,
|
||||||
|
"chain": 2,
|
||||||
|
"paths": 12,
|
||||||
|
"solution": 6,
|
||||||
|
"reverse": 4,
|
||||||
|
"css": 7,
|
||||||
|
"yields": 1,
|
||||||
|
"contradictory": 1,
|
||||||
|
"chainContra": 2,
|
||||||
|
"pro": 7,
|
||||||
|
"contra": 4,
|
||||||
|
"ALL": 2,
|
||||||
|
"conlusions": 1,
|
||||||
|
"uniqBy": 2,
|
||||||
|
"using": 2,
|
||||||
|
"sortBy": 2,
|
||||||
|
"comparing": 2,
|
||||||
|
"conslusion": 1,
|
||||||
|
"chains": 4,
|
||||||
|
"LET": 1,
|
||||||
|
"BE": 1,
|
||||||
|
"final": 2,
|
||||||
|
"conclusion": 4,
|
||||||
|
"THE": 1,
|
||||||
|
"FIRST": 1,
|
||||||
|
"implication": 2,
|
||||||
|
"ai": 2,
|
||||||
|
"so": 1,
|
||||||
|
"a0": 1,
|
||||||
|
"OR": 7,
|
||||||
|
"a2": 2,
|
||||||
|
"...": 2,
|
||||||
|
"IMPLIES": 1,
|
||||||
|
"For": 2,
|
||||||
|
"cells": 1,
|
||||||
|
"pi": 2,
|
||||||
|
"have": 1,
|
||||||
|
"construct": 2,
|
||||||
|
"p0": 1,
|
||||||
|
"p1": 1,
|
||||||
|
"c0": 1,
|
||||||
|
"cellRegionChain": 2,
|
||||||
|
"os": 3,
|
||||||
|
"cellas": 2,
|
||||||
|
"regionas": 2,
|
||||||
|
"iss": 3,
|
||||||
|
"ass": 2,
|
||||||
|
"first": 2,
|
||||||
|
"candidates@": 1,
|
||||||
|
"region": 2,
|
||||||
|
"oss": 2,
|
||||||
|
"Liste": 1,
|
||||||
|
"aller": 1,
|
||||||
|
"Annahmen": 1,
|
||||||
|
"ein": 1,
|
||||||
|
"bestimmtes": 1,
|
||||||
|
"acstree": 3,
|
||||||
|
"Tree.fromList": 1,
|
||||||
|
"bypass": 1,
|
||||||
|
"maybe": 1,
|
||||||
|
"tree": 1,
|
||||||
|
"lookup": 2,
|
||||||
|
"error": 1,
|
||||||
|
"performance": 1,
|
||||||
|
"resons": 1,
|
||||||
|
"confine": 1,
|
||||||
|
"ourselves": 1,
|
||||||
|
"20": 1,
|
||||||
|
"per": 1,
|
||||||
|
"mkPaths": 3,
|
||||||
|
"acst": 3,
|
||||||
|
"impl": 2,
|
||||||
|
"{": 1,
|
||||||
|
"a3": 1,
|
||||||
|
"ordered": 1,
|
||||||
|
"impls": 2,
|
||||||
|
"ns": 2,
|
||||||
|
"concat": 1,
|
||||||
|
"takeUntil": 1,
|
||||||
|
"null": 1,
|
||||||
|
"iterate": 1,
|
||||||
|
"expandchain": 3,
|
||||||
|
"avoid": 1,
|
||||||
|
"loops": 1,
|
||||||
|
"uni": 3,
|
||||||
|
"SOLVE": 1,
|
||||||
|
"SUDOKU": 1,
|
||||||
|
"Apply": 1,
|
||||||
|
"available": 1,
|
||||||
|
"strategies": 1,
|
||||||
|
"until": 1,
|
||||||
|
"changes": 1,
|
||||||
|
"anymore": 1,
|
||||||
|
"Strategy": 1,
|
||||||
|
"functions": 2,
|
||||||
|
"supposed": 1,
|
||||||
|
"applied": 1,
|
||||||
|
"changed": 1,
|
||||||
|
"board.": 1,
|
||||||
|
"strategy": 2,
|
||||||
|
"anything": 1,
|
||||||
|
"alter": 1,
|
||||||
|
"it": 2,
|
||||||
|
"next": 1,
|
||||||
|
"tried.": 1,
|
||||||
|
"solve": 19,
|
||||||
|
"res@": 16,
|
||||||
|
"apply": 17,
|
||||||
|
"res": 16,
|
||||||
|
"smallest": 1,
|
||||||
|
"comment": 16,
|
||||||
|
"SINGLES": 1,
|
||||||
|
"locked": 1,
|
||||||
|
"2": 3,
|
||||||
|
"QUADRUPELS": 6,
|
||||||
|
"3": 3,
|
||||||
|
"4": 3,
|
||||||
|
"WINGS": 1,
|
||||||
|
"FISH": 3,
|
||||||
|
"pcomment": 2,
|
||||||
|
"9": 5,
|
||||||
|
"forcing": 1,
|
||||||
|
"allow": 1,
|
||||||
|
"infer": 1,
|
||||||
|
"both": 1,
|
||||||
|
"brd": 2,
|
||||||
|
"com": 5,
|
||||||
|
"stderr": 3,
|
||||||
|
"<<": 4,
|
||||||
|
"log": 1,
|
||||||
|
"turn": 1,
|
||||||
|
"string": 3,
|
||||||
|
"into": 1,
|
||||||
|
"mkrow": 2,
|
||||||
|
"mkrow1": 2,
|
||||||
|
"xs": 4,
|
||||||
|
"make": 1,
|
||||||
|
"sure": 1,
|
||||||
|
"unpacked": 2,
|
||||||
|
"<=>": 1,
|
||||||
|
"0": 2,
|
||||||
|
"ignored": 1,
|
||||||
|
"h": 1,
|
||||||
|
"help": 1,
|
||||||
|
"usage": 1,
|
||||||
|
"Sudoku": 2,
|
||||||
|
"file": 4,
|
||||||
|
"81": 3,
|
||||||
|
"char": 1,
|
||||||
|
"consisting": 1,
|
||||||
|
"digits": 2,
|
||||||
|
"One": 1,
|
||||||
|
"such": 1,
|
||||||
|
"going": 1,
|
||||||
|
"http": 3,
|
||||||
|
"www": 1,
|
||||||
|
"sudokuoftheday": 1,
|
||||||
|
"pages": 1,
|
||||||
|
"o": 1,
|
||||||
|
"php": 1,
|
||||||
|
"click": 1,
|
||||||
|
"puzzle": 1,
|
||||||
|
"open": 1,
|
||||||
|
"tab": 1,
|
||||||
|
"Copy": 1,
|
||||||
|
"address": 1,
|
||||||
|
"your": 1,
|
||||||
|
"browser": 1,
|
||||||
|
"There": 1,
|
||||||
|
"also": 1,
|
||||||
|
"hard": 1,
|
||||||
|
"sudokus": 1,
|
||||||
|
"examples": 1,
|
||||||
|
"top95": 1,
|
||||||
|
"txt": 1,
|
||||||
|
"W": 1,
|
||||||
|
"felder": 2,
|
||||||
|
"decode": 4,
|
||||||
|
"files": 2,
|
||||||
|
"forM_": 1,
|
||||||
|
"sudoku": 2,
|
||||||
|
"openReader": 1,
|
||||||
|
"lines": 2,
|
||||||
|
"BufferedReader.getLines": 1,
|
||||||
|
"process": 5,
|
||||||
|
"candi": 2,
|
||||||
|
"consider": 3,
|
||||||
|
"acht": 4,
|
||||||
|
"neun": 2,
|
||||||
|
"examples.SwingExamples": 1,
|
||||||
|
"Java.Awt": 1,
|
||||||
|
"ActionListener": 2,
|
||||||
|
"Java.Swing": 1,
|
||||||
|
"rs": 2,
|
||||||
|
"Runnable.new": 1,
|
||||||
|
"helloWorldGUI": 2,
|
||||||
|
"buttonDemoGUI": 2,
|
||||||
|
"celsiusConverterGUI": 2,
|
||||||
|
"invokeLater": 1,
|
||||||
|
"tempTextField": 2,
|
||||||
|
"JTextField.new": 1,
|
||||||
|
"celsiusLabel": 1,
|
||||||
|
"JLabel.new": 3,
|
||||||
|
"convertButton": 1,
|
||||||
|
"JButton.new": 3,
|
||||||
|
"fahrenheitLabel": 1,
|
||||||
|
"frame": 3,
|
||||||
|
"JFrame.new": 3,
|
||||||
|
"frame.setDefaultCloseOperation": 3,
|
||||||
|
"JFrame.dispose_on_close": 3,
|
||||||
|
"frame.setTitle": 1,
|
||||||
|
"celsiusLabel.setText": 1,
|
||||||
|
"convertButton.setText": 1,
|
||||||
|
"convertButtonActionPerformed": 2,
|
||||||
|
"celsius": 3,
|
||||||
|
"getText": 1,
|
||||||
|
"double": 1,
|
||||||
|
"fahrenheitLabel.setText": 3,
|
||||||
|
"c*1.8": 1,
|
||||||
|
".long": 1,
|
||||||
|
"ActionListener.new": 2,
|
||||||
|
"convertButton.addActionListener": 1,
|
||||||
|
"contentPane": 2,
|
||||||
|
"frame.getContentPane": 2,
|
||||||
|
"layout": 2,
|
||||||
|
"GroupLayout.new": 1,
|
||||||
|
"contentPane.setLayout": 1,
|
||||||
|
"TODO": 1,
|
||||||
|
"continue": 1,
|
||||||
|
"//docs.oracle.com/javase/tutorial/displayCode.html": 1,
|
||||||
|
"code": 1,
|
||||||
|
"//docs.oracle.com/javase/tutorial/uiswing/examples/learn/CelsiusConverterProject/src/learn/CelsiusConverterGUI.java": 1,
|
||||||
|
"frame.pack": 3,
|
||||||
|
"frame.setVisible": 3,
|
||||||
|
"label": 2,
|
||||||
|
"cp.add": 1,
|
||||||
|
"newContentPane": 2,
|
||||||
|
"JPanel.new": 1,
|
||||||
|
"JButton": 4,
|
||||||
|
"b1.setVerticalTextPosition": 1,
|
||||||
|
"SwingConstants.center": 2,
|
||||||
|
"b1.setHorizontalTextPosition": 1,
|
||||||
|
"SwingConstants.leading": 2,
|
||||||
|
"b2.setVerticalTextPosition": 1,
|
||||||
|
"b2.setHorizontalTextPosition": 1,
|
||||||
|
"b3": 7,
|
||||||
|
"Enable": 1,
|
||||||
|
"button": 1,
|
||||||
|
"setVerticalTextPosition": 1,
|
||||||
|
"SwingConstants": 2,
|
||||||
|
"center": 1,
|
||||||
|
"setHorizontalTextPosition": 1,
|
||||||
|
"leading": 1,
|
||||||
|
"setEnabled": 7,
|
||||||
|
"action1": 2,
|
||||||
|
"action3": 2,
|
||||||
|
"b1.addActionListener": 1,
|
||||||
|
"b3.addActionListener": 1,
|
||||||
|
"newContentPane.add": 3,
|
||||||
|
"newContentPane.setOpaque": 1,
|
||||||
|
"frame.setContentPane": 1
|
||||||
|
},
|
||||||
"Game Maker Language": {
|
"Game Maker Language": {
|
||||||
"//draws": 1,
|
"//draws": 1,
|
||||||
"the": 62,
|
"the": 62,
|
||||||
@@ -51271,6 +52055,7 @@
|
|||||||
"Erlang": 2928,
|
"Erlang": 2928,
|
||||||
"fish": 636,
|
"fish": 636,
|
||||||
"Forth": 1516,
|
"Forth": 1516,
|
||||||
|
"Frege": 5564,
|
||||||
"Game Maker Language": 13310,
|
"Game Maker Language": 13310,
|
||||||
"GAS": 133,
|
"GAS": 133,
|
||||||
"GLSL": 3766,
|
"GLSL": 3766,
|
||||||
@@ -51424,6 +52209,7 @@
|
|||||||
"Erlang": 5,
|
"Erlang": 5,
|
||||||
"fish": 3,
|
"fish": 3,
|
||||||
"Forth": 7,
|
"Forth": 7,
|
||||||
|
"Frege": 4,
|
||||||
"Game Maker Language": 13,
|
"Game Maker Language": 13,
|
||||||
"GAS": 1,
|
"GAS": 1,
|
||||||
"GLSL": 3,
|
"GLSL": 3,
|
||||||
@@ -51539,5 +52325,5 @@
|
|||||||
"Xtend": 2,
|
"Xtend": 2,
|
||||||
"YAML": 2
|
"YAML": 2
|
||||||
},
|
},
|
||||||
"md5": "ae61e5c2d20e71a1a9df118bf8ea7a82"
|
"md5": "278ea8642dd01d246a77d63cdb053bfb"
|
||||||
}
|
}
|
||||||
44
samples/Frege/CommandLineClock.fr
Normal file
44
samples/Frege/CommandLineClock.fr
Normal file
@@ -0,0 +1,44 @@
|
|||||||
|
{--
|
||||||
|
This program displays the
|
||||||
|
current time on stdandard output
|
||||||
|
every other second.
|
||||||
|
-}
|
||||||
|
|
||||||
|
module examples.CommandLineClock where
|
||||||
|
|
||||||
|
data Date = native java.util.Date where
|
||||||
|
native new :: () -> IO (MutableIO Date) -- new Date()
|
||||||
|
native toString :: Mutable s Date -> ST s String -- d.toString()
|
||||||
|
|
||||||
|
--- 'IO' action to give us the current time as 'String'
|
||||||
|
current :: IO String
|
||||||
|
current = do
|
||||||
|
d <- Date.new ()
|
||||||
|
d.toString
|
||||||
|
|
||||||
|
{-
|
||||||
|
"java.lang.Thread.sleep" takes a "long" and
|
||||||
|
returns nothing, but may throw an InterruptedException.
|
||||||
|
This is without doubt an IO action.
|
||||||
|
|
||||||
|
public static void sleep(long millis)
|
||||||
|
throws InterruptedException
|
||||||
|
|
||||||
|
Encoded in Frege:
|
||||||
|
- argument type long Long
|
||||||
|
- result void ()
|
||||||
|
- does IO IO ()
|
||||||
|
- throws ... throws ....
|
||||||
|
|
||||||
|
-}
|
||||||
|
-- .... defined in frege.java.Lang
|
||||||
|
-- native sleep java.lang.Thread.sleep :: Long -> IO () throws InterruptedException
|
||||||
|
|
||||||
|
|
||||||
|
main args =
|
||||||
|
forever do
|
||||||
|
current >>= print
|
||||||
|
print "\r"
|
||||||
|
stdout.flush
|
||||||
|
Thread.sleep 999
|
||||||
|
|
||||||
147
samples/Frege/Concurrent.fr
Normal file
147
samples/Frege/Concurrent.fr
Normal file
@@ -0,0 +1,147 @@
|
|||||||
|
module examples.Concurrent where
|
||||||
|
|
||||||
|
import System.Random
|
||||||
|
import Java.Net (URL)
|
||||||
|
import Control.Concurrent as C
|
||||||
|
|
||||||
|
main2 args = do
|
||||||
|
m <- newEmptyMVar
|
||||||
|
forkIO do
|
||||||
|
m.put 'x'
|
||||||
|
m.put 'y'
|
||||||
|
m.put 'z'
|
||||||
|
replicateM_ 3 do
|
||||||
|
c <- m.take
|
||||||
|
print "got: "
|
||||||
|
println c
|
||||||
|
|
||||||
|
|
||||||
|
example1 = do
|
||||||
|
forkIO (replicateM_ 100000 (putChar 'a'))
|
||||||
|
replicateM_ 100000 (putChar 'b')
|
||||||
|
|
||||||
|
example2 = do
|
||||||
|
s <- getLine
|
||||||
|
case s.long of
|
||||||
|
Right n -> forkIO (setReminder n) >> example2
|
||||||
|
Left _ -> println ("exiting ...")
|
||||||
|
|
||||||
|
setReminder :: Long -> IO ()
|
||||||
|
setReminder n = do
|
||||||
|
println ("Ok, I remind you in " ++ show n ++ " seconds")
|
||||||
|
Thread.sleep (1000L*n)
|
||||||
|
println (show n ++ " seconds is up!")
|
||||||
|
|
||||||
|
table = "table"
|
||||||
|
|
||||||
|
mainPhil _ = do
|
||||||
|
[fork1,fork2,fork3,fork4,fork5] <- mapM MVar.new [1..5]
|
||||||
|
forkIO (philosopher "Kant" fork5 fork1)
|
||||||
|
forkIO (philosopher "Locke" fork1 fork2)
|
||||||
|
forkIO (philosopher "Wittgenstein" fork2 fork3)
|
||||||
|
forkIO (philosopher "Nozick" fork3 fork4)
|
||||||
|
forkIO (philosopher "Mises" fork4 fork5)
|
||||||
|
return ()
|
||||||
|
|
||||||
|
philosopher :: String -> MVar Int -> MVar Int -> IO ()
|
||||||
|
philosopher me left right = do
|
||||||
|
g <- Random.newStdGen
|
||||||
|
let phil g = do
|
||||||
|
let (tT,g1) = Random.randomR (60L, 120L) g
|
||||||
|
(eT, g2) = Random.randomR (80L, 160L) g1
|
||||||
|
thinkTime = 300L * tT
|
||||||
|
eatTime = 300L * eT
|
||||||
|
|
||||||
|
println(me ++ " is going to the dining room and takes his seat.")
|
||||||
|
fl <- left.take
|
||||||
|
println (me ++ " takes up left fork (" ++ show fl ++ ")")
|
||||||
|
rFork <- right.poll
|
||||||
|
case rFork of
|
||||||
|
Just fr -> do
|
||||||
|
println (me ++ " takes up right fork. (" ++ show fr ++ ")")
|
||||||
|
println (me ++ " is going to eat for " ++ show eatTime ++ "ms")
|
||||||
|
Thread.sleep eatTime
|
||||||
|
println (me ++ " finished eating.")
|
||||||
|
right.put fr
|
||||||
|
println (me ++ " took down right fork.")
|
||||||
|
left.put fl
|
||||||
|
println (me ++ " took down left fork.")
|
||||||
|
table.notifyAll
|
||||||
|
println(me ++ " is going to think for " ++ show thinkTime ++ "ms.")
|
||||||
|
Thread.sleep thinkTime
|
||||||
|
phil g2
|
||||||
|
Nothing -> do
|
||||||
|
println (me ++ " finds right fork is already in use.")
|
||||||
|
left.put fl
|
||||||
|
println (me ++ " took down left fork.")
|
||||||
|
table.notifyAll
|
||||||
|
println (me ++ " is going to the bar to await notifications from table.")
|
||||||
|
table.wait
|
||||||
|
println (me ++ " got notice that something changed at the table.")
|
||||||
|
phil g2
|
||||||
|
|
||||||
|
inter :: InterruptedException -> IO ()
|
||||||
|
inter _ = return ()
|
||||||
|
|
||||||
|
phil g `catch` inter
|
||||||
|
|
||||||
|
|
||||||
|
getURL xx = do
|
||||||
|
url <- URL.new xx
|
||||||
|
con <- url.openConnection
|
||||||
|
con.connect
|
||||||
|
is <- con.getInputStream
|
||||||
|
typ <- con.getContentType
|
||||||
|
-- stderr.println ("content-type is " ++ show typ)
|
||||||
|
ir <- InputStreamReader.new is (fromMaybe "UTF-8" (charset typ))
|
||||||
|
`catch` unsupportedEncoding is
|
||||||
|
br <- BufferedReader.new ir
|
||||||
|
br.getLines
|
||||||
|
where
|
||||||
|
unsupportedEncoding :: InputStream -> UnsupportedEncodingException -> IO InputStreamReader
|
||||||
|
unsupportedEncoding is x = do
|
||||||
|
stderr.println x.catched
|
||||||
|
InputStreamReader.new is "UTF-8"
|
||||||
|
|
||||||
|
charset ctyp = do
|
||||||
|
typ <- ctyp
|
||||||
|
case typ of
|
||||||
|
m~´charset=(\S+)´ -> m.group 1
|
||||||
|
_ -> Nothing
|
||||||
|
|
||||||
|
|
||||||
|
type SomeException = Throwable
|
||||||
|
|
||||||
|
main ["dining"] = mainPhil []
|
||||||
|
|
||||||
|
main _ = do
|
||||||
|
m1 <- MVar.newEmpty
|
||||||
|
m2 <- MVar.newEmpty
|
||||||
|
m3 <- MVar.newEmpty
|
||||||
|
|
||||||
|
forkIO do
|
||||||
|
r <- (catchAll . getURL) "http://www.wikipedia.org/wiki/Haskell"
|
||||||
|
m1.put r
|
||||||
|
|
||||||
|
forkIO do
|
||||||
|
r <- (catchAll . getURL) "htto://www.wikipedia.org/wiki/Java"
|
||||||
|
m2.put r
|
||||||
|
|
||||||
|
forkIO do
|
||||||
|
r <- (catchAll . getURL) "http://www.wikipedia.org/wiki/Frege"
|
||||||
|
m3.put r
|
||||||
|
|
||||||
|
r1 <- m1.take
|
||||||
|
r2 <- m2.take
|
||||||
|
r3 <- m3.take
|
||||||
|
println (result r1, result r2, result r3)
|
||||||
|
-- case r3 of
|
||||||
|
-- Right ss -> mapM_ putStrLn ss
|
||||||
|
-- Left _ -> return ()
|
||||||
|
where
|
||||||
|
result :: (SomeException|[String]) -> (String|Int)
|
||||||
|
result (Left x) = Left x.getClass.getName
|
||||||
|
result (Right y) = (Right . sum . map length) y
|
||||||
|
-- mapM_ putStrLn r2
|
||||||
|
|
||||||
|
|
||||||
561
samples/Frege/Sudoku.fr
Normal file
561
samples/Frege/Sudoku.fr
Normal file
@@ -0,0 +1,561 @@
|
|||||||
|
package examples.Sudoku where
|
||||||
|
|
||||||
|
import Data.TreeMap (Tree, keys)
|
||||||
|
import Data.List as DL hiding (find, union)
|
||||||
|
|
||||||
|
|
||||||
|
type Element = Int -- 1,2,3,4,5,6,7,8,9
|
||||||
|
type Zelle = [Element] -- set of candidates
|
||||||
|
type Position = Int -- 0..80
|
||||||
|
type Feld = (Position, Zelle)
|
||||||
|
type Brett = [Feld]
|
||||||
|
|
||||||
|
--- data type for assumptions and conclusions
|
||||||
|
data Assumption =
|
||||||
|
!ISNOT Position Element
|
||||||
|
| !IS Position Element
|
||||||
|
|
||||||
|
|
||||||
|
derive Eq Assumption
|
||||||
|
derive Ord Assumption
|
||||||
|
instance Show Assumption where
|
||||||
|
show (IS p e) = pname p ++ "=" ++ e.show
|
||||||
|
show (ISNOT p e) = pname p ++ "/" ++ e.show
|
||||||
|
|
||||||
|
showcs cs = joined " " (map Assumption.show cs)
|
||||||
|
|
||||||
|
elements :: [Element] -- all possible elements
|
||||||
|
elements = [1 .. 9]
|
||||||
|
|
||||||
|
{-
|
||||||
|
a b c d e f g h i
|
||||||
|
0 1 2 | 3 4 5 | 6 7 8 1
|
||||||
|
9 10 11 |12 13 14 |15 16 17 2
|
||||||
|
18 19 20 |21 22 23 |24 25 26 3
|
||||||
|
---------|---------|--------
|
||||||
|
27 28 29 |30 31 32 |33 34 35 4
|
||||||
|
36 37 38 |39 40 41 |42 43 44 5
|
||||||
|
45 46 47 |48 49 50 |51 52 53 6
|
||||||
|
---------|---------|--------
|
||||||
|
54 55 56 |57 58 59 |60 61 62 7
|
||||||
|
63 64 65 |66 67 68 |69 70 71 8
|
||||||
|
72 73 74 |75 76 77 |78 79 80 9
|
||||||
|
-}
|
||||||
|
|
||||||
|
positions :: [Position] -- all possible positions
|
||||||
|
positions = [0..80]
|
||||||
|
rowstarts :: [Position] -- all positions where a row is starting
|
||||||
|
rowstarts = [0,9,18,27,36,45,54,63,72]
|
||||||
|
colstarts :: [Position] -- all positions where a column is starting
|
||||||
|
colstarts = [0,1,2,3,4,5,6,7,8]
|
||||||
|
boxstarts :: [Position] -- all positions where a box is starting
|
||||||
|
boxstarts = [0,3,6,27,30,33,54,57,60]
|
||||||
|
boxmuster :: [Position] -- pattern for a box, by adding upper left position results in real box
|
||||||
|
boxmuster = [0,1,2,9,10,11,18,19,20]
|
||||||
|
|
||||||
|
|
||||||
|
--- extract field for position
|
||||||
|
getf :: Brett -> Position -> Feld
|
||||||
|
getf (f:fs) p
|
||||||
|
| fst f == p = f
|
||||||
|
| otherwise = getf fs p
|
||||||
|
getf [] p = (p,[])
|
||||||
|
|
||||||
|
|
||||||
|
--- extract cell for position
|
||||||
|
getc :: Brett -> Position -> Zelle
|
||||||
|
getc b p = snd (getf b p)
|
||||||
|
|
||||||
|
--- compute the list of all positions that belong to the same row as a given position
|
||||||
|
row :: Position -> [Position]
|
||||||
|
row p = [z..(z+8)] where z = (p `quot` 9) * 9
|
||||||
|
|
||||||
|
--- compute the list of all positions that belong to the same col as a given position
|
||||||
|
col :: Position -> [Position]
|
||||||
|
col p = map (c+) rowstarts where c = p `mod` 9
|
||||||
|
|
||||||
|
--- compute the list of all positions that belong to the same box as a given position
|
||||||
|
box :: Position -> [Position]
|
||||||
|
box p = map (z+) boxmuster where
|
||||||
|
ri = p `div` 27 * 27 -- 0, 27 or 54, depending on row
|
||||||
|
ci = p `mod` 9 -- column index 0..8, 0,1,2 is left, 3,4,5 is middle, 6,7,8 is right
|
||||||
|
cs = ci `div` 3 * 3 -- 0, 3 or 6
|
||||||
|
z = ri + cs
|
||||||
|
|
||||||
|
--- check if candidate set has exactly one member, i.e. field has been solved
|
||||||
|
single :: Zelle -> Bool
|
||||||
|
single [_] = true
|
||||||
|
single _ = false
|
||||||
|
|
||||||
|
unsolved :: Zelle -> Bool
|
||||||
|
unsolved [_] = false
|
||||||
|
unsolved _ = true
|
||||||
|
|
||||||
|
-- list of rows, cols, boxes
|
||||||
|
allrows = map row rowstarts
|
||||||
|
allcols = map col colstarts
|
||||||
|
allboxs = map box boxstarts
|
||||||
|
allrcb = zip (repeat "row") allrows
|
||||||
|
++ zip (repeat "col") allcols
|
||||||
|
++ zip (repeat "box") allboxs
|
||||||
|
|
||||||
|
|
||||||
|
containers :: [(Position -> [Position], String)]
|
||||||
|
containers = [(row, "row"), (col, "col"), (box, "box")]
|
||||||
|
|
||||||
|
-- ----------------- PRINTING ------------------------------------
|
||||||
|
-- printable coordinate of field, upper left is a1, lower right is i9
|
||||||
|
pname p = packed [chr (ord 'a' + p `mod` 9), chr (ord '1' + p `div` 9)]
|
||||||
|
|
||||||
|
-- print board
|
||||||
|
printb b = mapM_ p1line allrows >> println ""
|
||||||
|
where
|
||||||
|
p1line row = do
|
||||||
|
print (joined "" (map pfld line))
|
||||||
|
where line = map (getc b) row
|
||||||
|
|
||||||
|
-- print field (brief)
|
||||||
|
-- ? = no candidate
|
||||||
|
-- 5 = field is 5
|
||||||
|
-- . = some candidates
|
||||||
|
pfld [] = "?"
|
||||||
|
pfld [x] = show x
|
||||||
|
pfld zs = "0"
|
||||||
|
|
||||||
|
-- print initial/final board
|
||||||
|
result msg b = do
|
||||||
|
println ("Result: " ++ msg)
|
||||||
|
print ("Board: ")
|
||||||
|
printb b
|
||||||
|
return b
|
||||||
|
|
||||||
|
res012 b = case concatMap (getc b) [0,1,2] of
|
||||||
|
[a,b,c] -> a*100+b*10+c
|
||||||
|
_ -> 9999999
|
||||||
|
|
||||||
|
-- -------------------------- BOARD ALTERATION ACTIONS ---------------------------------
|
||||||
|
-- print a message about what is done to the board and return the new board
|
||||||
|
turnoff1 :: Position -> Zelle -> Brett -> IO Brett
|
||||||
|
turnoff1 i off b
|
||||||
|
| single nc = do
|
||||||
|
-- print (pname i)
|
||||||
|
-- print ": set to "
|
||||||
|
-- print (head nc)
|
||||||
|
-- println " (naked single)"
|
||||||
|
return newb
|
||||||
|
| otherwise = return newb
|
||||||
|
where
|
||||||
|
cell = getc b i
|
||||||
|
nc = filter (`notElem` off) cell
|
||||||
|
newb = (i, nc) : [ f | f <- b, fst f != i ]
|
||||||
|
|
||||||
|
turnoff :: Int -> Zelle -> String -> Brett -> IO Brett
|
||||||
|
turnoff i off msg b = do
|
||||||
|
-- print (pname i)
|
||||||
|
-- print ": set to "
|
||||||
|
-- print nc
|
||||||
|
-- print " by clearing "
|
||||||
|
-- print off
|
||||||
|
-- print " "
|
||||||
|
-- println msg
|
||||||
|
return newb
|
||||||
|
where
|
||||||
|
cell = getc b i
|
||||||
|
nc = filter (`notElem` off) cell
|
||||||
|
newb = (i, nc) : [ f | f <- b, fst f != i ]
|
||||||
|
|
||||||
|
turnoffh ps off msg b = foldM toh b ps
|
||||||
|
where
|
||||||
|
toh b p = turnoff p off msg b
|
||||||
|
|
||||||
|
setto :: Position -> Element -> String -> Brett -> IO Brett
|
||||||
|
setto i n cname b = do
|
||||||
|
-- print (pname i)
|
||||||
|
-- print ": set to "
|
||||||
|
-- print n
|
||||||
|
-- print " (hidden single in "
|
||||||
|
-- print cname
|
||||||
|
-- println ")"
|
||||||
|
return newb
|
||||||
|
where
|
||||||
|
nf = [n]
|
||||||
|
newb = (i, nf) : [ f | f <- b, fst f != i ]
|
||||||
|
|
||||||
|
|
||||||
|
-- ----------------------------- SOLVING STRATEGIES ---------------------------------------------
|
||||||
|
-- reduce candidate sets that contains numbers already in same row, col or box
|
||||||
|
-- This finds (and logs) NAKED SINGLEs in passing.
|
||||||
|
reduce b = [ turnoff1 p sss | (p,cell) <- b, -- for each field
|
||||||
|
unsolved cell, -- with more than 1 candidate
|
||||||
|
-- single fields in containers that are candidates of that field
|
||||||
|
sss = [ s | (rcb, _) <- containers, [s] <- map (getc b) (rcb p), s `elem` cell],
|
||||||
|
sss != [] ] -- collect field index, elements to remove from candidate set
|
||||||
|
|
||||||
|
-- look for a number that appears in exactly 1 candidate set of a container
|
||||||
|
-- this number can go in no other place (HIDDEN SINGLE)
|
||||||
|
hiddenSingle b = [ setto i n cname | -- select index, number, containername
|
||||||
|
(cname, rcb) <- allrcb, -- FOR rcb IN allrcb
|
||||||
|
n <- elements, -- FOR n IN elements
|
||||||
|
fs = filter (unsolved • snd) (map (getf b) rcb),
|
||||||
|
occurs = filter ((n `elem`) • snd) fs,
|
||||||
|
length occurs == 1,
|
||||||
|
(i, _) <- occurs ]
|
||||||
|
|
||||||
|
-- look for NAKED PAIRS, TRIPLES, QUADS
|
||||||
|
nakedPair n b = [ turnoff p t ("(naked tuple in " ++ nm ++ ")") | -- SELECT pos, tuple, name
|
||||||
|
-- n <- [2,3,4], // FOR n IN [2,3,4]
|
||||||
|
(nm, rcb) <- allrcb, -- FOR rcb IN containers
|
||||||
|
fs = map (getf b) rcb, -- let fs = fields for rcb positions
|
||||||
|
u = (fold union [] . filter unsolved . map snd) fs, -- let u = union of non single candidates
|
||||||
|
t <- n `outof` u, -- FOR t IN n-tuples
|
||||||
|
hit = (filter ((`subset` t) . snd) . filter (unsolved . snd)) fs,
|
||||||
|
length hit == n,
|
||||||
|
(p, cell) <- fs,
|
||||||
|
p `notElem` map fst hit,
|
||||||
|
any (`elem` cell) t
|
||||||
|
]
|
||||||
|
|
||||||
|
-- look for HIDDEN PAIRS, TRIPLES or QUADS
|
||||||
|
hiddenPair n b = [ turnoff p off ("(hidden " ++ show t ++ " in " ++ nm ++ ")") | -- SELECT pos, tuple, name
|
||||||
|
-- n <- [2,3,4], // FOR n IN [2,3,4]
|
||||||
|
(nm, rcb) <- allrcb, -- FOR rcb IN containers
|
||||||
|
fs = map (getf b) rcb, -- let fs = fields for rcb positions
|
||||||
|
u = (fold union [] . filter ((>1) . length) . map snd) fs, -- let u = union of non single candidates
|
||||||
|
t <- n `outof` u, -- FOR t IN n-tuples
|
||||||
|
hit = (filter (any ( `elem` t) . snd) . filter (unsolved . snd)) fs,
|
||||||
|
length hit == n,
|
||||||
|
off = (fold union [] . map snd) hit `minus` t,
|
||||||
|
off != [],
|
||||||
|
(p, cell) <- hit,
|
||||||
|
! (cell `subset` t)
|
||||||
|
]
|
||||||
|
|
||||||
|
a `subset` b = all (`elem` b) a
|
||||||
|
a `union` b = uniq (sort (a ++ b))
|
||||||
|
a `minus` b = filter (`notElem` b) a
|
||||||
|
a `common` b = filter (`elem` b) a
|
||||||
|
n `outof` as
|
||||||
|
| length as < n = []
|
||||||
|
| [] <- as = []
|
||||||
|
| 1 >= n = map (:[]) as
|
||||||
|
| (a:bs) <- as = map (a:) ((n-1) `outof` bs) ++ (n `outof` bs)
|
||||||
|
| otherwise = undefined -- cannot happen because either as is empty or not
|
||||||
|
|
||||||
|
same f a b = b `elem` f a
|
||||||
|
|
||||||
|
intersectionlist = [(allboxs, row, "box/row intersection"), (allboxs, col, "box/col intersection"),
|
||||||
|
(allrows ++ allcols, box, "line/box intersection")]
|
||||||
|
intersections b = [
|
||||||
|
turnoff pos [c] reason | -- SELECT position, candidate, reson
|
||||||
|
(from, container, reason) <- intersectionlist,
|
||||||
|
rcb <- from,
|
||||||
|
fs = (filter (unsolved . snd) . map (getf b)) rcb, -- fs = fields in from with more than 1 candidate
|
||||||
|
c <- (fold union [] • map snd) fs, -- FOR c IN union of candidates
|
||||||
|
cpos = (map fst • filter ((c `elem`) • snd)) fs, -- cpos = positions where c occurs
|
||||||
|
cpos != [], -- WHERE cpos is not empty
|
||||||
|
all (same container (head cpos)) (tail cpos), -- WHERE all positions are in the intersection
|
||||||
|
-- we can remove all occurences of c that are in container, but not in from
|
||||||
|
(pos, cell) <- map (getf b) (container (head cpos)),
|
||||||
|
c `elem` cell,
|
||||||
|
pos `notElem` rcb ]
|
||||||
|
|
||||||
|
|
||||||
|
-- look for an XY Wing
|
||||||
|
-- - there exists a cell A with candidates X and Y
|
||||||
|
-- - there exists a cell B with candidates X and Z that shares a container with A
|
||||||
|
-- - there exists a cell C with candidates Y and Z that shares a container with A
|
||||||
|
-- reasoning
|
||||||
|
-- - if A is X, B will be Z
|
||||||
|
-- - if A is Y, C will be Z
|
||||||
|
-- - since A will indeed be X or Y -> B or C will be Z
|
||||||
|
-- - thus, no cell that can see B and C can be Z
|
||||||
|
xyWing board = [ turnoff p [z] ("xy wing " ++ pname b ++ " " ++ pname c ++ " because of " ++ pname a) |
|
||||||
|
(a, [x,y]) <- board, -- there exists a cell a with candidates x and y
|
||||||
|
rcba = map (getf board) (row a ++ col a ++ box a), -- rcba = all fields that share a container with a
|
||||||
|
(b, [b1, b2]) <- rcba,
|
||||||
|
b != a,
|
||||||
|
b1 == x && b2 != y || b2 == x && b1 != y, -- there exists a cell B with candidates x and z
|
||||||
|
z = if b1 == x then b2 else b1,
|
||||||
|
(c, [c1, c2]) <- rcba,
|
||||||
|
c != a, c!= b,
|
||||||
|
c1 == y && c2 == z || c1 == z && c2 == y, -- there exists a cell C with candidates y and z
|
||||||
|
ps = (uniq . sort) ((row b ++ col b ++ box b) `common` (row c ++ col c ++ box c)),
|
||||||
|
-- remove z in ps
|
||||||
|
(p, cs) <- map (getf board) ps,
|
||||||
|
p != b, p != c,
|
||||||
|
z `elem` cs ]
|
||||||
|
|
||||||
|
-- look for a N-Fish (2: X-Wing, 3: Swordfish, 4: Jellyfish)
|
||||||
|
-- When all candidates for a particular digit in N rows are located
|
||||||
|
-- in only N columns, we can eliminate all candidates from those N columns
|
||||||
|
-- which are not located on those N rows
|
||||||
|
fish n board = fish "row" allrows row col ++ fish "col" allcols col row where
|
||||||
|
fishname 2 = "X-Wing"
|
||||||
|
fishname 3 = "Swordfish"
|
||||||
|
fishname 4 = "Jellyfish"
|
||||||
|
fishname _ = "unknown fish"
|
||||||
|
fish nm allrows row col = [ turnoff p [x] (fishname n ++ " in " ++ nm ++ " " ++ show (map (pname . head) rset)) |
|
||||||
|
rset <- n `outof` allrows, -- take n rows (or cols)
|
||||||
|
x <- elements, -- look for certain number
|
||||||
|
rflds = map (filter ((>1) . length . snd) . map (getf board)) rset, -- unsolved fields in the rowset
|
||||||
|
colss = (map (map (head . col . fst) . filter ((x `elem`) . snd)) rflds), -- where x occurs in candidates
|
||||||
|
all ((>1) . length) colss, -- x must appear in at least 2 cols
|
||||||
|
cols = fold union [] colss,
|
||||||
|
length cols == n,
|
||||||
|
cstart <- cols,
|
||||||
|
(p, cell) <- map (getf board) (col cstart),
|
||||||
|
x `elem` cell,
|
||||||
|
all (p `notElem`) rset]
|
||||||
|
|
||||||
|
|
||||||
|
-- compute immediate consequences of an assumption of the form (p `IS` e) or (p `ISNOT` e)
|
||||||
|
conseq board (IS p e) = uniq (sort ([ p `ISNOT` x | x <- getc board p, x != e ] ++
|
||||||
|
[ a `ISNOT` e |
|
||||||
|
(a,cs) <- map (getf board) (row p ++ col p ++ box p),
|
||||||
|
a != p,
|
||||||
|
e `elem` cs
|
||||||
|
]))
|
||||||
|
conseq board (ISNOT p e) = uniq (sort ([ p `IS` x | cs = getc board p, length cs == 2, x <- cs, x != e ] ++
|
||||||
|
[ a `IS` e |
|
||||||
|
cp <- [row p, box p, col p],
|
||||||
|
as = (filter ((e `elem`) . getc board) . filter (p!=)) cp,
|
||||||
|
length as == 1,
|
||||||
|
a = head as
|
||||||
|
]))
|
||||||
|
|
||||||
|
-- check if two assumptions contradict each other
|
||||||
|
contradicts (IS a x) (IS b y) = a==b && x!=y
|
||||||
|
contradicts (IS a x) (ISNOT b y) = a==b && x==y
|
||||||
|
contradicts (ISNOT a x) (IS b y) = a==b && x==y
|
||||||
|
contradicts (ISNOT _ _) (ISNOT _ _) = false
|
||||||
|
|
||||||
|
-- get the Position of an Assumption
|
||||||
|
aPos (IS p _) = p
|
||||||
|
aPos (ISNOT p _) = p
|
||||||
|
|
||||||
|
-- get List of elements that must be turned off when assumption is true/false
|
||||||
|
toClear board true (IS p x) = filter (x!=) (getc board p)
|
||||||
|
toClear board false (IS p x) = [x]
|
||||||
|
toClear board true (ISNOT p x) = [x]
|
||||||
|
toClear board false (ISNOT p x) = filter (x!=) (getc board p)
|
||||||
|
|
||||||
|
|
||||||
|
-- look for assumptions whose implications contradict themself
|
||||||
|
chain board paths = [ solution a (head cs) (reverse cs) |
|
||||||
|
(a, css) <- paths,
|
||||||
|
cs <- take 1 [ cs | cs <- css, contradicts a (head cs) ]
|
||||||
|
]
|
||||||
|
where
|
||||||
|
solution a c cs = turnoff (aPos a) (toClear board false a) reason where
|
||||||
|
reason = "Assumption " ++ show a ++ " implies " ++ show c ++ "\n\t"
|
||||||
|
++ showcs cs ++ "\n\t"
|
||||||
|
++ "Therefore, " ++ show a ++ " must be false."
|
||||||
|
|
||||||
|
-- look for an assumption that yields to contradictory implications
|
||||||
|
-- this assumption must be false
|
||||||
|
chainContra board paths = [ solution a (reverse pro) (reverse contra) |
|
||||||
|
(a, css) <- paths, -- FOR ALL assumptions "a" with list of conlusions "css"
|
||||||
|
(pro, contra) <- take 1 [ (pro, contra) |
|
||||||
|
pro <- (uniqBy (using head) . sortBy (comparing head)) css, -- FOR ALL conslusion chains "pro"
|
||||||
|
c = head pro, -- LET "c" BE the final conclusion
|
||||||
|
contra <- take 1 (filter ((contradicts c) . head) css) -- THE FIRST conclusion that contradicts c
|
||||||
|
]
|
||||||
|
]
|
||||||
|
where
|
||||||
|
solution a pro con = turnoff (aPos a) (toClear board false a) reason where
|
||||||
|
reason = ("assumption " ++ show a ++ " leads to contradictory conclusions\n\t"
|
||||||
|
++ showcs pro ++ "\n\t" ++ showcs con)
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
-- look for a common implication c of some assumptions ai, where at least 1 ai is true
|
||||||
|
-- so that (a0 OR a1 OR a2 OR ...) IMPLIES c
|
||||||
|
-- For all cells pi in same container that have x as candidate, we can construct (p0==x OR p1==x OR ... OR pi==x)
|
||||||
|
-- For a cell p with candidates ci, we can construct (p==c0 OR p==c1)
|
||||||
|
cellRegionChain board paths = [ solution b as (map head os) |
|
||||||
|
as <- cellas ++ regionas, -- one of as must be true
|
||||||
|
iss = filter ((`elem` as) . fst) paths, -- the implications for as
|
||||||
|
(a, ass) <- take 1 iss, -- implications for first assumption
|
||||||
|
fs <- (uniqBy (using head) . sortBy (comparing head)) ass,
|
||||||
|
b = head fs, -- final conclusions of first assumption
|
||||||
|
os = [fs] : map (take 1 . filter ((b==) . head) . snd) (tail iss), -- look for implications with same conclusion
|
||||||
|
all ([]!=) os]
|
||||||
|
where
|
||||||
|
cellas = [ map (p `IS`) candidates | (p, candidates@(_:_:_)) <- board ]
|
||||||
|
regionas = [ map (`IS` e) ps |
|
||||||
|
region <- map (map (getf board)) (allrows ++ allcols ++ allboxs),
|
||||||
|
e <- elements,
|
||||||
|
ps = map fst (filter ((e `elem`) . snd) region),
|
||||||
|
length ps > 1 ]
|
||||||
|
solution b as oss = turnoff (aPos b) (toClear board true b) reason where
|
||||||
|
reason = "all of the assumptions " ++ joined ", " (map show as) ++ " imply " ++ show b ++ "\n\t"
|
||||||
|
++ joined "\n\t" (map (showcs . reverse) oss) ++ "\n\t"
|
||||||
|
++ "One of them must be true, so " ++ show b ++ " must be true."
|
||||||
|
|
||||||
|
|
||||||
|
{-
|
||||||
|
Wir brauchen für einige Funktionen eine Datenstruktur wie
|
||||||
|
[ (Assumption, [[Assumption]]) ]
|
||||||
|
d.i. eine Liste von möglichen Annahmen samt aller Schlußketten.
|
||||||
|
Idealerweise sollte die Schlußkette in umgekehrter Reihenfolge vorliegen,
|
||||||
|
dann kann man einfach finden:
|
||||||
|
- Annahmen, die zum Selbstwiderspruch führen.
|
||||||
|
- alles, was aus einer bestimmten Annahme folgt (map (map head) [[a]])
|
||||||
|
-...
|
||||||
|
-}
|
||||||
|
--- Liste aller Annahmen für ein bestimmtes Brett
|
||||||
|
assumptions :: Brett -> [Assumption]
|
||||||
|
assumptions board = [ a |
|
||||||
|
(p, cs) <- board,
|
||||||
|
!(single cs),
|
||||||
|
a <- map (ISNOT p) cs ++ map (IS p) cs ]
|
||||||
|
|
||||||
|
consequences :: Brett -> [Assumption] -> [[Assumption]]
|
||||||
|
consequences board as = map (conseq board) as
|
||||||
|
|
||||||
|
acstree :: Brett -> Tree Assumption [Assumption]
|
||||||
|
acstree board = Tree.fromList (zip as cs)
|
||||||
|
where
|
||||||
|
as = assumptions board
|
||||||
|
cs = consequences board as
|
||||||
|
|
||||||
|
-- bypass maybe on tree lookup
|
||||||
|
find :: Tree Assumption [Assumption] -> Assumption -> [Assumption]
|
||||||
|
find t a
|
||||||
|
| Just cs <- t.lookup a = cs
|
||||||
|
| otherwise = error ("no consequences for " ++ show a)
|
||||||
|
|
||||||
|
-- for performance resons, we confine ourselves to implication chains of length 20 per assumption
|
||||||
|
mkPaths :: Tree Assumption [Assumption] -> [ (Assumption, [[Assumption]]) ]
|
||||||
|
mkPaths acst = map impl (keys acst) -- {[a1], [a2], [a3] ]
|
||||||
|
where
|
||||||
|
-- [Assumption] -> [(a, [chains, ordered by length]
|
||||||
|
impl a = (a, impls [[a]])
|
||||||
|
impls ns = (take 1000 • concat • takeUntil null • iterate expandchain) ns
|
||||||
|
-- expandchain :: [[Assumption]] -> [[Assumption]]
|
||||||
|
expandchain css = [ (n:a:as) |
|
||||||
|
(a : as) <- css, -- list of assumptions
|
||||||
|
n <- find acst a, -- consequences of a
|
||||||
|
n `notElem` as -- avoid loops
|
||||||
|
]
|
||||||
|
-- uni (a:as) = a : uni (filter ((head a !=) • head) as)
|
||||||
|
-- uni [] = empty
|
||||||
|
-- empty = []
|
||||||
|
|
||||||
|
|
||||||
|
-- ------------------ SOLVE A SUDOKU --------------------------
|
||||||
|
-- Apply all available strategies until nothing changes anymore
|
||||||
|
-- Strategy functions are supposed to return a list of
|
||||||
|
-- functions, which, when applied to a board, give a changed board.
|
||||||
|
-- When a strategy does not find anything to alter,
|
||||||
|
-- it returns [], and the next strategy can be tried.
|
||||||
|
solve b
|
||||||
|
| all (single . snd) b = result "Solved" b
|
||||||
|
| any (([]==) . snd) b = result "not solvable" b
|
||||||
|
| res@(_:_) <- reduce b = apply b res >>=solve -- compute smallest candidate sets
|
||||||
|
-- comment "candidate sets are up to date" = ()
|
||||||
|
| res@(_:_) <- hiddenSingle b = apply b res >>= solve -- find HIDDEN SINGLES
|
||||||
|
-- comment "no more hidden singles" = ()
|
||||||
|
| res@(_:_) <- intersections b = apply b res >>= solve -- find locked candidates
|
||||||
|
-- comment "no more intersections" = ()
|
||||||
|
| res@(_:_) <- nakedPair 2 b = apply b res >>= solve -- find NAKED PAIRS, TRIPLES or QUADRUPELS
|
||||||
|
-- comment "no more naked pairs" = ()
|
||||||
|
| res@(_:_) <- hiddenPair 2 b = apply b res >>= solve -- find HIDDEN PAIRS, TRIPLES or QUADRUPELS
|
||||||
|
-- comment "no more hidden pairs" = ()
|
||||||
|
-- res@(_:_) <- nakedPair 3 b = apply b res >>= solve // find NAKED PAIRS, TRIPLES or QUADRUPELS
|
||||||
|
-- | comment "no more naked triples" = ()
|
||||||
|
-- res@(_:_) <- hiddenPair 3 b = apply b res >>= solve // find HIDDEN PAIRS, TRIPLES or QUADRUPELS
|
||||||
|
-- | comment "no more hidden triples" = ()
|
||||||
|
-- res@(_:_) <- nakedPair 4 b = apply b res >>=solve // find NAKED PAIRS, TRIPLES or QUADRUPELS
|
||||||
|
-- | comment "no more naked quadruples" = ()
|
||||||
|
-- res@(_:_) <- hiddenPair 4 b = apply b res >>=solve // find HIDDEN PAIRS, TRIPLES or QUADRUPELS
|
||||||
|
-- | comment "no more hidden quadruples" = ()
|
||||||
|
| res@(_:_) <- xyWing b = apply b res >>=solve -- find XY WINGS
|
||||||
|
-- comment "no more xy wings" = ()
|
||||||
|
| res@(_:_) <- fish 2 b = apply b res >>=solve -- find 2-FISH
|
||||||
|
-- comment "no more x-wings" = ()
|
||||||
|
-- res@(_:_) <- fish 3 b = apply b res >>=solve // find 3-FISH
|
||||||
|
-- | comment "no more swordfish" = ()
|
||||||
|
-- res@(_:_) <- fish 4 b = apply b res >>=solve // find 4-FISH
|
||||||
|
-- | comment "no more jellyfish" = ()
|
||||||
|
-- | comment pcomment = ()
|
||||||
|
| res@(_:_) <- chain b paths = apply b (take 9 res) >>= solve -- find forcing chains
|
||||||
|
| res@(_:_) <- cellRegionChain b paths = apply b (take 9 res) >>= solve -- find common conclusion for true assumption
|
||||||
|
| res@(_:_) <- chainContra b paths = apply b (take 9 res) >>= solve -- find assumptions that allow to infer both a and !a
|
||||||
|
-- comment "consistent conclusions only" = ()
|
||||||
|
|
||||||
|
| otherwise = result "ambiguous" b
|
||||||
|
where
|
||||||
|
apply brd fs = foldM (\b\f -> f b) brd fs
|
||||||
|
paths = mkPaths (acstree b)
|
||||||
|
-- pcomment = show (length paths) ++ " assumptions with " ++ show (fold (+) 0 (map (length <~ snd) paths))
|
||||||
|
-- ++ " implication chains"
|
||||||
|
|
||||||
|
-- comment com = do stderr << com << "\n" for false
|
||||||
|
-- log com = do stderr << com << "\n" for true
|
||||||
|
|
||||||
|
--- turn a string into a row
|
||||||
|
mkrow :: String -> [Zelle]
|
||||||
|
mkrow s = mkrow1 xs
|
||||||
|
where
|
||||||
|
xs = s ++ "---------" -- make sure at least 9 elements
|
||||||
|
mkrow1 xs = (take 9 • filter ([]!=) • map f • unpacked) xs
|
||||||
|
f x | x >= '1' && x <= '9' = [ord x - ord '0']
|
||||||
|
| x == ' ' = [] -- ignored
|
||||||
|
| otherwise = elements
|
||||||
|
|
||||||
|
main ["-h"] = main []
|
||||||
|
main ["-help"] = main []
|
||||||
|
main [] = do
|
||||||
|
mapM_ stderr.println [
|
||||||
|
"usage: java Sudoku file ...",
|
||||||
|
" java Sudoku position",
|
||||||
|
"where position is a 81 char string consisting of digits",
|
||||||
|
"One can get such a string by going to",
|
||||||
|
"http://www.sudokuoftheday.com/pages/s-o-t-d.php",
|
||||||
|
"Right click on the puzzle and open it in new tab",
|
||||||
|
"Copy the 81 digits from the URL in the address field of your browser.",
|
||||||
|
"",
|
||||||
|
"There is also a file with hard sudokus in examples/top95.txt\n"]
|
||||||
|
return ()
|
||||||
|
|
||||||
|
|
||||||
|
main [s@#^[0-9\W]{81}$#] = solve board >> return ()
|
||||||
|
where
|
||||||
|
board = zip positions felder
|
||||||
|
felder = decode s
|
||||||
|
|
||||||
|
main files = forM_ files sudoku
|
||||||
|
where
|
||||||
|
sudoku file = do
|
||||||
|
br <- openReader file
|
||||||
|
lines <- BufferedReader.getLines br
|
||||||
|
bs <- process lines
|
||||||
|
ss <- mapM (\b -> print "Puzzle: " >> printb b >> solve b) bs
|
||||||
|
println ("Euler: " ++ show (sum (map res012 ss)))
|
||||||
|
return ()
|
||||||
|
|
||||||
|
-- "--3-" => [1..9, 1..9, [3], 1..9]
|
||||||
|
decode s = map candi (unpacked s) where
|
||||||
|
candi c | c >= '1' && c <= '9' = [(ord c - ord '0')]
|
||||||
|
| otherwise = elements
|
||||||
|
process [] = return []
|
||||||
|
process (s:ss)
|
||||||
|
| length s == 81 = consider b1
|
||||||
|
| length s == 9,
|
||||||
|
length acht == 8,
|
||||||
|
all ((9==) • length) acht = consider b2
|
||||||
|
| otherwise = do
|
||||||
|
stderr.println ("skipped line: " ++ s)
|
||||||
|
process ss
|
||||||
|
where
|
||||||
|
acht = take 8 ss
|
||||||
|
neun = fold (++) "" (s:acht)
|
||||||
|
b1 = zip positions (decode s)
|
||||||
|
b2 = zip positions (decode neun)
|
||||||
|
consider b = do
|
||||||
|
-- print "Puzzle: "
|
||||||
|
-- printb b
|
||||||
|
bs <- process ss
|
||||||
|
return (b:bs)
|
||||||
|
|
||||||
79
samples/Frege/SwingExamples.fr
Normal file
79
samples/Frege/SwingExamples.fr
Normal file
@@ -0,0 +1,79 @@
|
|||||||
|
package examples.SwingExamples where
|
||||||
|
|
||||||
|
import Java.Awt (ActionListener)
|
||||||
|
import Java.Swing
|
||||||
|
|
||||||
|
|
||||||
|
main _ = do
|
||||||
|
rs <- mapM Runnable.new [helloWorldGUI, buttonDemoGUI, celsiusConverterGUI]
|
||||||
|
mapM_ invokeLater rs
|
||||||
|
println "Hit enter to end ...."
|
||||||
|
s <- getLine
|
||||||
|
return ()
|
||||||
|
|
||||||
|
celsiusConverterGUI = do
|
||||||
|
tempTextField <- JTextField.new()
|
||||||
|
celsiusLabel <- JLabel.new ()
|
||||||
|
convertButton <- JButton.new ()
|
||||||
|
fahrenheitLabel <- JLabel.new ()
|
||||||
|
frame <- JFrame.new ()
|
||||||
|
frame.setDefaultCloseOperation JFrame.dispose_on_close
|
||||||
|
frame.setTitle "Celsius Converter"
|
||||||
|
celsiusLabel.setText "Celsius"
|
||||||
|
convertButton.setText "Convert"
|
||||||
|
let convertButtonActionPerformed _ = do
|
||||||
|
celsius <- tempTextField.getText
|
||||||
|
case celsius.double of
|
||||||
|
Left _ -> fahrenheitLabel.setText ("not a valid number: " ++ celsius)
|
||||||
|
Right c -> fahrenheitLabel.setText (show (c*1.8 + 32.0).long ++ " Fahrenheit")
|
||||||
|
return ()
|
||||||
|
ActionListener.new convertButtonActionPerformed >>= convertButton.addActionListener
|
||||||
|
fahrenheitLabel.setText "Fahrenheit"
|
||||||
|
contentPane <- frame.getContentPane
|
||||||
|
layout <- GroupLayout.new contentPane
|
||||||
|
contentPane.setLayout layout
|
||||||
|
-- TODO continue
|
||||||
|
-- http://docs.oracle.com/javase/tutorial/displayCode.html?code=http://docs.oracle.com/javase/tutorial/uiswing/examples/learn/CelsiusConverterProject/src/learn/CelsiusConverterGUI.java
|
||||||
|
frame.pack
|
||||||
|
frame.setVisible true
|
||||||
|
|
||||||
|
helloWorldGUI = do
|
||||||
|
frame <- JFrame.new "Hello World Frege"
|
||||||
|
frame.setDefaultCloseOperation(JFrame.dispose_on_close)
|
||||||
|
label <- JLabel.new "Hello World!"
|
||||||
|
cp <- frame.getContentPane
|
||||||
|
cp.add label
|
||||||
|
frame.pack
|
||||||
|
frame.setVisible true
|
||||||
|
|
||||||
|
buttonDemoGUI = do
|
||||||
|
frame <- JFrame.new "Button Demo"
|
||||||
|
frame.setDefaultCloseOperation(JFrame.dispose_on_close)
|
||||||
|
newContentPane <- JPanel.new ()
|
||||||
|
b1::JButton <- JButton.new "Disable middle button"
|
||||||
|
b1.setVerticalTextPosition SwingConstants.center
|
||||||
|
b1.setHorizontalTextPosition SwingConstants.leading
|
||||||
|
b2::JButton <- JButton.new "Middle button"
|
||||||
|
b2.setVerticalTextPosition SwingConstants.center
|
||||||
|
b2.setHorizontalTextPosition SwingConstants.leading
|
||||||
|
b3::JButton <- JButton.new "Enable middle button"
|
||||||
|
b3.setVerticalTextPosition SwingConstants.center
|
||||||
|
b3.setHorizontalTextPosition SwingConstants.leading
|
||||||
|
b3.setEnabled false
|
||||||
|
let action1 _ = do
|
||||||
|
b2.setEnabled false
|
||||||
|
b1.setEnabled false
|
||||||
|
b3.setEnabled true
|
||||||
|
action3 _ = do
|
||||||
|
b2.setEnabled true
|
||||||
|
b1.setEnabled true
|
||||||
|
b3.setEnabled false
|
||||||
|
ActionListener.new action1 >>= b1.addActionListener
|
||||||
|
ActionListener.new action3 >>= b3.addActionListener
|
||||||
|
newContentPane.add b1
|
||||||
|
newContentPane.add b2
|
||||||
|
newContentPane.add b3
|
||||||
|
newContentPane.setOpaque true
|
||||||
|
frame.setContentPane newContentPane
|
||||||
|
frame.pack
|
||||||
|
frame.setVisible true
|
||||||
Reference in New Issue
Block a user