From d2de997fcc9e28358223d5ffeb5b4e70cc50372e Mon Sep 17 00:00:00 2001 From: Joshua Peek Date: Mon, 20 Aug 2012 10:48:36 -0500 Subject: [PATCH] Add more Prolog samples Closes #233 --- lib/linguist/samples.json | 368 ++++++++++++++++++++++++++++++++-- samples/Prolog/calc.pl | 68 +++++++ samples/Prolog/normal_form.pl | 94 +++++++++ samples/Prolog/puzzle.pl | 287 ++++++++++++++++++++++++++ samples/Prolog/quicksort.pl | 13 ++ samples/Prolog/turing.pl | 21 ++ 6 files changed, 838 insertions(+), 13 deletions(-) create mode 100644 samples/Prolog/calc.pl create mode 100644 samples/Prolog/normal_form.pl create mode 100644 samples/Prolog/puzzle.pl create mode 100644 samples/Prolog/quicksort.pl create mode 100644 samples/Prolog/turing.pl diff --git a/lib/linguist/samples.json b/lib/linguist/samples.json index 3a345a31..88867a77 100644 --- a/lib/linguist/samples.json +++ b/lib/linguist/samples.json @@ -257,8 +257,8 @@ ".gemrc" ] }, - "tokens_total": 296236, - "languages_total": 263, + "tokens_total": 300219, + "languages_total": 268, "tokens": { "Apex": { "global": 70, @@ -23430,22 +23430,364 @@ "}": 1 }, "Prolog": { + "action_module": 1, + "(": 585, + "calculator": 1, + ")": 584, + ".": 210, + "%": 334, + "[": 110, + "-": 276, + "d1": 1, + "]": 109, + "push": 20, + "D": 37, + "if": 2, + "mode": 22, + "init": 11, + "<": 11, + "deny": 10, + "displayed": 17, + "D1": 5, + "affirm": 10, + "cont": 3, + "*D1": 2, + "+": 32, + "New": 2, + "a": 31, + "op": 28, + "d": 27, + "m": 16, + "clear": 4, + "nop": 6, + "accumulator": 10, + "A": 40, + "O": 14, + "memory": 5, + "M": 14, + "X": 62, + "mem_rec": 2, + "plus": 6, + "eval": 7, + "V": 16, + ";": 9, + "use": 3, + "normal": 3, + "arithmetic": 3, + "i.e.": 3, + "minus": 5, + "lt": 1, + "times": 4, + "equal": 2, + "mem_plus": 2, + "v": 3, + "where": 3, + "V1": 2, + "plus_minus": 1, + "normalize": 2, + "Wff": 3, + "NormalClauses": 3, + "conVert": 1, + "S": 26, + "cnF": 1, + "T": 6, + "flatten_and": 5, + "U": 2, + "make_clauses": 5, + "make": 2, + "sequence": 2, + "out": 4, + "of": 5, + "conjunction": 1, + "/": 2, + "Y": 34, + "F": 31, + "B": 30, + "sequence_append": 5, + "disjunction": 1, + "flatten_or": 6, + "append": 2, + "two": 1, + "sequences": 1, + "R": 32, + "separate": 7, + "into": 1, + "positive": 1, + "and": 3, + "negative": 1, + "literals": 1, + "P": 37, + "N": 20, + "|": 36, + "N1": 2, + "P1": 2, + "tautology": 4, + "some_occurs": 3, + "occurs": 4, + "_": 21, + "C": 21, + "make_clause": 5, + "false": 1, + "make_sequence": 9, + "H": 11, + "write_list": 3, + "write": 13, + "nl": 8, + "A*": 1, + "Algorithm": 1, + "Nodes": 1, + "have": 2, + "form": 2, + "S#D#F#A": 1, + "describes": 1, + "the": 15, + "state": 1, + "or": 1, + "configuration": 1, + "is": 22, + "depth": 1, + "node": 2, + "evaluation": 1, + "function": 4, + "value": 1, + "ancestor": 1, + "list": 1, + "for": 1, + "yfx": 1, + "solve": 2, + "State": 7, + "Soln": 3, + "f_function": 3, + "search": 4, + "State#0#F#": 1, + "reverse": 2, + "h_function": 2, + "H.": 1, + "State#_#_#Soln": 1, + "goal": 2, + "expand": 2, + "Children": 2, + "insert_all": 4, + "Open": 7, + "Open1": 2, + "Open3": 2, + "insert": 6, + "Open2": 2, + "repeat_node": 2, + "cheaper": 2, + "B1": 2, + "P#_#_#_": 2, + "_#_#F1#_": 1, + "_#_#F2#_": 1, + "F1": 1, + "F2.": 1, + "State#D#_#S": 1, + "All_My_Children": 2, + "bagof": 1, + "Child#D1#F#": 1, + "Move": 3, + "move": 7, + "Child": 2, + "puzzle": 4, + "solver": 1, + "A/B/C/D/E/F/G/H/I": 3, + "{": 3, + "...": 3, + "I": 5, + "}": 3, + "represents": 1, + "empty": 2, + "tile": 5, + "/2/3/8/0/4/7/6/5": 1, + "The": 1, + "moves": 1, + "left": 26, + "A/0/C/D/E/F/H/I/J": 3, + "/A/C/D/E/F/H/I/J": 1, + "A/B/C/D/0/F/H/I/J": 4, + "A/B/C/0/D/F/H/I/J": 1, + "A/B/C/D/E/F/H/0/J": 3, + "A/B/C/D/E/F/0/H/J": 1, + "A/B/0/D/E/F/H/I/J": 2, + "A/0/B/D/E/F/H/I/J": 1, + "A/B/C/D/E/0/H/I/J": 3, + "A/B/C/D/0/E/H/I/J": 1, + "A/B/C/D/E/F/H/I/0": 2, + "A/B/C/D/E/F/H/0/I": 1, + "up": 17, + "A/B/C/0/E/F/H/I/J": 3, + "/B/C/A/E/F/H/I/J": 1, + "A/0/C/D/B/F/H/I/J": 1, + "A/B/0/D/E/C/H/I/J": 1, + "A/B/C/D/E/F/0/I/J": 2, + "A/B/C/0/E/F/D/I/J": 1, + "A/B/C/D/0/F/H/E/J": 1, + "A/B/C/D/E/0/H/I/F": 1, + "right": 22, + "A/C/0/D/E/F/H/I/J": 1, + "A/B/C/D/F/0/H/I/J": 1, + "A/B/C/D/E/F/H/J/0": 1, + "/B/C/D/E/F/H/I/J": 2, + "B/0/C/D/E/F/H/I/J": 1, + "A/B/C/E/0/F/H/I/J": 1, + "A/B/C/D/E/F/I/0/J": 1, + "down": 15, + "A/B/C/H/E/F/0/I/J": 1, + "A/B/C/D/I/F/H/0/J": 1, + "A/B/C/D/E/J/H/I/0": 1, + "D/B/C/0/E/F/H/I/J": 1, + "A/E/C/D/0/F/H/I/J": 1, + "A/B/F/D/E/0/H/I/J": 1, + "heuristic": 1, + "Puzz": 3, + "p_fcn": 2, + "s_fcn": 2, + "*S.": 1, + "Manhattan": 1, + "distance": 1, + "Pa": 2, + "b": 12, + "Pb": 2, + "c": 10, + "Pc": 2, + "Pd": 2, + "e": 10, + "E": 3, + "Pe": 2, + "f": 10, + "Pf": 2, + "g": 10, + "G": 7, + "Pg": 3, + "h": 10, + "Ph": 2, + "i": 10, + "Pi": 1, + "Pi.": 1, + "cycle": 1, + "s_aux": 14, + "S1": 2, + "S2": 2, + "S3": 2, + "S4": 2, + "S5": 2, + "S6": 2, + "S7": 2, + "S8": 2, + "S9": 1, + "S9.": 1, + "animation": 1, + "using": 2, + "VT100": 1, + "character": 3, + "graphics": 1, + "animate": 2, + "message.": 2, + "initialize": 2, + "cursor": 7, + "get0": 2, + "_X": 2, + "play_back": 5, + "dynamic": 1, + "location/3.": 1, + "A/B/C/D/E/F/H/I/J": 1, + "cls": 2, + "retractall": 1, + "location": 32, + "assert": 17, + "J": 1, + "draw_all.": 1, + "draw_all": 1, + "draw": 18, + "call": 1, + "Put": 1, + "way": 1, + "message": 1, + "nl.": 1, + "put": 16, + "ESC": 1, + "screen": 1, + "quickly": 1, + "video": 1, + "attributes": 1, + "bold": 1, + "blink": 1, + "not": 1, + "working": 1, + "plain": 1, + "reverse_video": 2, + "Tile": 35, + "objects": 1, + "map": 2, + "s": 1, + "Each": 1, + "should": 1, + "be": 1, + "drawn": 2, + "at": 1, + "which": 1, + "asserted": 1, + "retracted": 1, + "by": 1, + "character_map": 3, + "spot": 1, + "to": 1, + "retract": 8, + "X0": 10, + "Y0": 10, + "Xnew": 6, + "Ynew": 6, + "Obj": 26, + "plain.": 1, + "hide": 10, + "hide_row": 4, + "Y1": 8, + "X1": 8, + "draw_row": 4, + "an": 1, + "Object": 1, + "partition": 5, + "Xs": 5, + "Pivot": 4, + "Smalls": 3, + "Bigs": 3, + "@": 1, + "Rest": 4, + "quicksort": 4, + "Smaller": 2, + "Bigger": 2, "male": 3, - "(": 10, "john": 2, - ")": 10, - ".": 7, "peter": 3, "female": 2, "vick": 2, "christie": 3, "parents": 4, "brother": 1, - "X": 3, - "Y": 2, - "-": 1, - "F": 2, - "M": 2 + "turing": 1, + "Tape0": 2, + "Tape": 2, + "perform": 4, + "q0": 1, + "Ls": 12, + "Rs": 16, + "Ls1": 4, + "qf": 1, + "Q0": 2, + "Ls0": 6, + "Rs0": 6, + "symbol": 3, + "Sym": 6, + "RsRest": 2, + "once": 1, + "rule": 1, + "Q1": 2, + "NewSym": 2, + "Action": 2, + "action": 4, + "Rs1": 2, + "stay": 1, + "L": 2 }, "Python": { "from": 29, @@ -27948,7 +28290,7 @@ "Perl": 17113, "PHP": 22931, "PowerShell": 12, - "Prolog": 57, + "Prolog": 4040, "Python": 4020, "R": 14, "Racket": 269, @@ -28018,7 +28360,7 @@ "Perl": 13, "PHP": 6, "PowerShell": 2, - "Prolog": 1, + "Prolog": 6, "Python": 4, "R": 1, "Racket": 2, @@ -28045,5 +28387,5 @@ "XSLT": 1, "YAML": 1 }, - "md5": "5b0ec806dc1b637bcd265357c621011c" + "md5": "62da0e867a535d88012d4bde71ece816" } \ No newline at end of file diff --git a/samples/Prolog/calc.pl b/samples/Prolog/calc.pl new file mode 100644 index 00000000..b7492ca8 --- /dev/null +++ b/samples/Prolog/calc.pl @@ -0,0 +1,68 @@ +action_module(calculator) . + + +%[-,-,d1,-] --push(D)--> [-,-,D,-] if mode(init) +push(D) < - + mode(init), + deny([displayed(D1),mode(init)]), + affirm([displayed(D),mode(cont)]). + +%[-,-,D1,-] --push(D)--> [-,-,10*D1+D,-] if mode(cont) +push(D) < - + mode(cont), + deny(displayed(D1)), + New = 10*D1 + D, + affirm(displayed(New)). + +%[a,op,d,m] --push(clear)--> [0,nop,0,0] +push(clear) < - + deny([accumulator(A),op(O),displayed(D),memory(M),mode(X)]), + affirm([accumulator(0),op(nop),displayed(0),memory(0),mode(init)]). + +%[a,op,d,m] --push(mem_rec)--> [a,op,m,m] +push(mem_rec) < - + memory(M), + deny([displayed(D),mode(X)]), + affirm([displayed(M),mode(init)]). + +%[a,op,d,m] --push(plus)--> [op(a,d),plus,d,m] +push(plus) < - + displayed(D), + deny([accumulator(A),op(O),mode(X)]), + eval(O,A,D,V), ; use normal arithmetic, i.e., V=O(A,D) + affirm([accumulator(V),op(plus),mode(init)]). + +%[a,op,d,m] --push(minus)--> [op(a,d,minus,d,m] +push(minus) lt - + displayed(D), + deny([accumulator(A),op(O),mode(X)]), + eval(O,A,D,V), ; use normal arithmetic, i.e., V=O(A,D) + affirm([accumulator(V),op(minus),mode(init)]). + +%[a,op,d,m] --push(times)--> [op(a,d),times,d,m] +push(times) < - + displayed(D), + deny([accumulator(A),op(O),mode(X)]), + eval(O,A,D,V), ; use normal arithmetic, i.e., V=O(A,D) + affirm([accumulator(V),op(times),mode(init)]). + +%[a,op,d,m] --push(equal)--> [a,nop,op(a,d),m] +push(equal) < - + accumulator(A), + deny([op(O),displayed(D),mode(X)]), + eval(O,A,D,V), + affirm([op(nop),displayed(V),mode(init)]). + +%[a,op,d,m] --push(mem_plus)--> [a,nop,v,plus(m,v)] where v=op(a,d) +push(mem_plus) < - + accumulator(A), + deny([op(O),displayed(D),memory(M),mode(X)]), + eval(O,A,D,V), + eval(plus,M,V,V1), + affirm([op(nop),displayed(V),memory(V1),mode(init)]). + +%[a,op,d,m] --push(plus_minus)--> [a,op,-d,m] +push(clear) < - + deny([displayed(D),mode(X)]), + eval(minus,0,D,V), + affirm([displayed(V),mode(init)]). diff --git a/samples/Prolog/normal_form.pl b/samples/Prolog/normal_form.pl new file mode 100644 index 00000000..808e5221 --- /dev/null +++ b/samples/Prolog/normal_form.pl @@ -0,0 +1,94 @@ +%%----- normalize(+Wff,-NormalClauses) ------ +normalize(Wff,NormalClauses) :- + conVert(Wff,[],S), + cnF(S,T), + flatten_and(T,U), + make_clauses(U,NormalClauses). + +%%----- make a sequence out of a conjunction ----- +flatten_and(X /\ Y, F) :- + !, + flatten_and(X,A), + flatten_and(Y, B), + sequence_append(A,B,F). +flatten_and(X,X). + +%%----- make a sequence out of a disjunction ----- +flatten_or(X \/ Y, F) :- + !, + flatten_or(X,A), + flatten_or(Y,B), + sequence_append(A,B,F). +flatten_or(X,X). + + +%%----- append two sequences ------------------------------- +sequence_append((X,R),S,(X,T)) :- !, sequence_append(R,S,T). +sequence_append((X),S,(X,S)). + +%%----- separate into positive and negative literals ----------- +separate((A,B),P,N) :- + !, + (A = ~X -> N=[X|N1], + separate(B,P,N1) + ; + P=[A|P1], + separate(B,P1,N) ). +separate(A,P,N) :- + (A = ~X -> N=[X], + P = [] + ; + P=[A], + N = [] ). + +%%----- tautology ---------------------------- +tautology(P,N) :- some_occurs(N,P). + +some_occurs([F|R],B) :- + occurs(F,B) | some_occurs(R,B). + +occurs(A,[F|_]) :- + A == F, + !. +occurs(A,[_|R]) :- + occurs(A,R). + +make_clauses((A,B),C) :- + !, + flatten_or(A,F), + separate(F,P,N), + (tautology(P,N) -> + make_clauses(B,C) + ; + make_clause(P,N,D), + C = [D|R], + make_clauses(B,R) ). +make_clauses(A,C) :- + flatten_or(A,F), + separate(F,P,N), + (tautology(P,N) -> + C = [] + ; + make_clause(P,N,D), + C = [D] ). + +make_clause([],N, false :- B) :- + !, + make_sequence(N,B,','). +make_clause(P,[],H) :- + !, + make_sequence(P,H,'|'). +make_clause(P,N, H :- T) :- + make_sequence(P,H,'|'), + make_sequence(N,T,','). + +make_sequence([A],A,_) :- !. +make_sequence([F|R],(F|S),'|') :- + make_sequence(R,S,'|'). +make_sequence([F|R],(F,S),',') :- + make_sequence(R,S,','). + +write_list([F|R]) :- + write(F), write('.'), nl, + write_list(R). +write_list([]). diff --git a/samples/Prolog/puzzle.pl b/samples/Prolog/puzzle.pl new file mode 100644 index 00000000..9b0deb9c --- /dev/null +++ b/samples/Prolog/puzzle.pl @@ -0,0 +1,287 @@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%%% +%%% A* Algorithm +%%% +%%% +%%% Nodes have form S#D#F#A +%%% where S describes the state or configuration +%%% D is the depth of the node +%%% F is the evaluation function value +%%% A is the ancestor list for the node + +:- op(400,yfx,'#'). /* Node builder notation */ + +solve(State,Soln) :- f_function(State,0,F), + search([State#0#F#[]],S), reverse(S,Soln). + +f_function(State,D,F) :- h_function(State,H), + F is D + H. + +search([State#_#_#Soln|_], Soln) :- goal(State). +search([B|R],S) :- expand(B,Children), + insert_all(Children,R,Open), + search(Open,S). + +insert_all([F|R],Open1,Open3) :- insert(F,Open1,Open2), + insert_all(R,Open2,Open3). +insert_all([],Open,Open). + +insert(B,Open,Open) :- repeat_node(B,Open), ! . +insert(B,[C|R],[B,C|R]) :- cheaper(B,C), ! . +insert(B,[B1|R],[B1|S]) :- insert(B,R,S), !. +insert(B,[],[B]). + +repeat_node(P#_#_#_, [P#_#_#_|_]). + +cheaper( _#_#F1#_ , _#_#F2#_ ) :- F1 < F2. + +expand(State#D#_#S,All_My_Children) :- + bagof(Child#D1#F#[Move|S], + (D1 is D+1, + move(State,Child,Move), + f_function(Child,D1,F)), + All_My_Children). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%%% +%%% 8-puzzle solver +%%% +%%% +%%% State have form A/B/C/D/E/F/G/H/I +%%% where {A,...,I} = {0,...,8} +%%% 0 represents the empty tile +%%% + +goal(1/2/3/8/0/4/7/6/5). + +%%% The puzzle moves + +left( A/0/C/D/E/F/H/I/J , 0/A/C/D/E/F/H/I/J ). +left( A/B/C/D/0/F/H/I/J , A/B/C/0/D/F/H/I/J ). +left( A/B/C/D/E/F/H/0/J , A/B/C/D/E/F/0/H/J ). +left( A/B/0/D/E/F/H/I/J , A/0/B/D/E/F/H/I/J ). +left( A/B/C/D/E/0/H/I/J , A/B/C/D/0/E/H/I/J ). +left( A/B/C/D/E/F/H/I/0 , A/B/C/D/E/F/H/0/I ). + +up( A/B/C/0/E/F/H/I/J , 0/B/C/A/E/F/H/I/J ). +up( A/B/C/D/0/F/H/I/J , A/0/C/D/B/F/H/I/J ). +up( A/B/C/D/E/0/H/I/J , A/B/0/D/E/C/H/I/J ). +up( A/B/C/D/E/F/0/I/J , A/B/C/0/E/F/D/I/J ). +up( A/B/C/D/E/F/H/0/J , A/B/C/D/0/F/H/E/J ). +up( A/B/C/D/E/F/H/I/0 , A/B/C/D/E/0/H/I/F ). + +right( A/0/C/D/E/F/H/I/J , A/C/0/D/E/F/H/I/J ). +right( A/B/C/D/0/F/H/I/J , A/B/C/D/F/0/H/I/J ). +right( A/B/C/D/E/F/H/0/J , A/B/C/D/E/F/H/J/0 ). +right( 0/B/C/D/E/F/H/I/J , B/0/C/D/E/F/H/I/J ). +right( A/B/C/0/E/F/H/I/J , A/B/C/E/0/F/H/I/J ). +right( A/B/C/D/E/F/0/I/J , A/B/C/D/E/F/I/0/J ). + +down( A/B/C/0/E/F/H/I/J , A/B/C/H/E/F/0/I/J ). +down( A/B/C/D/0/F/H/I/J , A/B/C/D/I/F/H/0/J ). +down( A/B/C/D/E/0/H/I/J , A/B/C/D/E/J/H/I/0 ). +down( 0/B/C/D/E/F/H/I/J , D/B/C/0/E/F/H/I/J ). +down( A/0/C/D/E/F/H/I/J , A/E/C/D/0/F/H/I/J ). +down( A/B/0/D/E/F/H/I/J , A/B/F/D/E/0/H/I/J ). + +%%% the heuristic function +h_function(Puzz,H) :- p_fcn(Puzz,P), + s_fcn(Puzz,S), + H is P + 3*S. + + +%%% the move +move(P,C,left) :- left(P,C). +move(P,C,up) :- up(P,C). +move(P,C,right) :- right(P,C). +move(P,C,down) :- down(P,C). + +%%% the Manhattan distance function +p_fcn(A/B/C/D/E/F/G/H/I, P) :- + a(A,Pa), b(B,Pb), c(C,Pc), + d(D,Pd), e(E,Pe), f(F,Pf), + g(G,Pg), h(H,Ph), i(I,Pi), + P is Pa+Pb+Pc+Pd+Pe+Pf+Pg+Ph+Pg+Pi. + +a(0,0). a(1,0). a(2,1). a(3,2). a(4,3). a(5,4). a(6,3). a(7,2). a(8,1). +b(0,0). b(1,1). b(2,0). b(3,1). b(4,2). b(5,3). b(6,2). b(7,3). b(8,2). +c(0,0). c(1,2). c(2,1). c(3,0). c(4,1). c(5,2). c(6,3). c(7,4). c(8,3). +d(0,0). d(1,1). d(2,2). d(3,3). d(4,2). d(5,3). d(6,2). d(7,2). d(8,0). +e(0,0). e(1,2). e(2,1). e(3,2). e(4,1). e(5,2). e(6,1). e(7,2). e(8,1). +f(0,0). f(1,3). f(2,2). f(3,1). f(4,0). f(5,1). f(6,2). f(7,3). f(8,2). +g(0,0). g(1,2). g(2,3). g(3,4). g(4,3). g(5,2). g(6,2). g(7,0). g(8,1). +h(0,0). h(1,3). h(2,3). h(3,3). h(4,2). h(5,1). h(6,0). h(7,1). h(8,2). +i(0,0). i(1,4). i(2,3). i(3,2). i(4,1). i(5,0). i(6,1). i(7,2). i(8,3). + +%%% the out-of-cycle function +s_fcn(A/B/C/D/E/F/G/H/I, S) :- + s_aux(A,B,S1), s_aux(B,C,S2), s_aux(C,F,S3), + s_aux(F,I,S4), s_aux(I,H,S5), s_aux(H,G,S6), + s_aux(G,D,S7), s_aux(D,A,S8), s_aux(E,S9), + S is S1+S2+S3+S4+S5+S6+S7+S8+S9. + +s_aux(0,0) :- !. +s_aux(_,1). + +s_aux(X,Y,0) :- Y is X+1, !. +s_aux(8,1,0) :- !. +s_aux(_,_,2). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%%% +%%% 8-puzzle animation -- using VT100 character graphics +%%% +%%% +%%% + +puzzle(P) :- solve(P,S), + animate(P,S), + message. + +animate(P,S) :- initialize(P), + cursor(1,2), write(S), + cursor(1,22), write('Hit ENTER to step solver.'), + get0(_X), + play_back(S). + +:- dynamic location/3. + +initialize(A/B/C/D/E/F/H/I/J) :- + cls, + retractall(location(_,_,_)), + assert(location(A,20,5)), + assert(location(B,30,5)), + assert(location(C,40,5)), + assert(location(F,40,10)), + assert(location(J,40,15)), + assert(location(I,30,15)), + assert(location(H,20,15)), + assert(location(D,20,10)), + assert(location(E,30,10)), draw_all. + +draw_all :- draw(1), draw(2), draw(3), draw(4), + draw(5), draw(6), draw(7), draw(8). + +%%% play_back([left,right,up,...]). +play_back([M|R]) :- call(M), get0(_X), play_back(R). +play_back([]) :- cursor(1,24). %%% Put cursor out of the way + +message :- nl,nl, + write(' ********************************************'), nl, + write(' * Enter 8-puzzle goals in the form ... *'), nl, + write(' * ?- puzzle(0/8/1/2/4/3/7/6/5). *'), nl, + write(' * Enter goal ''message'' to reread this. *'), nl, + write(' ********************************************'), nl, nl. + + +cursor(X,Y) :- put(27), put(91), %%% ESC [ + write(Y), + put(59), %%% ; + write(X), + put(72). %%% M + +%%% clear the screen, quickly +cls :- put(27), put("["), put("2"), put("J"). + +%%% video attributes -- bold and blink not working +plain :- put(27), put("["), put("0"), put("m"). +reverse_video :- put(27), put("["), put("7"), put("m"). + + +%%% Tile objects, character map(s) +%%% Each tile should be drawn using the character map, +%%% drawn at 'location', which is asserted and retracted +%%% by 'playback'. +character_map(N, [ [' ',' ',' ',' ',' ',' ',' '], + [' ',' ',' ', N ,' ',' ',' '], + [' ',' ',' ',' ',' ',' ',' '] ]). + + +%%% move empty tile (spot) to the left +left :- retract(location(0,X0,Y0)), + Xnew is X0 - 10, + location(Tile,Xnew,Y0), + assert(location(0,Xnew,Y0)), + right(Tile),right(Tile),right(Tile), + right(Tile),right(Tile), + right(Tile),right(Tile),right(Tile), + right(Tile),right(Tile). + +up :- retract(location(0,X0,Y0)), + Ynew is Y0 - 5, + location(Tile,X0,Ynew), + assert(location(0,X0,Ynew)), + down(Tile),down(Tile),down(Tile),down(Tile),down(Tile). + +right :- retract(location(0,X0,Y0)), + Xnew is X0 + 10, + location(Tile,Xnew,Y0), + assert(location(0,Xnew,Y0)), + left(Tile),left(Tile),left(Tile),left(Tile),left(Tile), + left(Tile),left(Tile),left(Tile),left(Tile),left(Tile). + +down :- retract(location(0,X0,Y0)), + Ynew is Y0 + 5, + location(Tile,X0,Ynew), + assert(location(0,X0,Ynew)), + up(Tile),up(Tile),up(Tile),up(Tile),up(Tile). + + +draw(Obj) :- reverse_video, character_map(Obj,M), + location(Obj,X,Y), + draw(X,Y,M), plain. + +%%% hide tile +hide(Obj) :- character_map(Obj,M), + location(Obj,X,Y), + hide(X,Y,M). + +hide(_,_,[]). +hide(X,Y,[R|G]) :- hide_row(X,Y,R), + Y1 is Y + 1, + hide(X,Y1,G). + +hide_row(_,_,[]). +hide_row(X,Y,[_|R]) :- cursor(X,Y), + write(' '), + X1 is X + 1, + hide_row(X1,Y,R). + +%%% draw tile +draw(_,_,[]). +draw(X,Y,[R|G]) :- draw_row(X,Y,R), + Y1 is Y + 1, + draw(X,Y1,G). + +draw_row(_,_,[]). +draw_row(X,Y,[P|R]) :- cursor(X,Y), + write(P), + X1 is X + 1, + draw_row(X1,Y,R). + +%%% Move an Object up +up(Obj) :- hide(Obj), + retract(location(Obj,X,Y)), + Y1 is Y - 1, + assert(location(Obj,X,Y1)), + draw(Obj). + +down(Obj) :- hide(Obj), + retract(location(Obj,X,Y)), + Y1 is Y + 1, + assert(location(Obj,X,Y1)), + draw(Obj). + +left(Obj) :- hide(Obj), + retract(location(Obj,X,Y)), + X1 is X - 1, + assert(location(Obj,X1,Y)), + draw(Obj). + +right(Obj) :- hide(Obj), + retract(location(Obj,X,Y)), + X1 is X + 1, + assert(location(Obj,X1,Y)), + draw(Obj). + +:- message. diff --git a/samples/Prolog/quicksort.pl b/samples/Prolog/quicksort.pl new file mode 100644 index 00000000..eb4467b4 --- /dev/null +++ b/samples/Prolog/quicksort.pl @@ -0,0 +1,13 @@ +partition([], _, [], []). +partition([X|Xs], Pivot, Smalls, Bigs) :- + ( X @< Pivot -> + Smalls = [X|Rest], + partition(Xs, Pivot, Rest, Bigs) + ; Bigs = [X|Rest], + partition(Xs, Pivot, Smalls, Rest) + ). + +quicksort([]) --> []. +quicksort([X|Xs]) --> + { partition(Xs, X, Smaller, Bigger) }, + quicksort(Smaller), [X], quicksort(Bigger). diff --git a/samples/Prolog/turing.pl b/samples/Prolog/turing.pl new file mode 100644 index 00000000..82fe104f --- /dev/null +++ b/samples/Prolog/turing.pl @@ -0,0 +1,21 @@ +turing(Tape0, Tape) :- + perform(q0, [], Ls, Tape0, Rs), + reverse(Ls, Ls1), + append(Ls1, Rs, Tape). + +perform(qf, Ls, Ls, Rs, Rs) :- !. +perform(Q0, Ls0, Ls, Rs0, Rs) :- + symbol(Rs0, Sym, RsRest), + once(rule(Q0, Sym, Q1, NewSym, Action)), + action(Action, Ls0, Ls1, [NewSym|RsRest], Rs1), + perform(Q1, Ls1, Ls, Rs1, Rs). + +symbol([], b, []). +symbol([Sym|Rs], Sym, Rs). + +action(left, Ls0, Ls, Rs0, Rs) :- left(Ls0, Ls, Rs0, Rs). +action(stay, Ls, Ls, Rs, Rs). +action(right, Ls0, [Sym|Ls0], [Sym|Rs], Rs). + +left([], [], Rs0, [b|Rs0]). +left([L|Ls], Ls, Rs, [L|Rs]).