% FileName: fsot_riggle % Author: Jason Riggle % Last Mod: 8-20-04 % %------------------------------------------ Predicates -------------------------------------------------% % % Paste the text next to "Example:" into the prolog window and hit return to see what these do. % % Command: constraint(C,M). % Purpose: Returns the machine M=(Start,Finals,Arcs) that is named 'C'. % Example: constraint(dep,M). % % Command: draw(M). <- This'll crash if you don't have graph- % Purpose: Uses graphviz to draw M=(Start,Finals,Arcs). <- viz and ghostview propperly installed. % Example: constraint(dep,M),draw(M). % % Command: mIntersect([ConstraintList],M). % Purpose: Intersects the machines named in the ConstraintList to build M. % example: mIntersect([syl,ons,noc,dep,max],E),draw(E). % % Command: tidy(M,N). % Purpose: Cleans up machine M by removing dead-ends and dead beginnings. % Example: mIntersect([syl,ons,noc,dep,max],E),draw(E),more,tidy(E,F),draw(F). % % Command: opt(Input,Ranking,Result). % Purpose: Returns 'R', the optimal output under Ranking for the segment-list Input % Example: opt([c,v,c],[syl,ons,noc,dep,max],R). % % Command: fileEval([ConstraintList]). % Purpose: Builds Eval and writes it to the file EVAL.pl % Example: fileEval([syl,ons,dpV,max,dpC]). % After you've created EVAL.pl, to see Eval enter: eval(E),draw(E). % % Command: opt(Input). % Purpose: Optimizes using Eval from Eval.pl and prints the result to the screen. % Example: opt([c,v,c]). % % Command: preOpt([ConstraintList]). % Purpose: Preoptimizes EVAL and writes it to EVAL.pl % Example: preOpt([syl,ons,noc,dep,max]). % % Command: candidates(Input). % Purpose: Writes out a table of contender-candiates for input under EVAL.pl (assumes preopt) % Example: candidates([v,v,v,c,c,v,c]). % % Command: candidates(Input,ERCs). % Purpose: Writes out a table of contender-candiates modulo the truth of ERCs. % Example: candidates([v,v,v,c,c,v,c],[[e,w,l,e,e],[e,e,w,l,e]]). % % %-------------------------------------- BEGIN INVENTORY ---------------------------------------% %-------------------------------------- BEGIN INVENTORY ---------------------------------------% %--- Segment Inventory: % inv([a,i,u,p,m,w,t,n,l,r,x,wd,nm]). %--Lardil Lite % inv([a,i,u,p,m,t,x,nm,wd]). %--yet still lighter Lardil % inv([a,p,m,t,x,nm,wd]). %--extremely reduced Lardil % inv([a,b,x,wd]). %--use for CeeVee % inv([a,b,p,x,wrd]). % inv([a,b,x,wrd]). % inv([a,b,x]). %--use for CeeVee with no wd boundaries inv([c,v,x]). % inv([c,v]). % inv([a,b]). %--use for Baa %--- Features: sig(X):- inv(Inv),member(X,Inv). sig([]). edge(x). edge(wd). % Edges smbl(x). smbl(wd). smbl(nm). % non-phonemic symbols mrph(wrd). mrph(nm). % morpheme boundary markers null([]). % phonetically empty stuff seg(a). seg(i). seg(u). seg(p). seg(m). % Phonemes seg(w). seg(t). seg(n). seg(l). seg(r). seg(b). seg(c). seg(v). vwl(a). vwl(i). vwl(u). vwl(v). % Vowels cns(c). cns(p). cns(m). cns(w). cns(b). % Consonants cns(t). cns(n). cns(l). cns(r). voi(V):-vwl(V). voi(N):-nas(N). voi(b). voi(d). nas(m). nas(n). nas(ng). % nasals lab(p). lab(b). lab(m). lab(w). % labials cor(t). cor(n). cor(l). cor(r). % coronals %--- RESTRICTOR: "wimp(I,O)." restricts the arcs in the constraints to those that %--- use segments in the inventory and depending on the predicates in "wimpy" %--- using this predicate ommits certain I/O mappings. wimp([],[]). wimp([(N1,(O,W),N2)|T1],[(N1,(O,W),N2)|T2]):- is_list(W),inv(X),member(O,X),!,wimp(T1,T2). wimp([(N1,(I,O,W),N2)|T1],[(N1,(I,O,W),N2)|T2]):-wimpy(I,O),!,wimp(T1,T2). wimp([_|T1],T2):- wimp(T1,T2). %--- Deletion is okay for everything: wimpy(S,[]):- inv(I), member(S,I), S\=x. %--- Insertion is okay for everything but morpheme boundaries: wimpy([],S):- inv(I), member(S,I), \+mrph(S). %--- Faithful parsing is okay for everything but morpheme boundaries: wimpy(S,S):- inv(I), member(S,I), S\=x, \+mrph(S). % wimpy(p,b). %<-- put these in if you want to allow ident violations % wimpy(b,p). %<-- put these in if you want to allow ident violations %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %------------------------------------- BEGIN CONSTRAINTS -------------------------------------% %------------------------------------- BEGIN CONSTRAINTS -------------------------------------% %--- Building Constraints: arcs(Lists,Arcs):-aarcs(Lists,ArcsList),sort(ArcsList,Arcs0),wimp(Arcs0,Arcs). aarcs([],[]). aarcs([H1|T1],Arcs):- append(H1,Arcs0,Arcs),aarcs(T1,Arcs0). %------------------------------ Filters: %--- Filter for the basic CV-syllable theory problem: constraint(gn,(g0,[g0],Rk)):- set_of((g0,A,g1),cns(A),A1), set_of((g0,B,g2),vwl(B),A2), set_of((g1,C,g2),vwl(C),A3), set_of((g2,D,g0),edge(D),A4), set_of((g2,E,g3),cns(E),A5), set_of((g3,F,g0),edge(F),A6), arcs([A1,A2,A3,A4,A5,A6],Rk). %------------------------------ MARKEDNESS Constraints: %--- Penalizes consonant-consonant sequences: constraint(cc,(cc-0,[cc-0,cc-1],Rk)):- setof((cc-0,(A,[0]),cc-0),(sig(A),\+cns(A)),A1), setof((cc-0,(B,[0]),cc-1),cns(B),A2), setof((cc-1,(C,[0]),cc-0),(sig(C),\+cns(C),\+null(C)),A3), setof((cc-1,(D,[0]),cc-1),null(D),A4), setof((cc-1,(E,[1]),cc-1),cns(E),A5), arcs([A1,A2,A3,A4,A5],Rk). %--- Penalizes consonant-consonant-consonant sequences: constraint(ccc,(ccc-0,[ccc-0,ccc-1,ccc-2],Rk)):- setof((ccc-0,(A,[0]),ccc-0),(sig(A),\+cns(A)),A1), setof((ccc-0,(B,[0]),ccc-1),cns(B),A2), setof((ccc-1,(C,[0]),ccc-0),(sig(C),\+cns(C),\+null(C)),A3), setof((ccc-1,(D,[0]),ccc-1),null(D),A4), setof((ccc-1,(E,[0]),ccc-2),cns(E),A5), setof((ccc-2,(F,[0]),ccc-0),(sig(F),\+cns(F),\+null(F)),A6), setof((ccc-2,(G,[0]),ccc-2),null(G),A7), setof((ccc-2,(H,[1]),ccc-2),cns(H),A8), arcs([A1,A2,A3,A4,A5,A6,A7,A8],Rk). %--- Penalizes vowel-vowel sequences: constraint(vv,(vv-0,[vv-0,vv-1],Rk)):- setof((vv-0,(A,[0]),vv-0),(sig(A),\+vwl(A)),A1), setof((vv-0,(B,[0]),vv-1),vwl(B),A2), setof((vv-1,(C,[0]),vv-0),(sig(C),\+vwl(C),\+null(C)),A3), setof((vv-1,(D,[0]),vv-1),null(D),A4), setof((vv-1,(E,[1]),vv-1),vwl(E),A5), arcs([A1,A2,A3,A4,A5],Rk). %--- Penalizes vowel-vowel-vowel sequences: constraint(vvv,(vvv-0,[vvv-0,vvv-1,vvv-2],Rk)):- setof((vvv-0,(A,[0]),vvv-0),(sig(A),\+vwl(A)),A1), setof((vvv-0,(B,[0]),vvv-1),vwl(B),A2), setof((vvv-1,(C,[0]),vvv-0),(sig(C),\+vwl(C),\+null(C)),A3), setof((vvv-1,(D,[0]),vvv-1),null(D),A4), setof((vvv-1,(E,[0]),vvv-2),vwl(E),A5), setof((vvv-2,(F,[0]),vvv-0),(sig(F),\+vwl(F),\+null(F)),A6), setof((vvv-2,(G,[0]),vvv-2),null(G),A7), setof((vvv-2,(H,[1]),vvv-2),vwl(H),A8), arcs([A1,A2,A3,A4,A5,A6,A7,A8],Rk). %--- Penalizes VC+V: syllables with multiple vowels separated by consonants constraint(ocp,(ocp-0,[ocp-0,ocp-1,ocp-2],Rk)):- setof((ocp-0,(A,[0]),ocp-0),(sig(A),\+vwl(A)),A1), setof((ocp-0,(B,[0]),ocp-1),vwl(B),A2), setof((ocp-1,(C,[0]),ocp-0),edge(C),A3), setof((ocp-1,(D,[0]),ocp-1),(sig(D),\+edge(D),\+cns(D)),A4), setof((ocp-1,(E,[0]),ocp-2),cns(E),A5), setof((ocp-2,(F,[0]),ocp-0),edge(F),A6), setof((ocp-2,(G,[0]),ocp-2),(sig(G),\+edge(G),\+vwl(G)),A7), setof((ocp-2,(H,[1]),ocp-1),vwl(H),A8), arcs([A1,A2,A3,A4,A5,A6,A7,A8],Rk). %--- Penalizes xC*x: sylables with no vowels constraint(hNuc,(hNuc-0,[hNuc-0,hNuc-1],Rk)):- setof((hNuc-0,(A,[0]),hNuc-0),(sig(A),\+edge(A)),A1), setof((hNuc-0,(B,[0]),hNuc-1),edge(B),A2), setof((hNuc-1,(C,[0]),hNuc-0),vwl(C),A3), setof((hNuc-1,(D,[0]),hNuc-1),(sig(D),\+vwl(D),\+edge(D)),A4), setof((hNuc-1,(E,[1]),hNuc-1),edge(E),A5), arcs([A1,A2,A3,A4,A5],Rk). %--- Filter to enforce basic (c)v(c) syllable shapes: constraint(syl,(syl-0,[syl-0],Rk)):- setof((syl-0,(A,[0]),syl-1),cns(A),A1), setof((syl-0,(B,[0]),syl-2),vwl(B),A2), setof((syl-1,(C,[0]),syl-2),vwl(C),A3), setof((syl-2,(D,[0]),syl-3),cns(D),A4), setof((syl-2,(E,[0]),syl-0),edge(E),A5), setof((syl-3,(E,[0]),syl-0),edge(E),A6), arcs([A1,A2,A3,A4,A5,A6],Rk). %--- Filter to enforce (c)(c)(v)v(c)(c) syllable shapes: constraint(sy2,(syl-0,[syl-0],Rk)):- setof((syl-0,(A,[0]),syl-1),cns(A),A1), setof((syl-0,(B,[0]),syl-3),vwl(B),A2), setof((syl-1,(C,[0]),syl-2),cns(C),A3), setof((syl-1,(D,[0]),syl-3),vwl(D),A4), setof((syl-2,(E,[0]),syl-3),vwl(E),A5), setof((syl-3,(F,[0]),syl-4),vwl(F),A6), setof((syl-3,(G,[0]),syl-5),cns(G),A7), setof((syl-3,(H,[0]),syl-0),edge(H),A8), setof((syl-4,(I,[0]),syl-5),cns(I),A9), setof((syl-4,(J,[0]),syl-0),edge(J),A10), setof((syl-5,(K,[0]),syl-6),cns(K),A11), setof((syl-5,(L,[0]),syl-0),edge(L),A12), setof((syl-6,(M,[0]),syl-0),edge(M),A13), arcs([A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13],Rk). %--- Penalizes syllables without onsets: constraint(ons,(ons-0,[ons-0,ons-1],Rk)):- setof((ons-0,(A,[0]),ons-1),(sig(A),\+vwl(A),\+edge(A)),A1), setof((ons-0,(B,[1]),ons-1),vwl(B),A2), setof((ons-0,(C,[0]),ons-0),edge(C),A3), setof((ons-1,(D,[0]),ons-1),(sig(D),\+edge(D)),A4), setof((ons-1,(E,[0]),ons-0),edge(E),A5), arcs([A1,A2,A3,A4,A5],Rk). %--- Penalizes syllables with codas: constraint(noc,(noc-0,[noc-0,noc-1],Rk)):- setof((noc-0,(A,[0]),noc-0),(sig(A),\+cns(A)),A1), setof((noc-0,(B,[0]),noc-1),cns(B),A2), setof((noc-1,(C,[0]),noc-1),cns(C),A3), setof((noc-1,(D,[0]),noc-0),(sig(D),\+cns(D),\+edge(D)),A4), setof((noc-1,(E,[1]),noc-0),edge(E),A5), arcs([A1,A2,A3,A4,A5],Rk). %--- Penalizes voiced obstruents constraint(noVO,(noVO,[noVO],Rk)):- setof((noVO,(A,[0]),noVO),(sig(A),A\=b,A\=[]),A1), setof((noVO,(B,[1]),noVO),B = b,A2), arcs([A1,A2],Rk). %--- Penalizes consonants constraint(noC,(noC,[noC],Rk)):- setof((noC,(A,[0]),noC),(sig(A),\+cns(A)),A1), setof((noC,(B,[1]),noC),cns(B),A2), arcs([A1,A2],Rk). %--- Penalizes vowels constraint(noV,(noV,[noV],Rk)):- setof((noV,(A,[0]),noV),(sig(A),\+vwl(A)),A1), setof((noV,(B,[1]),noV),vwl(B),A2), arcs([A1,A2],Rk). %--- Penalizes the segment 'p': constraint(noP,(noP,[noP],Rk)):- setof((noP,(A,[0]),noP),(sig(A),A\=p,A\=[]),A1), setof((noP,(B,[1]),noP),B = p,A2), arcs([A1,A2],Rk). %--- Penalizes all segments: constraint(stk,(stk,[stk],Rk)):- setof((stk,(A,[0]),stk),(sig(A),\+seg(A)), A1), setof((stk,(B,[1]),stk),seg(B), A2), arcs([A1,A2],Rk). %------------------------------ FAITHFULNESS Constraints: constraint(max,(max,[max],Arcs)):- setof((max,(A,B,[0]),max),(sig(A),sig(B),B\=[]),A1), setof((max,(C,[],[0]),max),(sig(C),\+seg(C)),A2), setof((max,(D,[],[1]),max),seg(D),A3), arcs([A1,A2,A3],Arcs). constraint(mxC,(maxC,[maxC],Arcs)):- setof((maxC,(A,B,[0]),maxC),(sig(A),sig(B),\+cns(A)),A1), setof((maxC,(C,D,[0]),maxC),(cns(C),sig(D),D\=[]),A2), setof((maxC,(E,[],[1]),maxC),cns(E),A3), arcs([A1,A2,A3],Arcs). constraint(mxV,(maxV,[maxV],Arcs)):- setof((maxV,(A,B,[0]),maxV),(sig(A),sig(B),\+vwl(A)),A1), setof((maxV,(C,D,[0]),maxV),(vwl(C),sig(D),D\=[]),A2), setof((maxV,(E,[],[1]),maxV),vwl(E),A3), arcs([A1,A2,A3],Arcs). constraint(dep,(dep,[dep],Arcs)):- setof((dep,(A,B,[0]),dep),(sig(A),sig(B),A\=[]),A1), setof((dep,([],C,[0]),dep),(sig(C),\+seg(C)),A2), setof((dep,([],D,[1]),dep),seg(D),A3), arcs([A1,A2,A3],Arcs). constraint(dpC,(depC,[depC],Arcs)):- setof((depC,(A,B,[0]),depC),(sig(A),sig(B),\+cns(B)),A1), setof((depC,(C,D,[0]),depC),(cns(D),sig(C),C\=[]),A2), setof((depC,([],E,[1]),depC),cns(E),A3), arcs([A1,A2,A3],Arcs). constraint(dpV,(depV,[depV],Arcs)):- setof((depV,(A,B,[0]),depV),(sig(A),sig(B),\+vwl(B)),A1), setof((depV,(C,D,[0]),depV),(vwl(D),sig(C),C\=[]),A2), setof((depV,([],E,[1]),depV),vwl(E),A3), arcs([A1,A2,A3],Arcs). constraint(idt,(idt,[idt],Arcs)):- setof((idt,(A,B,[0]),idt),(sig(A),sig(B),\+vwl(B)),A1), setof((idt,(C,D,[1]),idt),(vwl(C),vwl(D),C\=D),A2), setof((idt,(E,E,[0]),idt), vwl(E),A3), arcs([A1,A2,A3],Arcs). constraint(idV,(idVoi,[idVoi],Arcs)):- set_of((idVoi,(A,B,[1]),idVoi),(seg(A),voi(A),seg(B),\+voi(B)),A1), set_of((idVoi,(C,D,[1]),idVoi),(seg(C),\+voi(C),seg(D),voi(D)),A2), set_of((idVoi,(E,F,[0]),idVoi),(seg(E),voi(E),seg(F),voi(F)),A3), set_of((idVoi,(G,H,[0]),idVoi),(seg(G),\+voi(G),seg(H),\+voi(H)),A4), set_of((idVoi,(I,J,[0]),idVoi),(sig(I),\+seg(I),sig(J)),A5), set_of((idVoi,(K,L,[0]),idVoi),(sig(K),sig(L),\+seg(L)),A6), arcs([A1,A2,A3,A4,A5,A6],Arcs). %-------------------------------------- END CONSTRAINTS --------------------------------------% %-------------------------------------- END CONSTRAINTS --------------------------------------% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %---------------------------------- BEGIN MACHINE MANIPULATION -------------------------------% %---------------------------------- BEGIN MACHINE MANIPULATION -------------------------------% %----------- Machine-Intersection: macIntersect((S1,F1,A1),(S2,F2,A2),([S1,S2],Finals,Arcs)):- fillOut(A1,A11),fillOut(A2,A22),!, setof(A,xArcs(A11,A22,A),Arcs), setof(Fin,crossFins(F1,F2,Arcs,Fin),Finals). xArcs(A1,A2,([X1,Y1],(O,[W1|W2]),[X2,Y2])):- %-mark X mark member((X1,(O,[W1]),X2),A1), member((Y1,(O,W2),Y2),A2),O\=[],is_list(W2). xArcs(A1,A2,([X1,Y1],(I,O,[W1|W2]),[X2,Y2])):- %-full X full member((X1,(I,O,[W1]),X2),A1), member((Y1,(I,O,W2),Y2),A2). xArcs(A1,A2,([X1,Y1],(I,O,[W1|W2]),[X2,Y2])):- %-mark X full member((X1,(O,[W1]),X2),A1), member((Y1,(I,O,W2),Y2),A2). xArcs(A1,A2,([X1,Y1],(I,O,[W1|W2]),[X2,Y2])):- %-full X mark member((X1,(I,O,[W1]),X2),A1), member((Y1,(O,W2),Y2),A2),is_list(W2). xArcs(A1,A2,([X1,Y1],(I,O,W),[X2,Y2])):- member((X1,(I,O,[]),X2),A1),member((Y1,(I,O,W),Y2),A2). %- For candidate generator xArcs(A1,A2,([X1,Y1],(I,O,W),[X2,Y2])):- member((X1,[I],X2),A1),member((Y1,(I,O,W),Y2),A2). %- For linear acceptor %- the list keeps it distinct crossFins(F1,F2,Arcs,[A,B]):- member(A,F1),member(B,F2), member((X,_,Y),Arcs),(X=[A,B];Y=[A,B]). fillOut([(A1,(I1,O1,W1),B1)|T1],[(A1,(I1,O1,W1),B1)|T1]). %-- Leave complete machines alone. fillOut(Ain,Aout):- getZero(Ain,Z), %-- Add null-self-loops to M-const. fill_Out(Ain,Ain,Z,Rks),sort(Rks,Aout). fill_Out([],Ain,_,Ain). fill_Out([(N1,_,N2)|T1],An,Z,[(N1,([],Z),N1)|[(N2,([],Z),N2)|T2]]):- fill_Out(T1,An,Z,T2). %------------------ Recursive Intersection: mIntersect([M|[]],Mac):-constraint(M,Mac). mIntersect([H|T1],Mac):-constraint(H,M1),mIntersect(T1,Inc),macIntersect(M1,Inc,Mac). %------------------ Cleaning up dead arcs and states: tidy((S,F0,A0),(S,F1,A1)):- reachable([S],from,A0,Nds1),reachable(F0,to,A0,Nds2), %- Find Nds reachable from S & F, intersection(Nds1,Nds2,Nodes), %- take their intersection, connected(A0,Nodes,Rk),sort(Rk,A1), %- eliminate dead arcs, connected(F0,Nodes,F1),!. %- eliminate dead nodes. reachable(IncNds,DIR,Arcs,FinNodes):- member(N,IncNds), ((DIR=from,member((N,_,NN),Arcs));(DIR=to,member((NN,_,N),Arcs))), \+member(NN,IncNds),reachable([NN|IncNds],DIR,Arcs,FinNodes). reachable(Nodes,_,_,Nodes). connected([],_,[]). connected([N|T1],Nodes,[N|T2]):- member(N,Nodes),!,connected(T1,Nodes,T2). connected([(N1,L,N2)|T1],Nodes,[(N1,L,N2)|T2]):- member(N1,Nodes),member(N2,Nodes),!,connected(T1,Nodes,T2). connected([_|T1],Nodes,T2):-connected(T1,Nodes,T2). %------------------ Writing Eval to a file: fileEval(CON):- mIntersect(CON,E0),tidy(E0,(S,F,Arcs)), tell('EVAL.pl'),write('%-- Ranking: '),print(CON),nl, write('ranking('),print(CON),write(').'),nl,nl, write('%-- Eval:'),nl,write('eval(('),print((S,F,Arcs)),write(')).'), told,compile('EVAL.pl'). %------------------ GEN of an input: g(In,(0,[F],A)):-length(In,F),makeArcs(In,0,A). makeArcs([], N, Arcs):- inv(Inv),arcsLoop(Inv,N,[],Arcs). makeArcs([I|T],N,Rk3):- NN is N +1,makeArcs(T,NN,Rk1), inv(Inv), arcsNext(Inv,N,I,Rk1,Rk2), arcsLoop(Inv,N,Rk2,Rk3). arcsLoop([],_,Arcs,Arcs). arcsLoop([H|T1],N,Arcs,[(N,([],H,[]),N)|T2]):-arcsLoop(T1,N,Arcs,T2). arcsNext([],N,I,Arcs,[(N,(I,[],[]),NN)|Arcs]):- NN is N + 1. arcsNext([H|T1],N,I,Arcs,[(N,(I,H,[]),NN)|T2]):- NN is N + 1, arcsNext(T1,N,I,Arcs,T2). %-- GEN of a single input segment with epenthesis only on the right: gRt(I,(0,[1],Rkz)):- inv(Inv),arcsNext(Inv,0,I,[],Rk1),arcsLoop(Inv,1,Rk1,Rkz). %-- liear acceptor for a string linAx(In,(0,[F],A)):- length(In,F),linAxArcs(In,0,A). linAxArcs([],_,[]). linAxArcs([H|T1],N,[(N,[H],NN)|T2]):- NN is N + 1, linAxArcs(T1,NN,T2). %------------------------------- End Machine Manipulation -----------------------------------% %------------------------------- End Machine Manipulation -----------------------------------% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %-------------------------------------- BEGIN GRAPHING ---------------------------------------% %-------------------------------------- BEGIN GRAPHING ---------------------------------------% draw((Start,Finals,Arcs)):- tell('graph.dott'), write('digraph most_recent_machine {'),nl,tab(6), write('graph [margin="0.02",size="5.5,5.5",rankdir=LR];'),nl,tab(6), write('node [shape=ellipse,peripheries=1,fontname=ITC_Bookman_Demi,fontsize=12];'),nl, tab(6),write('edge [minlen=1,fontname=ITC_Bookman_Demi,fontsize=12];'),nl,nl, printarcs(Arcs),nl,nl,!, tab(6),write('"'),nodewrite(Start),write('" [shape=egg];'), print_finals(Finals),nl, nl,nl,tab(32),write('}'),told,!, shell('dot -Tps graph.dott -o graph.ps'), win_exec('gsview32 -e graph.ps',normal). nodewrite(N0):-is_list(N0),flatten(N0,N1),nnodewrite(N1). nodewrite(N):-write(N). nnodewrite([Last]):-print(Last). nnodewrite([H|T]):-write(H),write('\\n'),nnodewrite(T). labelwrite([]):-write('<>'). labelwrite([H|[]]):-print(H). labelwrite([H|T]):-print(H),write(','),labelwrite(T). printfinals([H|[]]):- nl,tab(10),write('"'), nodewrite(H),write('"'). printfinals([H|T]):- nl,tab(10),write('"'), nodewrite(H),write('"'),printfinals(T). print_finals([H|[]]):- nl,tab(6),write('"'),nodewrite(H),write('" [peripheries=2];'). print_finals([H|T]):- nl,tab(6),write('"'),nodewrite(H),write('" [peripheries=2];'), print_finals(T). printarcs([H|[]]):- printarc(H). printarcs([H|T]):- printarc(H), printarcs(T). printarc((A,(I,O,W),B)):- write('"'),nodewrite(A),write('" -> "'),nodewrite(B), write('" [label="'),symwrite(I),write('/'),symwrite(O), write('\\n'),labelwrite(W),write('"]; '),nl. printarc((A,(O,W),B)):- write('"'),nodewrite(A),write('" -> "'),nodewrite(B), write('" [label="'),symwrite(O), write('\\n'),labelwrite(W),write('"];'),nl. printarc((A,[O],B)):- write('"'),nodewrite(A),write('" -> "'),nodewrite(B), write('" [label="'),symwrite(O),write('"];'),nl. symwrite([]):-write('-'). symwrite(S):-is_list(S),write('{'),symWrite(S). symwrite(S):-S\=c, S\=v, print(S). symwrite(v):-write('V'). symwrite(c):-write('C'). symWrite([St]):-strngWrite(St),write('}'). symWrite([H|T]):-strngWrite(H),write(','),symWrite(T). strngWrite([]):-write('-'). strngWrite([S]):-print(S),!. strngWrite([H|T]):-print(H),strngWrite(T). %--------------------------------------- End Graphing ----------------------------------------% %--------------------------------------- End Graphing ----------------------------------------% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %--------------------------------------- OPTIMIZATION ----------------------------------------% %--------------------------------------- OPTIMIZATION ----------------------------------------% %---- Adding or subtracting vecotrs: c_SUM(A,B,C) -The sum of vectors A and B is C. c_SUM([],[],[]). c_SUM([H1|T1],[H2|T2],[H3|T3]):- plus(H1,H2,H3), c_SUM(T1,T2,T3). %----------------------------------- Generating an optimal I/O pair %----------------------------------- Generating an optimal I/O pair opt(In,Ranking,Opt):- g(In,I), mIntersect(Ranking,M1), macIntersect(I,M1,M2), tidy(M2,M3),!, dijkstra(M3,NCP0), resetSubOptFins(NCP0,M3,NCP1), setCosts(NCP1,NCP2),!, gatherKand(M3,NCP2,Opt). opt(In):- eval(M1),g(In,I), macIntersect(I,M1,M2), tidy(M2,M3),!, dijkstra(M3,NCP0), resetSubOptFins(NCP0,M3,NCP1), setCosts(NCP1,NCP2),!, gatherKand(M3,NCP2,Opt),print(Opt),nl. opCst(In,Ranking,Cst):- g(In,I),mIntersect(Ranking,M1), macIntersect(I,M1,M2), tidy(M2,M3),!,dijFinc(M3,Cst). %----- Dijkstra's algorithm: --takes a machine and returns a list of (node,bestCost) pairs. dijkstra((S,_,Arcs),NdCstPairs):- Arcs = [(_,(_,_,W),_)|_], toZeroes(W,Zeroes), dijkstraLoop([(Zeroes,S)],Arcs,[],NdCstPairs). dijkstraLoop([],_,R0,Result):- flip2(R0,Result). dijkstraLoop([(C,N)|T0],Rks,Fn0,Result):- Fn1 = [(C,N)|Fn0], dijkstraUpdate(Rks,(C,N),T0,T1,Fn1), sort(T1,T2), dijkstraLoop(T2,Rks,Fn1,Result). dijkstraUpdate([],_,T,T,_). dijkstraUpdate([(N,(_i,_o,W),M)|RkT],(C,N),T0,T1,Fn):- c_SUM(W,C,V), dijkstraUpdateTail(T0,M,V,Tx),!, dijkstraUpdate(RkT,(C,N),Tx,T1,Fn). dijkstraUpdate([(N,(_i,_o,W),M)|Rkt],(C,N),T0,T1,Fn):- \+member((_,M),Fn), c_SUM(W,C,V), dijkstraUpdate(Rkt,(C,N),[(V,M)|T0],T1,Fn). dijkstraUpdate([_|Rkt],(C,N),T0,T1,Fn):- dijkstraUpdate(Rkt,(C,N),T0,T1,Fn). dijkstraUpdateTail([(C,M)|Tail],M,W,[(V,M)|Tail]):-sort([C,W],[V,_]). dijkstraUpdateTail([H|T1],M,W,[H|T2]):-dijkstraUpdateTail(T1,M,W,T2). %----- Version that just finds the cost of a cheapest final: dijFinc((S,F,Arcs),Cst):- getZero(Arcs,Zeroes), dijFincLoop([(Zeroes,S)],F,Arcs,[],Cst),!. dijFincLoop([(C,N)|T0],Fins,Rks,Fn0,Cst):- Fn1 = [(C,N)|Fn0], ( (member(N,Fins),!,Cst=C) ; (dijkstraUpdate(Rks,(C,N),T0,T1,Fn1),sort(T1,T2),dijFincLoop(T2,Fins,Rks,Fn1,Cst))). %----- Reseting Suboptimal final cost-attributes to null resetSubOptFins(NCPin,(_,F,_),NCPout):-resetSubOptFinals(NCPin,F,[init],_bs,NCPout). resetSubOptFinals([],_,Bst,Bst,[]). resetSubOptFinals([(N,C)|T1],F,HyBst,Bst,[(N,Cx)|T2]):- member(N,F),!, sort([C,HyBst],[NxBst,_]), resetSubOptFinals(T1,F,NxBst,Bst,T2), ((C=Bst,!,Cx=C);(Cx=[])). resetSubOptFinals([(N,C)|T1],F,HyBst,Bst,[(N,C)|T2]):- resetSubOptFinals(T1,F,HyBst,Bst,T2). %----- Putting the costs in sets (- makes the next predicate more general) setCosts([],[]). setCosts([(A,B)|T1],[(A,[B])|T2]):-setCosts(T1,T2). %----- Gathering candidates based on a cost-Table: gatherKand((S,F,A),D,K):- getZero(A,Z), setof(Knd,oneKand((S,F,A),[],Z,D,Knd),K). oneKand((F,Fn,_),Inc,Cst,_,(String,Cst)):- member(F,Fn),!, reverse(Inc,String). oneKand((N1,Fn,A),Inc,Cst0,D,Rslt):- member((N1,(_i,O,W),N2),A), c_SUM(Cst0,W,Cst1), member((N2,N2c),D), member(Cst1,N2c), kat(O,Inc,Ninc), oneKand((N2,Fn,A),Ninc,Cst1,D,Rslt). %------------------------------- End Basic Optimization ----------------------------% %------------------------------- End Basic Optimization ----------------------------% %------------------------------------------ Contenders %------------------------------------------ Contenders %--- Generating the contenders: contenderCand(In,Ranking,Kand):- g(In,I), mIntersect(Ranking,E), eval_renumerate(E,M1), macIntersect(I,M1,M2), tidy(M2,M3),!, % draw(M3),!, contenderNCP(M3,NCP0), % llist(NCP0),nl, resetContFins(NCP0,M3,NCP1), % llist(NCP1),nl, gatherKand(M3,NCP1,Kand),!. contenderNCP((S,_,Arcs),NdCstPairs):- Arcs = [(_,(_,_,W),_)|_],toZeroes(W,Zeroes), contenderNcpLoop([(S,[Zeroes])],Arcs,[],NdCstPairs). contenderNcpLoop([],_,Rslt,Rslt). contenderNcpLoop([(N,C)|T0],Rks,Fn,Rslt):- Fn0 = [(N,C)|Fn], updateAttributes(Rks,(N,C),T0,T1,Fn0,Fn1), contenderNcpLoop(T1,Rks,Fn1,Rslt). updateAttributes([],_,T,T,Fn,Fn). updateAttributes([(N,(_,_,W),M)|Rkt],(N,C),T0,T1,Fn0,Fn1):-!, crossAdd(C,[W],[],Valz), updateNxtAttribute(T0,Tx,Fn0,Fnx,M,Valz), updateAttributes(Rkt,(N,C),Tx,T1,Fnx,Fn1). updateAttributes([_|Rkt],(N,C),T0,T1,Fn0,Fn1):- updateAttributes(Rkt,(N,C),T0,T1,Fn0,Fn1). updateNxtAttribute([],[(M,Valz)],[],[],M,Valz). updateNxtAttribute([(N1,C1)|T1],[(N1,C1)|T2],[],T4,M,Valz):- N1 \= M, updateNxtAttribute(T1,T2,[],T4,M,Valz). updateNxtAttribute([],T2,[(N2,C2)|T3],[(N2,C2)|T4],M,Valz):- N2 \= M, updateNxtAttribute([],T2,T3,T4,M,Valz). updateNxtAttribute([(N1,C1)|T1],[(N1,C1)|T2],[(N2,C2)|T3],[(N2,C2)|T4],M,Valz):- N1 \= M, N2 \= M, updateNxtAttribute(T1,T2,T3,T4,M,Valz). updateNxtAttribute([(M,C1)|T1],[(M,Cx)|T1],Fn,Fn,M,Valz):-!, union(C1,Valz,Csts), contenders(Csts,Cx). updateNxtAttribute(Tail,NewTail,[(M,C2)|T3],T4,M,Valz):- union(C2,Valz,Csts), contenders(Csts,K),!, ((C2=K,!,Tail=NewTail,T4=[(M,C2)|T3]);(C2\=K,!,NewTail=[(M,K)|Tail],T4=T3)). %--- Fixing the finals: resetContFins(NCP0,(_,F,_),NCP1):- resetContFinals(NCP0,F,[],_,NCP1). resetContFinals([],_,AllFinz,ContFinz,[]):- sort(AllFinz,Fnz), contenders(Fnz,ContFinz). resetContFinals([(N,C)|T1],F,Inc,Bst,[(N,Cx)|T2]):- member(N,F),!, append(C,Inc,Ninc), resetContFinals(T1,F,Ninc,Bst,T2), intersection(C,Bst,Cx). resetContFinals([(N,C)|T1],F,Inc,Bst,[(N,C)|T2]):- resetContFinals(T1,F,Inc,Bst,T2). %------------------------ Contender Vectors: contenders(Vex1,VexOut):- %length(Vex1,Ln1),tab(8),print(Ln1), noDuSmp(Vex1,[],Vex2), %length(Vex2,Ln2),tab(8),print(Ln2), contenders(Vex2,Vex2,VexOut). %length(VexOut,Ln4),tab(8),print(Ln4),nl. noDuSmp([],R,Rslt):-reverse(R,Rslt). noDuSmp([V|T1],Inc,Rslt):- notSBD(T1,V),notSBD(Inc,V),!,noDuSmp(T1,[V|Inc],Rslt). noDuSmp([_|T1],Inc,Rslt):- noDuSmp(T1,Inc,Rslt). notSBD([],_). notSBD([V1|T],V2):-no_BS(V2,V1),notSBD(T,V2). no_BS([H1|_],[H2|_]):- H1 < H2. no_BS([H1|T1],[H2|T2]):- H1 >= H2, no_BS(T1,T2). contenders([],_,[]). contenders([H|T1],V,[H|T2]):- contender(H,V),!,contenders(T1,V,T2). contenders([_|T1],V,T2):-contenders(T1,V,T2). contender(V,[V]). contender(V,Lst):-nth1(N,V,Wt),ties(Lst,Wt,N,0,Ties),contender(V,Ties). ties([],_,_,1,[]). ties([H|T1],Wt,N,Q,[H|T2]):- %- The "switch" Q has to be flipped nth1(N,H,Wt),ties(T1,Wt,N,Q,T2). %- from 0 to 1 for ties to succeed, ties([H|T1],W1,N,_,T2):- %- this happens if V beats someone. nth1(N,H,W2),W1W,X=w);(L (Nd1,Nd2,[Contender-costs]) pairContend(Rks,Dtab):- getNodes(Rks,[],Nodes), initDtab(Nodes,Nodes,Rks,Dtab0), dTabLoop(Nodes,Dtab0,Dtab),!. initDtab([],_,_,[]). initDtab([H|T1],Nds,Rks,Cells):-nodeNode(Nds,H,Rks,Cls,Cells),initDtab(T1,Nds,Rks,Cls). nodeNode([],_,_,Cells,Cells). nodeNode([N|T1],NN,Rks,Cls,[(N,NN,Ctnd)|T2]):- set_of(W,ndndWt(N,NN,Rks,W),Vex), contenders(Vex,Ctnd),nodeNode(T1,NN,Rks,Cls,T2). ndndWt(N,NN,Rks,W):-member((N,(_,_,W),NN),Rks). dTabLoop([],Dtab,Dtab). dTabLoop([H|T],Dtab0,Dtab):-updaTable(Dtab0,Dtab0,H,Dtab1),dTabLoop(T,Dtab1,Dtab). updaTable([],_,_,[]). updaTable([(N1,N2,C0)|T1],Dtab,Int,[(N1,N2,Ctnd)|T2]):- member((N1,Int,C1),Dtab),member((Int,N2,C2),Dtab),crossAdd(C1,C2,[],C3), union(C0,C3,C4),contenders(C4,Ctnd),updaTable(T1,Dtab,Int,T2). crossAdd([],_,R0,Rslt):-sort(R0,Rslt). crossAdd([H|T1],L2,Inc,Rslt):-xAd(L2,H,Inc,Nx),crossAdd(T1,L2,Nx,Rslt). xAd([],_,Inc,Inc). xAd([C1|T1],C2,Inc,[C3|T2]):-c_SUM(C1,C2,C3),xAd(T1,C2,Inc,T2). %------------------------------- End Contenders --------------------------------% %------------------------------- End Contenders --------------------------------% %------------------------------- End Contenders --------------------------------% %---------------------------- Stratified Dijkstra: %---- Re-Keying cost vectors according to a stratified ranking: reKey(C,K):-key(Strat,Orig),newKey(Strat,[],K,Orig,C). newKey([],Inc,Key,_,_):-reverse(Inc,Key). newKey([H|T],Inc,Key,Orig,C):- stratSum(H,0,K,Orig,C),newKey(T,[K|Inc],Key,Orig,C). stratSum([],R,R,_,_). stratSum([H|T],Inc,Rslt,Orig,C):- nth1(N,Orig,H),nth1(N,C,V), Nx is Inc + V,stratSum(T,Nx,Rslt,Orig,C). writeKey(R):- tell('key.pl'), write('% Ranking Key: '),nl,nl, write('key(['),keyWriter(R),write('],'),print(R),write(').'), told,compile('key.pl'). keyWriter([C]):-write('['),print(C),write(']'). keyWriter([H|T]):-write('['),print(H),write('],'),keyWriter(T). %------------ Stratified Dijkstra: dStrat((S,F,Rks),NdCstPairs):- key(_,Org),toZeroes(Org,Z), dStratLoop([(S,[Z])],[],Rks,NdCstPairs0), killSubOptFinalCosts(F,[],F,NdCstPairs0,NdCstPairs). dStratLoop([],Rslt,_Rk,Rslt). dStratLoop([(N,C)|T0],Fn,Rks,Rslt):- Fn0 = [(N,C)|Fn], updatStrat(Rks,(N,C),T0,T1,Fn0,Fn1), dStratLoop(T1,Fn1,Rks,Rslt). updatStrat([],_,T,T,F,F). updatStrat([(N,(_i,_o,W),M)|T],(N,C),T0,T1,Fn0,Fn1):- N\=M, crossAdd(C,[W],[],NewCosts), uppers(M,NewCosts,T0,Tx,Fn0,Fnx), updatStrat(T,(N,C),Tx,T1,Fnx,Fn1). updatStrat([_|T],(N,C),Est0,Est1,Inc0,Inc1):- updatStrat(T,(N,C),Est0,Est1,Inc0,Inc1). uppers(M,NewCosts,T0,Tx,Fn,Fn):- member((M,OldCosts),T0),!, union(NewCosts,OldCosts,Costs), bestAtKey(Costs,BestCosts), ( (BestCosts = OldCosts,!, T0 = Tx) ; (delete(T0,(M,OldCosts),T1),append(T1,[(M,BestCosts)],Tx))). uppers(M,NewCosts,T0,Tx,Fn0,Fnx):- member((M,OldCosts),Fn0),!, union(NewCosts,OldCosts,Costs), bestAtKey(Costs,BestCosts), ( (BestCosts = OldCosts,!, T0 = Tx, Fn0 = Fnx) ; (delete(Fn0,(M,OldCosts),Fnx), append(T0,[(M,BestCosts)],Tx))). uppers(M,NewCosts,T0,Tx,F,F):- append(T0,[(M,NewCosts)],Tx). %--- Sorting out the final costs: killSubOptFinalCosts([],FinCosts,F,NdCstPairs0,NdCstPairs):- sort(FinCosts,Finz), bestAtKey(Finz,BestFinz), fixBestFinz(NdCstPairs0,F,BestFinz,NdCstPairs). killSubOptFinalCosts([H|T],Inc,F,NdCstPairs0,NdCstPairs):- member((H,C),NdCstPairs0), append(C,Inc,Ninc), killSubOptFinalCosts(T,Ninc,F,NdCstPairs0,NdCstPairs). fixBestFinz([],_,_,[]). fixBestFinz([(N,C0)|T1],Finz,BestC,[(N,C1)|T2]):- member(N,Finz),!, fixFinCosts(C0,BestC,C1), fixBestFinz(T1,Finz,BestC,T2). fixBestFinz([(N,C)|T1],Finz,BestC,[(N,C)|T2]):- fixBestFinz(T1,Finz,BestC,T2). fixFinCosts([],_,[]). fixFinCosts([H|T1],BestC,[H|T2]):- member(H,BestC),!, fixFinCosts(T1,BestC,T2). fixFinCosts([_|T1],BestC,T2):- fixFinCosts(T1,BestC,T2). %---- Get the set of best vectors at the KEY value bestAtKey(Vin,Vout):- bestAtKey(Vin,[],Vout0),sort(Vout0,Vout). bestAtKey([],ReKeyed,Vout):- sort(ReKeyed,[(BestKey,_)|_]), set_of(V,member((BestKey,V),ReKeyed),Vout). bestAtKey([V|T],Inc,Rslt):- reKey(V,K),bestAtKey(T,[(K,V)|Inc],Rslt). %-------------------------------------- END OPTIMIZATION --------------------------------------% %-------------------------------------- END OPTIMIZATION --------------------------------------% %-------------------------------------- END OPTIMIZATION --------------------------------------% %------------------------ Preoptimization: preOpt(C):-(member(dep,C);member(depV,C);(write(' YOU FORGOT DEP!'),nl)), mIntersect(C,Eval), tidy(Eval,(S,F,A)), %draw((S,F,A)),more, inv(I),preOptArcs(I,(S,F,A),[],Arcs,epLR), tell('EVAL.pl'),write('%-- Ranking: '),print(C),nl, write('ranking('),print(C),write(').'),nl,nl, write('%-- Eval:'),nl,write('eval(('),print((S,F,Arcs)),write(')).'), told,compile('EVAL.pl'). prEopt(C):-(member(dep,C);member(depV,C);(write(' YOU FORGOT DEP!'),nl)), mIntersect(C,Eval), tidy(Eval,(S0,F0,A0)), %draw((S,F,A)),more, eval_renumerate((S0,F0,A0),(S,F,A)), inv(I),preOptArcs(I,(S,F,A),[],Arcs,epLR), tell('EVAL.pl'),write('%-- Ranking: '),print(C),nl, write('ranking('),print(C),write(').'),nl,nl, write('%-- Eval:'),nl,write('eval(('),print((S,F,Arcs)),write(')).'), told,compile('EVAL.pl'). preOpera(C):-(member(dep,C);member(depV,C);(write(' YOU FORGOT DEP!'),nl)), mIntersect(C,Eval), tidy(Eval,(S0,F0,A0)), %draw((S,F,A)),more, eval_renumerate((S0,F0,A0),(S,F,A)), inv(I),preOptArcs(I,(S,F,A),[],Arcs,epRt), tell('EVAL.pl'),write('%-- Ranking: '),print(C),nl, write('ranking('),print(C),write(').'),nl,nl, write('%-- Eval:'),nl,write('eval(('),print((S,F,Arcs)),write(')).'), told,compile('EVAL.pl'). preOptArcs([],_,Result,Result,_). preOptArcs([In|T],Eval,Inc,Result,epLR):- g([In],M1), macIntersect(M1,Eval,(_,_,Rks)), pairContend(Rks,Dtab),!, makeArcs(Dtab,In,Rks,Inc,Nx), preOptArcs(T,Eval,Nx,Result,epLR). preOptArcs([In|T],Eval,Inc,Result,epRt):- gRt(In,M1), macIntersect(M1,Eval,(_,_,Rks)), pairContend(Rks,Dtab),!, makeArcs(Dtab,In,Rks,Inc,Nx), preOptArcs(T,Eval,Nx,Result,epRt). makeArcs([],_,_,Arcs,Arcs). makeArcs([([0,N1],[1,N2],Ctnd)|T1],In,Rks,Inc,Arcs):- Ctnd\=[],arcMaker(Ctnd,[0,N1],[1,N2],In,Rks,Inc,Nx),makeArcs(T1,In,Rks,Nx,Arcs). makeArcs([_|T1],In,Rks,Inc,T2):-makeArcs(T1,In,Rks,Inc,T2). arcMaker([],_,_,_,_,Inc,Inc). arcMaker([W|T1],[0,N1],[1,N2],I,Rks,Inc,[(N1,(I,Outs,W),N2)|T2]):- toZeroes(W,Z),setof(Out,makeOut([0,N1],Z,[1,N2],W,[],Rks,Out),Outs), arcMaker(T1,[0,N1],[1,N2],I,Rks,Inc,T2). makeOut(N,W,N,W,Inc,_,Out):-reverse(Inc,Out). makeOut(CrNd,CrWt,DsNd,DsWt,CrStng,Arcs,Out):- member((CrNd,(_,O,W),NxNd),Arcs), c_SUM(CrWt,W,NxWt), inBounds(NxWt,DsWt),kat(O,CrStng,NxStng), makeOut(NxNd,NxWt,DsNd,DsWt,NxStng,Arcs,Out). inBounds([],[]). %- makes sure than no coordinate inBounds([H1|T1],[H2|T2]):- H1 =< H2,inBounds(T1,T2). %- H1 has exceeded target weight %-------------------------------- END PREOPTIMIZATION ------------------------------% %-------------------------------- END PREOPTIMIZATION ------------------------------% %-------------------------------- END PREOPTIMIZATION ------------------------------% %-------------------------------- Contenders as Candidates --------------------------------------% %-------------------------------- Contenders as Candidates --------------------------------------% candidates(Inpt):- candidates(Inpt,_),!. cando(Inpt):-candidates(Inpt,[W|L]), toERCs(L,W,ERCs),nl,llist(ERCs). candidates(Inpt,Vex):- candiLoop(Inpt,0,[],(S,F,Arcs)), %draw((S,F,Arcs)),more, getZero(Arcs,Zro),!,candCostLoop(Arcs,[(S,[Zro],c)],Costs), contenderFinCosts(Costs,F,[],ConCost0),sort(ConCost0,ConCosts), ranking(R),write('|/'),strngWrite(Inpt),write('/'),write('|'),tabRow(R),nl, candidateTable(ConCosts,1,Zro,S,F,Arcs), getVex(ConCosts,Vex). candidatesNoDisp(Inpt,Vex):- candiLoop(Inpt,0,[],(S,F,Arcs)), getZero(Arcs,Zro),!,candCostLoop(Arcs,[(S,[Zro],c)],Costs), contenderFinCosts(Costs,F,[],ConCost0),sort(ConCost0,ConCosts), ConCosts = [H|Tcon],annoWLE(Tcon,H,ConCosts1),getVex(ConCosts1,Vex),!. %---- Crossing the input with preoptimized Eval: candiLoop([],N,Rks,M):-eval((S,F,_)),finFinz(F,N,FINZ),tidy(([0,S],FINZ,Rks),M). candiLoop([H|T],N,IncRks,M):- eval((_,_,Arcs)), NN is N + 1, set_of(A,nxtArc(H,N,NN,Arcs,A),Rkz), append(Rkz,IncRks,NxtRks),candiLoop(T,NN,NxtRks,M). nxtArc(I,N,NN,Arcs,([N,A],(I,O,W),[NN,B])):- member((A,(I,O,W),B),Arcs). finFinz([],_,[]). finFinz([H|T1],N,[[N,H]|T2]):-finFinz(T1,N,T2). %---- Best cost to each node: candCostLoop([],Rslt0,Rslt):-remSwitch(Rslt0,Rslt). candCostLoop([(N1,(_,_,W),N2)|T],FiNdz,Rslt):- member((N1,N1cc,c),FiNdz), crossAdd([W],N1cc,[],New20), ( ( member((N2,N2cc,Q),FiNdz),!, union(N2cc,New20,New21), delete(FiNdz,(N2,N2cc,Q),FiNdz1), candCostLoop(T,[(N2,New21,Q)|FiNdz1],Rslt) ) ; ( candCostLoop(T,[(N2,New20,n)|FiNdz],Rslt))). candCostLoop([(N1,(_,_,W),N2)|T],FiNdz,Rslt):- member((N1,N1cc,n),FiNdz), delete(FiNdz,(N1,N1cc,n),FiNdz1), contenders(N1cc,Cont), crossAdd([W],Cont,[],New20), ( ( member((N2,N2cc,Q),FiNdz1),!, union(N2cc,New20,New21), delete(FiNdz1,(N2,N2cc,Q),FiNdz2), candCostLoop(T,[(N2,New21,Q)|[(N1,Cont,c)|FiNdz2]],Rslt) ) ; ( candCostLoop(T,[(N2,New20,n)|[(N1,Cont,c)|FiNdz1]],Rslt))). %---- Contender costs at the finals: contenderFinCosts([],_,Inc,ConCosts):-contenders(Inc,ConCosts). contenderFinCosts([(Nd,_)|T1],F,Inc,ConCosts):- \+member(Nd,F),contenderFinCosts(T1,F,Inc,ConCosts). contenderFinCosts([(Fn,Csts)|T1],F,Inc,ConCosts):- member(Fn,F),union(Csts,Inc,Ninc),contenderFinCosts(T1,F,Ninc,ConCosts). %---- Annotating with ERCs: annoWLE([],_,[]). annoWLE([W|T1],W,[W|T2]):-annoWLE(T1,W,T2). annoWLE([L|T1],W,[La|T2]):-annot(L,W,La),annoWLE(T1,W,T2). annot([],[],[]). annot([H1|T1],[H2|T2],[(H1,w)|T3]):- H2 < H1, annot(T1,T2,T3). annot([H1|T1],[H2|T2],[(H1,l)|T3]):- H2 > H1, annot(T1,T2,T3). annot([H1|T1],[H2|T2],[(H1,e)|T3]):- H2 = H1, annot(T1,T2,T3). %---- Making a table of candidates: tabRow([H]):-print(H). tabRow([H|T]):-print(H),write('|'),tabRow(T). rankTab([C]):-print(C). rankTab([C|T]):- print(C),atom_chars(C,Cc),length(Cc,L), Tb is 4 - L,tab(Tb),write('- '),rankTab(T). rankTabMult(0,R):-rankTab(R). rankTabMult(Iln,R):-rankTab(R),write('-'),N is Iln-1, rankTabMult(N,R). cosTab([(N,L)]):- print(N),write('/'),lint(L),tab(1),write('- '). cosTab([N]):- print(N). cosTab([(N,L)|T]):- print(N),write('/'),lint(L),tab(1),write('- '),cosTab(T). cosTab([N|T]):- print(N),tab(0),write('|'),cosTab(T). lint(e):-write('e'). lint(l):-write('L'). lint(w):-write('W'). candidateTable([],_,_,_,_,_). candidateTable([C|T],N,Z,S,F,A):- print(N), NN is N+1, ((N>9,write(' |'));write(' |')), reducArit(C,2,CC), setof(Kand,cando(S,Z,F,CC,A,[],Kand),Strings), linWdPrint(Strings),write('|'),cosTab(C),nl,candidateTable(T,NN,Z,S,F,A). cando(N,TrgWt,Finz,TrgWt,_Rks,Inc,Kand):- member(N,Finz),reverse(Inc,Kn0),flatten(Kn0,Kand). %atom_chars(Kand,Kn1). cando(N,CrnWt,Finz,TrgWt,Arcs,Inc,Kand):- member((N,(_,Outs,RkWt),NN),Arcs), c_SUM(CrnWt,RkWt,NxWt), inBounds(NxWt,TrgWt), member(O,Outs),kat(O,Inc,Ninc), cando(NN,NxWt,Finz,TrgWt,Arcs,Ninc,Kand). reducArit([],_,[]). reducArit([(A,_)|T1],2,[A|T2]):- reducArit(T1,2,T2). reducArit([(_,B)|T1],1,[B|T2]):- reducArit(T1,1,T2). reducArit([X|T1],N,[X|T2]):- reducArit(T1,N,T2). getVex([],[]). getVex([H1|T1],[H2|T2]):-reducArit(H1,1,H2),getVex(T1,T2). linWdPrint([Wd]):- wdPrint(Wd). linWdPrint([H|T]):- wdPrint(H),write(', '),linWdPrint(T). wdPrint([x]). wdPrint([]). wdPrint([H|T]):-symPrnt(H),wdPrint(T). symPrnt(x):-write('.'). symPrnt(X):-print(X). %-------------------------------------- Working with ERCs ---------------------------------------% %-------------------------------------- Working with ERCs ---------------------------------------% %-- not_ent(A,B) is true iff A is not entailed by B: not_ent([l|_],[e|_]). not_ent([e|_],[w|_]). not_ent([l|_],[w|_]). not_ent([_|T1],[_|T2]):-not_ent(T1,T2). ent([],Inc,Rslt):-member(l,Inc),member(w,Inc),reverse(Inc,Rslt),!. ent([X|T1],Inc,Rslt):-ent(T1,[X|Inc],Rslt). ent([_|T1],Inc,Rslt):-ent(T1,[w|Inc],Rslt). ent([l|T1],Inc,Rslt):-ent(T1,[e|Inc],Rslt). ent([l|T1],Inc,Rslt):-ent(T1,[w|Inc],Rslt). %-- notEnt(Set,Rg) is true iff Rg is not entailed by any member of Set: notEnt([],_). notEnt([H|T],Rg):-not_ent(Rg,H),!,notEnt(T,Rg). %-- remEnt(In,[],Out) removes all entailed members of In to produce Out remEnt([],O,Out):-reverse(O,Out). remEnt([H|T],Inc,Out):-notEnt(T,H),notEnt(Inc,H),!,remEnt(T,[H|Inc],Out). remEnt([_|T],Inc,Out):-remEnt(T,Inc,Out). %-- fuse(A,B,C) yields C where C is the fusion of A an B: fuse([],[],[]). fuse([w|T1],[w|T2],[w|T3]):-fuse(T1,T2,T3). fuse([e|T1],[X|T2],[X|T3]):-!,fuse(T1,T2,T3). fuse([X|T1],[e|T2],[X|T3]):-!,fuse(T1,T2,T3). fuse([l|T1],[_|T2],[l|T3]):-!,fuse(T1,T2,T3). fuse([_|T1],[l|T2],[l|T3]):-!,fuse(T1,T2,T3). fuseMany([H|T],Rslt):-fuseMany(T,H,Rslt). fuseMany([],Rslt,Rslt). fuseMany([H|T],Inc0,Rslt):- fuse(H,Inc0,Inc), fuseMany(T,Inc,Rslt). newArgz(Vex,Argz):-set_of(A,newRg(Vex,Vex,[],A),Argz),!. newRg([],ERC,[A|[B|C]],Rslt):-fuseMany([A|[B|C]],Rslt),notEnt(ERC,Rslt). newRg([X|T],ERC,Inc,Rslt):- newRg(T,ERC,[X|Inc],Rslt). newRg([_|T],ERC,Inc,Rslt):- newRg(T,ERC,Inc,Rslt). fusRgz(Vex,Argz):-set_of(A,fusRg(Vex,[],A),Argz),!. fusRg([],[A|[B|C]],Rslt):-fuseMany([A|[B|C]],Rslt). fusRg([X|T],Inc,Rslt):- fusRg(T,[X|Inc],Rslt). fusRg([_|T],Inc,Rslt):- fusRg(T,Inc,Rslt). entRgz(Vex,Argz):- entRgz(Vex,[],Argz). entRgz([],A,Argz):- sort(A,Argz). entRgz([H|T],Inc,Argz):- setof(A,ent(H,[],A),Narg),append(Inc,Narg,Ninc),entRgz(T,Ninc,Argz). %--- learner: learn:-learn([b,a]). learn(In):- candidates(In,Vex), tell('brain.pl'),write('knowledge('),print(Vex),write(').'),told, learnLoop. learnLoop:- compile('brain.pl'), nl,write('Give me an input in the form "input."'),nl, read(X),atom_chars(X,In), knowledge(Vex0o),sort(Vex0o,Vex0), candidates(In,Vex1), write('Starting knowledge base: '),length(Vex0,L0),print(L0),nl, write('Clauses for '),print(X),write(': '),length(Vex1,L1),print(L1),nl, vexList(Vex1), append(Vex0,Vex1,Vex2), write('Combined clauses: '),length(Vex2,L2),print(L2),nl, %vexList(Vex2), remEnt(Vex2,[],Vex3), ( ( Vex3 = Vex0,!,write('Removing the entailments yields starting knowledge base.'), nl,vexList(Vex3), write('------------------------------------------'),nl,learnLoop ) ; ( write('After removing entailments: '),length(Vex3,L3), print(L3),nl, %vexList(Vex3), set_of(A,newRg(Vex3,Vex3,[],A),Argz),append(Argz,Vex3,Vex4o),sort(Vex4o,Vex4), vexList(Argz),nl, write('After fusion: '),length(Vex4,L4),print(L4),nl, remEnt(Vex4,[],Vex5), ( ( Vex5 = Vex0, !,write('Removing the entailments yields starting knowledge base.'), nl,vexList(Vex5), write('------------------------------------------'),nl,learnLoop ) ; ( write('After removing entailments: '),length(Vex5,L5),print(L5),nl, vexList(Vex5), write('------------------------------------------'),nl, tell('brain.pl'),write('knowledge('),print(Vex5),write(').'),told,sleep(1), learnLoop ) ) ) ). newClauses(X,X,X):- write('-- Nothing new discoverd.'),nl. newClauses(X,Y,Z):- X\=Y, set_of(A,newRg(X,X,[],A),Argz),append(Argz,X,Z). vexList([]). vexList([[_|H]|T]):-tab(6),print(H),nl,vexList(T). %------------------------------------ Detritus & Misclenea ------------------------------------% %------------------------------------ Detritus & Misclenea ------------------------------------% %-- Get a random element out of a list: (result is a one-item list). randomElement([],[]). randomElement(Lst,E):-length(Lst,Ln),random(0,Ln,N),getEle(0,N,Lst,E). getEle(N,N,[H|_],[H]). getEle(N,Trg,[_|T],Rslt):- NN is N +1, getEle(NN,Trg,T,Rslt). %-- Flip a list of pairs: flip2([],[]). flip2([(A,B)|T1],[(B,A)|T2]):-flip2(T1,T2). %-- Enumeration of strings built from an alphabet: enum(Alphabet,[Symbl]):- member(Symbl,Alphabet). enum(Alphabet,[S|Seq]):- enum(Alphabet,Seq),member(S,Alphabet). %-- Prompt: more:-write(' More?'),nl,get_single_char(X),X=_. %-- Redraw: redraw:- shell('dot -Tps graph.dott -o graph.ps'), win_exec('gsview32 -e graph.ps',normal). %---- Numbers forever: num(N):-num(1,N). num(N,N). num(N,Out):-NN is N+1, num(NN,Out). %-- List: llist([]). llist([H|T]):-print(H),nl,llist(T). %-- List items on a line: linPrint([T]):-print(T). linPrint([H|T]):-print(H),write(', '),linPrint(T). %-- List to string: listrng([T]):-print(T). listrng([H|T]):-print(H),listrng(T). %-- Tabbed list with commas: llist([H],_):-write('['),print(H),write(']'). llist([H|T],N):-write('['),print(H),write('],'),nl,tab(N),llist(T,N). %-- ToZeroes: toZeroes([],[]). toZeroes([_|T1],[0|T2]):-toZeroes(T1,T2). getZero([(_,(_,_,W),_)|_],Z):-toZeroes(W,Z),!. getZero([(_,(_,W),_)|_],Z):-toZeroes(W,Z),!. %-- Zeroes for free variation: getVarZro(Input,Zro):- length([0|Input],L1),ranking(R),length(R,L2), L3 is L1 * L2, makeZeroes(L3,Zro). makeZeroes(0,[]). makeZeroes(N,[0|T]):- NN is N - 1, makeZeroes(NN,T). %-- set_of predicate that returns [] when the set is empty: set_of(X,Predicates,Set):-setof(X,Predicates,Set). set_of(_,_,[]). %-- getNodes getNodes([],Inc,Nodes):-sort(Inc,Nodes). getNodes([(N,_,NN)|T1],Inc,Nodes):- getNodes(T1,[N|[NN|Inc]],Nodes). %-- concatenate: kat([],L,L). kat(S,L,[S|L]):- S\=[]. %-- remSwitch remSwitch([],[]). remSwitch([(X,Y,_)|T1],[(X,Y)|T2]):-remSwitch(T1,T2). %-- Permute List: ranP([],[]):-!. ranP(In,[X|Rn]):- length(In,L), random(0,L,N), nth0(N,In,X), delete(In,X,Nxt), ranP(Nxt,Rn). %-- Renumerating the nodes of eval eval_renumerate((StartIn,FinIn,ArcsIn),(StartOut,FinOut,ArcsOut)):- getNodes(ArcsIn,[],Nodes0), delete(Nodes0,StartIn,Nodes), newEvalNames([StartIn|Nodes],0,O_N_Pairs), renamEnode(StartIn,O_N_Pairs,StartOut), renamEfins(FinIn,O_N_Pairs,FinOut), renamEarcs(ArcsIn,O_N_Pairs,ArcsOut). newEvalNames([],_,[]). newEvalNames([Nd|T1],N,[(Nd,NewNd)|T2]):- unsegment([e,v,N],NewNd),NN is N + 1, newEvalNames(T1,NN,T2). unsegment(ListOfSegs,Word):- un_segment(ListOfSegs,C_codes),name(Word,C_codes). un_segment([],[]). un_segment([H|T],[X|W0]):-name(H,[X]),un_segment(T,W0). un_segment([H|T],W):-name(H,X),append(X,W0,W),un_segment(T,W0). renamEnode(NdIn,O_N_Pairs,NdOut):-member((NdIn,NdOut),O_N_Pairs). renamEfins([],_,[]). renamEfins([H1|T1],O_N_Pairs,[H2|T2]):- renamEnode(H1,O_N_Pairs,H2),renamEfins(T1,O_N_Pairs,T2). renamEarcs([],_,[]). renamEarcs([(A,L,B)|T1],Pairs,[(X,L,Y)|T2]):- renamEnode(A,Pairs,X),renamEnode(B,Pairs,Y),renamEarcs(T1,Pairs,T2). %--------------------------------------- End Detritus ----------------------------------------% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %----------------------------------------- LEARNING ------------------------------------------% %----------------------------------------- LEARNING ------------------------------------------% lrn:- tell('trials.pl'),write('% Trial Results:'),nl,told, tell('LEX.pl'),write('% LEXICON'),nl,told, %CON = [sy2,ons,noc,mxV,mxC,dpV,dpC,cc,vv,noC,noV], CON = [syl,ons,noc,max,dpV,dpC], lexi(CON,[c,v],5,Siz), write('There are '),print(Siz),write(' items in the lexicon.'),nl,nl,!, learnTrials(1,CON,Siz). %--- The predictate lexi takes a set of constraints CON, a segment inventory Inv, and %--- a length-limit lmt and writes the file 'LEX.pl' that numbers the strings in the %--- enumeration up to lenght lmt and includes for each its set of contender vectors. lexi(CON,Inv,Lmt,Size):- buildLEX(CON,Inv,Lmt),!,sleep(1), setof((X,Y),lex(X,Y),LexList), tell('LEX.pl'), numberLEX(LexList,1,Size), told,compile('LEX.pl'). numberLEX([(X,Y)],N,N):- write('lex('),print(N),write(','),print(X),write(','),print(Y),write(').'),nl. numberLEX([(X,Y)|T],N,Size):- write('lex('),print(N),write(','),print(X),write(','),print(Y),write(').'),nl, NN is N + 1, numberLEX(T,NN,Size). buildLEX(CON,Inv,N):- End is N + 1, mIntersect(CON,E0),!, enum(Inv,In),length(In,Ln), ((Ln=End,compile('LEX.pl')); (contenderVEX(In,E0,Vex), append('LEX.pl'), write('lex('),print(In),write(', '),print(Vex),write(').'),nl,told, fail)). contenderVEX(In,E0,Vex):- g(In,I),macIntersect(I,E0,M0),tidy(M0,(S,F,A)),!, contenderNCP((S,F,A),NCP0),vexAtFins(NCP0,F,[],V0),contenders(V0,Vex),!. vexAtFins([],_,Inc,Rslt):- sort(Inc,Rslt). vexAtFins([(N,C)|T1],F,Inc,Rslt):- member(N,F),!, append(C,Inc,Ninc),vexAtFins(T1,F,Ninc,Rslt). vexAtFins([_|T1],F,Inc,Rslt):- vexAtFins(T1,F,Inc,Rslt). %---------------------- Enter one of these to run the learner: %learnTrials(1,[sy2,ons,noc,mxV,mxC,dpV,dpC,cc,vv,noC,noV],62). %learnTrials(1,[syl,ons,noc,max,dpV,dpC],62). %---------------------- learnTrials(N,CON,Siz):- ranP(CON,Rank), nl,write('Trial #'),print(N),write(' ranking: '),print(Rank),nl, append('trials.pl'),write('trial('),print(N),write(','),print(Rank),write(',['),told, learnTrialoop(1,Siz,CON,Rank,[],0), %-- 2 or 0 --% append('trials.pl'),write(']).'),nl,told, NN is N + 1, sleep(0), learnTrials(NN,CON,Siz). learnTrialoop(N,Siz,CON,Rank,ERC0,K):- SS is Siz + 1, random(1,SS,Rn), lex(Rn,In,Vx), %--For RandomLearner: contendERCs(Vx,ERC0,NarrowVex), randomElement(NarrowVex,OneVek), %--returns a list with one element write('--- Observation #'),print(N),write(' is: '),print(In),nl, getOptCst(In,CON,Rank,Cst), write('Optimal cost: '),print(Cst),nl, (member(Cst,Vx);(write('FAILURE!!!'),more)), %--For RandomLearner: toERCs(OneVek,Cst,ERCs), % toERCs(Vx,Cst,ERCs), %--Take out for randomLearner brainiERC(ERC0,ERCs,NERCs,Change),!, ((Change=no,KK=K);(Change=yes,coverage(Siz,NERCs,0,KK))), % ((KK=0,write('--- Zero Coverage ---'),sleep(1));K\=0), write('Coverage: '),print(KK),nl, ( (KK=Siz,!,append('trials.pl'),write('('),print(N), write(','),strngWrite(In),write(','),print(KK),write(')'),told) ; (append('trials.pl'),write('('),print(N),write(','),strngWrite(In), write(','),print(KK),write('),'), told,NN is N + 1, learnTrialoop(NN,Siz,CON,Rank,NERCs,KK))). coverage(0,_,K,K). coverage(N,ERCs,Inc,Rslt):- lex(N,In,Vex), In=_, contendERCs(Vex,ERCs,Out),length(Out,Lo), ((Lo<2, % print(In),write(' covered'),nl, Ninc is Inc +1); (Lo>1, % print(In),write(' NOT covered'),nl, % llist(Out), Ninc=Inc)), M is N - 1, coverage(M,ERCs,Ninc,Rslt). %------- getOptCst(In,CON,Rank,Cst):- lex(_,In,Vex0), translateVex(Vex0,Rank,CON,Vex1), %-- Translate to Rank to find winner sort(Vex1,[Winner|_]), translate(CON,Rank,Winner,Cst),!. %-- Translate back to CON for record keeping %------- translate(TargetOrder,OrigOrder,OrigVector,NewVector). translate([],_,_,[]). translate([H|T1],OrigOrd,OrigVec,[C|T2]):- nth1(N,OrigOrd,H), nth1(N,OrigVec,C), translate(T1,OrigOrd,OrigVec,T2). translateVex([],_,_,[]):- !. translateVex([H1|T1],Targ,Orig,[H2|T2]):- translate(Targ,Orig,H1,H2),translateVex(T1,Targ,Orig,T2). %-------- audt:-compile('trials.pl'), highest(0,H),longest(0,L), write('longest: '),print(L),nl, zeroList(L,Z),!, auditLoop(H,Z). auditLoop(0,Nic):- reverse(Nic,[Tot|_]),div(Nic,Tot,R),llist(R). auditLoop(N,Inc):- trial(N,_,Kv), updateKv(Inc,Kv,Nic), M is N - 1,!, auditLoop(M,Nic). auditLoop(N,Inc):- M is N - 1,auditLoop(M,Inc). updateKv([],_,[]). updateKv([H1|T1],[],[H2|T2]):- H2 is H1 + 62, updateKv(T1,[],T2). updateKv([H1|T1],[(_,_,H)|T],[H2|T2]):- H2 is H1 + H, updateKv(T1,T,T2). div([],_,[]). div([H1|T1],Tot,[H2|T2]):- H2 is H1 / Tot, div(T1,Tot,T2). zeroList(0,[]). zeroList(N,[0|L]):- M is N - 1, zeroList(M,L). %------------ highest(B,Mx):- trial(N,_,_), N > B, highest(N,Mx). highest(Mx,Mx). longest(B,Mx):-trial(_,_,Trz), length(Trz,Ln), Ln > B, longest(Ln,Mx). longest(Mx,Mx). longestLx(B,Mx):-lex(N,_,Trz), length(Trz,Ln), Ln > B, print(N),nl,longestLx(Ln,Mx). longestLx(Mx,Mx). %---- diff([],B,B). diff([H|T],B,Rslt):-delete(B,H,Nx), diff(T,Nx,Rslt). %---- %braniERC(OrigErcs,AddedErcs,NewErcs,Changey/n) brainiERC(ERC0,ERC1,Rslt,Change):- append(ERC0,ERC1,ERC2), sort(ERC2,ERC3),remEnt(ERC3,[],ERC4), ((ERC4=ERC0,!,Rslt=ERC0,Change=no);(Change=yes, brainiERC2(ERC4,Rslt))),!. brainiERC2(ERC0,ERC3):- % llist(ERC0),nl, fusePairLoop(ERC0,ERC0,[],ERC1), % llist(ERC1),nl, remEnt(ERC1,[],ERC2),sort(ERC2,ERC3). % llist(ERC3),nl. fusePairLoop([],ERC0,Inc,ERC1):- sort(Inc,ERC2),((ERC0=ERC2,!,ERC1=ERC2);(ERC0\=ERC2, fusePairLoop(ERC2,ERC2,[],ERC1))). fusePairLoop([E|T],ERC0,Inc,ERC1):- fuserEr(ERC0,E,Inc,Ninc),fusePairLoop(T,ERC0,Ninc,ERC1). fuserEr([],_,Prev,Prev). fuserEr([H|T1],E,Prev,[F|T2]):- fuse(H,E,F),fuserEr(T1,E,Prev,T2). %-------------- boo(In):-candiLoop(In,0,[],(M)),draw(M). %-------------- More ERC madness erkk(E1,E2,E3,Kode):- erkzlop(E1,E2,E3,K),interpK(K,Kode),!. erkzlop([],[],[],(1,1,1,1)). erkzlop([X|T1],[X|T2],[X|T3],(A,B,C,D)):- !, erkzlop(T1,T2,T3,(A,B,C,D)). erkzlop([l|T1],[_|T2],[l|T3],(A,B,C,0)):- !, erkzlop(T1,T2,T3,(A,B,C,_)). erkzlop([_|T1],[l|T2],[l|T3],(A,B,0,D)):- !, erkzlop(T1,T2,T3,(A,B,_,D)). erkzlop([w|T1],[e|T2],[w|T3],(A,0,C,D)):- !, erkzlop(T1,T2,T3,(A,_,C,D)). erkzlop([e|T1],[w|T2],[w|T3],(0,B,C,D)):- !, erkzlop(T1,T2,T3,(_,B,C,D)). interpK((0,1,1,1),k1). interpK((1,1,1,0),k1). interpK((1,0,1,1),k2). interpK((1,1,0,1),k2). interpK((0,1,1,0),k1). interpK((0,1,0,1),k12). interpK((0,0,1,1),k12). interpK((1,1,0,0),k3). interpK((1,0,1,0),k12). interpK((1,0,0,1),k2). interpK((0,0,1,0),k12). interpK((0,1,0,0),k13). interpK((1,0,0,0),k23). interpK((0,0,0,1),k12). interpK((0,0,0,0),k123). interpK((1,1,1,1),id):-write('Comparing identical ERCs!!!'),nl,more. minErcs(ERCs,MinERCs):- % sort(ERCs,E0), ERCs = E0, reverse(E0,Er), merklop(E0,Er,Er,[],[],MinERCs). merklop([],_,_,[],Result,Result). merklop([],_,_,New,Old,Result):- New\=[], reverse2append(New,Old,[],Er), write('---next---'),nl, merklop(New,Er,Er,[],[],Result). merklop([H|T1],[H|_],Er,IncNew,IncOld,Rslt):- print(H), write(' - survives'),nl, !, merklop(T1,Er,Er,IncNew,[H|IncOld],Rslt). merklop([E1|T1],[E2|T2],Er,IncNew,IncOld,Rslt):- erkk(E1,E2,E3,K), print((E1,E2,E3,K)),nl, ( (K=k1,!,delete(Er,E2,Erx),merklop([E1|T1],T2,Erx,IncNew,IncOld,Rslt)); (K=k2,!,merklop(T1,Er,Er,IncNew,IncOld,Rslt)); (K=k3,!,delete(Er,E2,Erx),merklop(T1,Erx,Erx,IncNew,IncOld,Rslt)); (K=k12,!,merklop([E1|T1],T2,Er,IncNew,IncOld,Rslt)); (K=k13,!,delete(Er,E2,Erx),merklop([E1|T1],T2,Erx,[E3|IncNew],IncOld,Rslt)); (K=k23,!,merklop(T1,Er,Er,[E3|IncNew],IncOld,Rslt)); (K=k123,!,merklop([E1|T1],T2,Er,[E3|IncNew],IncOld,Rslt)) ). reverse2append([],[],R,R). reverse2append([H|T],L,Inc,R):-reverse2append(T,L,[H|Inc],R). reverse2append([],[H|T],Inc,R):-reverse2append([],T,[H|Inc],R).