131 lines
3.7 KiB
Prolog
131 lines
3.7 KiB
Prolog
% ----------------------------------------------------------------------
|
|
% The Computer Language Benchmarks Game
|
|
% http://shootout.alioth.debian.org/
|
|
% Contributed by Anthony Borla
|
|
% Modified to run with YAP by Glendon Holst
|
|
% ----------------------------------------------------------------------
|
|
|
|
:- yap_flag(unknown,error).
|
|
|
|
:- initialization(main).
|
|
|
|
main :-
|
|
unix( argv([H|_]) ), number_atom(N,H),
|
|
|
|
init_fasta(ALU, IUB, HOMOSAPIENS, RAND0),
|
|
|
|
N1 is N * 2,
|
|
N2 is N * 3,
|
|
N3 is N * 5,
|
|
|
|
repeat_fasta('ONE', 'Homo sapiens alu', N1, ALU),
|
|
|
|
make_cumulative(IUB, CVIUB),
|
|
|
|
random_fasta('TWO', 'IUB ambiguity codes', N2, CVIUB, RAND0, RAND1),
|
|
|
|
make_cumulative(HOMOSAPIENS, CVHOMOSAPIENS),
|
|
|
|
random_fasta('THREE', 'Homo sapiens frequency', N3, CVHOMOSAPIENS, RAND1, RAND),
|
|
|
|
statistics,
|
|
statistics_jit.
|
|
|
|
% ------------------------------- %
|
|
|
|
init_fasta(ALU, IUB, HOMOSAP, RAND) :-
|
|
ALU = 'GGCCGGGCGCGGTGGCTCACGCCTGTAATCCCAGCACTTTGGGAGGCCGAGGCGGGCGGATCACCTGAGGTCAGGAGTTCGAGACCAGCCTGGCCAACATGGTGAAACCCCGTCTCTACTAAAAATACAAAAATTAGCCGGGCGTGGTGGCGCGCGCCTGTAATCCCAGCTACTCGGGAGGCTGAGGCAGGAGAATCGCTTGAACCCGGGAGGCGGAGGTTGCAGTGAGCCGAGATCGCGCCACTGCACTCCAGCCTGGGCGACAGAGCGAGACTCCGTCTCAAAAA',
|
|
IUB = [a:0.27, c:0.12, g:0.12, t:0.27,
|
|
'B':0.02, 'D':0.02, 'H':0.02, 'K':0.02, 'M':0.02,
|
|
'N':0.02, 'R':0.02, 'S':0.02, 'V':0.02, 'W':0.02, 'Y':0.02],
|
|
HOMOSAP = [a:0.3029549426680, c:0.1979883004921,
|
|
g:0.1975473066391, t:0.3015094502008],
|
|
init_gen_random(42, RAND).
|
|
|
|
% ------------------------------- %
|
|
|
|
repeat_fasta(Id, Desc, N, ALU) :-
|
|
LineLength = 60,
|
|
atom_length(ALU, ALULength),
|
|
write('>'), write(Id), tab(1), write(Desc), nl,
|
|
repeat_fasta_(N, 0, LineLength, ALU, ALULength).
|
|
|
|
% ------------- %
|
|
|
|
repeat_fasta_(N, _, _, _, _) :- N =< 0, !.
|
|
|
|
repeat_fasta_(N, Q, L, ALU, ALULength) :-
|
|
(N < L -> L1 = N ; L1 = L),
|
|
(L1 + Q < ALULength ->
|
|
sub_atom(ALU, Q, L1, Lineout), Q1 is L1 + Q,
|
|
write(Lineout), nl
|
|
;
|
|
Rest is ALULength - Q, sub_atom(ALU, Q, Rest, Prefix),
|
|
atom_length(Prefix, PrefixLength), Q1 is L1 - PrefixLength,
|
|
sub_atom(ALU, 0, Q1, Segment),
|
|
write(Prefix), write(Segment), nl),
|
|
|
|
N1 is N - L1, !, repeat_fasta_(N1, Q1, L1, ALU, ALULength).
|
|
|
|
% ------------------------------- %
|
|
|
|
random_fasta(Id, Desc, N, CumTbl, RAND0, RAND) :-
|
|
LineLength = 60,
|
|
write('>'), write(Id), tab(1), write(Desc), nl,
|
|
random_fasta_(N, LineLength, CumTbl, RAND0, RAND).
|
|
|
|
% ------------- %
|
|
|
|
random_fasta_(N, _, _, RAND, RAND) :- N =< 0, !.
|
|
|
|
random_fasta_(N, L, CumTbl, RAND0, RAND) :-
|
|
(N < L -> L1 = N ; L1 = L),
|
|
gen_line(L1, CumTbl, Codesout, RAND0, RAND1),
|
|
atom_chars(Lineout, Codesout), write(Lineout), nl,
|
|
N1 is N - L1, !, random_fasta_(N1, L1, CumTbl, RAND1, RAND).
|
|
|
|
% ------------- %
|
|
|
|
gen_line(0, _, [], RAND, RAND).
|
|
gen_line(N, CumTbl, K, RAND0, RAND) :-
|
|
select_random(CumTbl, C, RAND0, RAND1),
|
|
char_code(C, C1), K = [C1|T1], N1 is N - 1, !,
|
|
gen_line(N1, CumTbl, T1, RAND1, RAND).
|
|
|
|
% ------------------------------- %
|
|
|
|
make_cumulative(L, RL) :- make_cumulative_(L, RL, 0).
|
|
|
|
make_cumulative_([], [], _) :- !.
|
|
make_cumulative_([K:V|T], L, CV) :-
|
|
CV1 is CV + V, L = [K:CV1|T1], !, make_cumulative_(T, T1, CV1).
|
|
|
|
% ------------- %
|
|
|
|
select_random(L, RK, RAND0, RAND) :-
|
|
gen_random(1.0, R, RAND0, RAND),
|
|
select_random_(L, R, RK).
|
|
|
|
select_random_([], _, _) :- !.
|
|
select_random_([K:V|T], R, RK) :-
|
|
(R < V -> RK = K ; !, select_random_(T, R, RK)).
|
|
|
|
% ------------------------------- %
|
|
|
|
init_gen_random(Seed, [3877, 29573, 139968, Seed]).
|
|
|
|
% ------------- %
|
|
|
|
gen_random(UB, R, RAND0, RAND) :-
|
|
RAND0 = [IA, IC, IM, LAST],
|
|
LAST1 is (LAST * IA + IC) mod IM,
|
|
RAND = [IA, IC, IM, LAST1],
|
|
R is UB * LAST1 / IM.
|
|
|
|
% ------------------------------- %
|
|
% BUG FIX - sub_atom/5 errors out if Size = 0.
|
|
|
|
sub_atom(_,_,0,'') :- !.
|
|
sub_atom(A,Bef,Size,Aout) :- sub_atom(A,Bef,Size,_,Aout).
|
|
|