:- use_module(rope). take_max(N, Rope, List) :- rope_take(Rope, N, R), rope_to_list(R, List). %?- start('prefixes/00_start'). %?- start('prefixes/01_self_check'). %?- start('prefixes/empty'). upper_lower('I', i). upper_lower('C', c). upper_lower('F', f). upper_lower('P', p). start0 :- start('prefixes/empty'). start1 :- start('prefixes/00_start'). start(PN) :- open(PN, read, PS), read_all(PS, Prefix), length(Prefix, LP), format("prefix: ~w bases\n", [LP]), close(PS), open('endo.dna', read, DS), read_all(DS, DNA0), close(DS), length(DNA0, DL), format("dna: ~w bases\n", [DL]), append(Prefix, DNA0, DNA), execute(DNA). read_all(Stream, As) :- get_char(Stream, C), ( C == end_of_file -> As = [] ; upper_lower(C, L), As = [L|Rest], read_all(Stream, Rest) ). execute(DNA) :- %length(Prefix, 50000), %append(Prefix, _, DNA), Prefix = DNA, list_to_rope(Prefix, Rope), execute(0, Rope, []). execute(Iter, DNA00, RNA0) :- %Iter < 10, ( Iter > 0, Iter mod 100 =:= 0 -> rope_length(DNA00, DNA00L), format("\n\nrebalancing ~w elements...\n", [DNA00L]), rope_to_list(DNA00, DNA01), list_to_rope(DNA01, DNA0) ; DNA0 = DNA00 ), format("--- execute ~w--- \n", [Iter]), take_max(20, DNA0, Firsts0), format("DNA: ~w\n", [Firsts0]), pattern(DNA0, RNA0, Pattern, DNA1, RNA1), format("pattern: ~w\n", [Pattern]), take_max(20, DNA1, Firsts1), format("remaining DNA: ~w\n", [Firsts1]), template(DNA1, RNA1, Template, DNA2, RNA2), %take_max(20, Template, Temps), %format("template: ~w\n", [Temps]), take_max(20, DNA2, Firsts2), format("remaining DNA: ~w\n", [Firsts2]), matchreplace(Pattern, Template, DNA2, DNA3), take_max(20, DNA3, Firsts3), format("DNA after matchreplace: ~w\n", [Firsts3]), Iter1 is Iter + 1, execute(Iter1, DNA3, RNA2). %?- DNA = [i, i, i, p, f, f, f, f, f, p, i, i, i, p, f, f, f, f, f, p], trace, execute(DNA). matchreplace(Pattern, Template, DNA0, DNA) :- matchr_each(Pattern, 0, I, [], Env, [], Return, DNA0, DNA1), format("matchr_each return\n"), ( Return == return -> DNA = DNA1 ; Return == continue -> take_max(20, DNA1, Firsts1), format("before replace: ~w\n", [Firsts1]), rope_drop(DNA1, I, DNA2), take_max(20, DNA2, Firsts2), format("after dropping: ~w\n", [Firsts2]), replace(Template, Env, DNA2, DNA), ( Env = [E1|_] -> take_max(20, E1, Es1), format("environment: ~w\n", [Es1]) ; true ) ; format("matchreplace: illegal action ~w\n", [Return]), fail ). matchr_each([], I, I, Env, Env, _, continue, DNA, DNA). matchr_each([P|Ps], I0, I, Env0, Env, C0, Return, DNA0, DNA) :- ( P = base(B) -> %format("base(~w)\n", [B]), ( rope_nth0(I0, DNA0, B) -> I1 is I0 + 1, matchr_each(Ps, I1, I, Env0, Env, C0, Return, DNA0, DNA) ; format("failed\n"), DNA0 = DNA, Return = return ) ; P = skip(N) -> I1 is I0 + N, format("skipping ~w\n", [N]), rope_length(DNA0, DL), ( I1 > DL -> DNA0 = DNA, Return = return ; matchr_each(Ps, I1, I, Env0, Env, C0, Return, DNA0, DNA) ) ; P = search(S) -> length(S, SearchLen), format("searching for ~w (~w)\n", [S,SearchLen]), rope_length(DNA0, DL), Upper is DL - SearchLen, ( ( S == [], Trial = I0 ; S = [FirstS|_], between(I0, Upper, Trial), rope_nth0(Trial, DNA0, FirstS), subrope(DNA0, Trial, SearchLen, Sub), rope_to_list(Sub, S) ) -> I1 is Trial + SearchLen, matchr_each(Ps, I1, I, Env0, Env, C0, Return, DNA0, DNA) ; DNA0 = DNA, Return = return ) ; P = open -> format("open\n"), matchr_each(Ps, I0, I, Env0, Env, [I0|C0], Return, DNA0, DNA) ; P = close -> C0 = [First|C1], format("close, from ~w to ~w\n", [First,I0]), Len is I0 - First, subrope(DNA0, First, Len, Sub), append(Env0, [Sub], Env1), matchr_each(Ps, I0, I, Env1, Env, C1, Return, DNA0, DNA) ; format("matchr_each: unknown pattern ~w\n", [P]), fail ). %?- list_to_rope([a,b,c,e,f], R), subrope(R, 2,2,R1). /* From ICFP mailing list: IIPIPICPIICICIIF gives (!2)P for the pattern ICCIFCCCPPIIC gives PI 0_7 for the template, where 7 is the protection level for ref 0 CFPC is the remaining, unconsumed part of the DNA Protecting CF with level 7 gives ICCFCFFP, and therefore we have PIICCFCFFPC after one iteration. Hope this helps. ?- protect(7, [c,f], Prot). ?- DNA = [i,i,p,i,p,i,c,p,i,i,c,i,c,i,i,f],list_to_rope(DNA,R), pattern(R, [], Pattern, D, RN). ?- DNA = [i,c,c,i,f,c,c,c,p,p,i,i,c], list_to_rope(DNA,Rope), template(Rope, [], Template, D, R). Example 1: ?- DNA = [i,i,p,i,p,i,c,p,i,i,c,i,c,i,i,f,i,c,c,i,f,p,p,i,i,c,c,f,p,c], execute(DNA). ?- DNA = [p, i, c, f, c], execute(DNA). Example 2: ?- DNA = [i,i,p,i,p,i,c,p,i,i,c,i,c,i,i,f,i,c,c,i,f,c,c,c,p,p,i,i,c,c,f,p,c], execute(DNA). Example 3: ?- DNA = [i,i,p,i,p,i,i,c,p,i,i,c,i,i,c,c,i,i,c,f,c,f,c], execute(DNA). ?- DNA = [i,i,c,i,p,i,i,c,c,i,i,p,i,p,c,i,i,i,i,c], execute(DNA). %@ --- execute --- %@ DNA: [i, i, c, i, p, i, i, c, c, i, i, p, i, p, c, i, i, i, i, c] */ finish(RNA) :- format("finished"), length(RNA, L), L1 is L * 7, format("RNA has ~w*7 = L1 bases\n", [L,L1]), reverse(RNA, RNA1), ( RNA1 = [A,B,C|_] -> format("RNA starts with: ~w ~w ~w\n", [A,B,C]) ; true ), halt. %?- Ps = [c,i,i,c], list_to_rope(Ps, R), pattern(R, [], Pattern, DNA, RNA). %?- pattern([i,i,p,i,p,i,c,p,i,i,c,i,c,i,i,f], [], Pattern, DNA, RNA). %?- DNA = [p,i,c,f,c], trace, execute(DNA). %?- list_to_rope([p,i,c,f,c], R), rope_take(R, 3, F). pattern(DNA0, RNA0, Pattern, DNA, RNA) :- pattern(DNA0, RNA0, 0, [], Pattern0, DNA, RNA), reverse(Pattern0, Pattern). pattern(DNA0, RNA0, Level0, Pattern0, Pattern, DNA, RNA) :- rope_take(DNA0, 3, Firsts), rope_to_list(Firsts, Fs), %format("looking at: ~w\n", [Fs]), rope_drop(DNA0, 1, DNA1), rope_drop(DNA1, 1, DNA2), rope_drop(DNA2, 1, DNA3), ( Fs = [c|_] -> pattern(DNA1, RNA0, Level0, [base(i)|Pattern0], Pattern, DNA, RNA) ; Fs = [f|_] -> pattern(DNA1, RNA0, Level0, [base(c)|Pattern0], Pattern, DNA, RNA) ; Fs = [p|_] -> pattern(DNA1, RNA0, Level0, [base(f)|Pattern0], Pattern, DNA, RNA) ; Fs = [i,c|_] -> pattern(DNA2, RNA0, Level0, [base(p)|Pattern0], Pattern, DNA, RNA) ; Fs = [i,p|_] -> nat(N, DNA2, DNA23, RNA0), pattern(DNA23, RNA0, Level0, [skip(N)|Pattern0], Pattern, DNA, RNA) ; Fs = [i,f,_|_] -> consts(S, DNA3, DNA4), pattern(DNA4, RNA0, Level0, [search(S)|Pattern0], Pattern, DNA, RNA) ; Fs = [i,i,p|_] -> Level1 is Level0 + 1, pattern(DNA3, RNA0, Level1, [open|Pattern0], Pattern, DNA, RNA) ; ( Fs = [i,i,c|_] ; Fs = [i,i,f|_]) -> ( Level0 =:= 0 -> Pattern0 = Pattern, DNA = DNA3, RNA = RNA0 ; Level1 is Level0 - 1, pattern(DNA3, RNA0, Level1, [close|Pattern0], Pattern, DNA, RNA) ) ; Fs = [i,i,i|_] -> subrope(DNA0, 3, 7, Subseq0), rope_to_list(Subseq0, Subseq), rope_drop(DNA0, 10, DNA10), pattern(DNA10, [Subseq|RNA0], Level0, Pattern0, Pattern, DNA, RNA) ; DNA = DNA0, RNA = RNA0, Pattern = Pattern0, finish(RNA0) ). %?- from_to([a,b,c], 10, inf, DNA1). nat(N, DNA0, DNA, RNA) :- rope_nth0(0, DNA0, F), rope_drop(DNA0, 1, DNA1), ( F == p -> N = 0, DNA = DNA1 ; ( F == i ; F == f) -> nat(N0, DNA1, DNA, RNA), N is (2*N0) mod round(2^31) ; F == c -> nat(N0, DNA1, DNA, RNA), N is (2*N0 + 1) mod round(2^31) ; finish(RNA) ). consts(Cs, DNA0, DNA) :- %rope_take(DNA0, 100, Fs), %format("consts: ~w\n", [Fs]), rope_nth0(0, DNA0, F), %format("looking at DNA head: ~w", [F]), rope_nth0(1, DNA0, X), %format(" second element: ~w\n", [X]), rope_drop(DNA0, 1, DNA1), ( F == c -> consts(S, DNA1, DNA), Cs = [i|S] ; F == f -> consts(S, DNA1, DNA), Cs = [c|S] ; F == p -> consts(S, DNA1, DNA), Cs = [f|S] ; F == i, X == c -> rope_drop(DNA1, 1, DNA2), consts(S, DNA2, DNA), Cs = [p|S] ; DNA0 = DNA, Cs = [] ). replace(Template, Environment, DNA0, DNA) :- empty_rope(R0), replace_ts(Template, Environment, R0, R), rope_append(R, DNA0, DNA). replace_ts([], _, R, R). replace_ts([T|Ts], Env, R0, R) :- ( T = base(B) -> list_to_rope([B], BR), rope_append(R0, BR, R1), replace_ts(Ts, Env, R1, R) ; T = ref(N,L) -> length(Env, EnvLength), ( N < EnvLength -> nth0(N, Env, At) ; empty_rope(At) ), ( L =:= 0 -> Prot = At ; rope_to_list(At, AtL), protect(L, AtL, Prot0), list_to_rope(Prot0, Prot) ), rope_append(R0, Prot, R1), replace_ts(Ts, Env, R1, R) ; T = len(N) -> length(Env, EnvLength), ( N < EnvLength -> nth0(N, Env, AtR) ; empty_rope(AtR) ), rope_length(AtR, Len), asnat(Len, Asnat), list_to_rope(Asnat, AsnatR), rope_append(R0, AsnatR, R1), replace_ts(Ts, Env, R1, R) ; format("replace_ts: unknown template ~w\n", [T]), fail ). %?- consts(Cs, [c,f,i,c], DNA). template(DNA0, RNA0, Template, DNA, RNA) :- template(DNA0, RNA0, [], Template0, DNA, RNA), reverse(Template0, Template). template(DNA0, RNA0, T0, T, DNA, RNA) :- rope_take(DNA0, 3, Fs0), rope_drop(DNA0, 1, DNA1), rope_drop(DNA1, 1, DNA2), rope_drop(DNA2, 1, DNA3), rope_to_list(Fs0, Fs), %format("template -- looking at: ~w\n", [Fs]), ( Fs = [c|_] -> template(DNA1, RNA0, [base(i)|T0], T, DNA, RNA) ; Fs = [f|_] -> template(DNA1, RNA0, [base(c)|T0], T, DNA, RNA) ; Fs = [p|_] -> template(DNA1, RNA0, [base(f)|T0], T, DNA, RNA) ; Fs = [i,c|_] -> template(DNA2, RNA0, [base(p)|T0], T, DNA, RNA) ; ( Fs =[i,f|_] ; Fs = [i,p|_]) -> nat(L, DNA2, DNA2a, RNA0), nat(N, DNA2a, DNA2b, RNA0), template(DNA2b, RNA0, [ref(N,L)|T0], T, DNA, RNA) ; ( Fs = [i,i,c|_] ; Fs = [i,i,f|_]) -> T0 = T, DNA = DNA3, RNA = RNA0 ; Fs = [i,i,p|_] -> nat(N, DNA3, DNA13, RNA0), template(DNA13, RNA0, [len(N)|T0], T, DNA, RNA) ; Fs = [i,i,i|_] -> subrope(DNA0, 3, 7, Sub0), rope_to_list(Sub0, Sub), rope_drop(DNA0, 10, DNA10), template(DNA10, [Sub|RNA0], T0, T, DNA, RNA) ; DNA0 = DNA, RNA0 = RNA, finish(RNA0) ). protect(L, D, Prot) :- ( L =:= 0 -> Prot = D ; L1 is L-1, quote(D, D1), protect(L1, D1, Prot) ). quote(D, Q) :- ( D = [i|D1] -> quote(D1, Q1), Q = [c|Q1] ; D = [c|D1] -> quote(D1, Q1), Q = [f|Q1] ; D = [f|D1] -> quote(D1, Q1), Q = [p|Q1] ; D = [p|D1] -> quote(D1, Q1), Q = [i,c|Q1] ; Q = [] ). asnat(N, D) :- ( N =:= 0 -> D = [p] ; N mod 2 =:= 0 -> N1 is N // 2, asnat(N1, D1), D = [i|D1] ; N1 is N // 2, asnat(N1, D1), D = [c|D1] ). /* ?- dna(DNA), profile(execute(DNA)). */ %?- list_to_rope([c,p,i,c,f,p,i,i,f,c,p,p,i,i],R). %?- list_to_rope([i,i], R), rope_nth0(1, R, i). %?- list_to_rope([p], Rope), subrope(Rope, 0, 1, Sub), rope_to_list(Sub, R1).