Skip to content
Browse files

bug: 7045

Even more shootout benchmarks by luc (Serg Kozhemyakin)
  • Loading branch information...
1 parent eeb38bb commit 5df9aec39497015cf1bcd21175211d278cffab07 @andreas23 andreas23 committed Mar 20, 2005
Showing with 215 additions and 0 deletions.
  1. +78 −0 fannkuch.dylan
  2. +125 −0 fasta.dylan
  3. +12 −0 harmonic.dylan
View
78 fannkuch.dylan
@@ -0,0 +1,78 @@
+module: funnkuch
+
+define constant <int-vector> = limited(<vector>, of: <integer>);
+
+define function funnkuch (n :: <integer>)
+ => result :: <integer>;
+ let perm :: <int-vector> = make(<int-vector>,size: n,fill: 0);
+ let perm1 = make(<int-vector>,size: n,fill: 0);
+ let max-perm = make(<int-vector>,size: n,fill: 0);
+ let count = make(<int-vector>,size: n,fill: 0);
+ let max-flip-count :: <integer> = 0;
+ let m :: <integer> = n - 1;
+ let r :: <integer> = n;
+
+ for (i from 0 below n)
+ perm1[i] := i;
+ end for;
+
+ block(return)
+ while (#t)
+ while (r ~= 1)
+ count[r - 1] := r;
+ r := r - 1;
+ end while;
+
+ if (~ (perm1[0] = 0 | perm1[m] = m))
+ for (i from 0 below n)
+ perm[i] := perm1[i];
+ end for;
+ let flip-count :: <integer> = 0;
+ while (perm[0] ~= 0)
+ let k :: <integer> = perm[0];
+ let k2 = (k + 1) / 2.0;
+ for(i from 0 below k2)
+ let tmp = perm[i];
+ perm[i] := perm[k - i];
+ perm[k - i] := tmp;
+ end for;
+ flip-count := flip-count + 1;
+ end while;
+
+ if (flip-count > max-flip-count)
+ max-flip-count := flip-count;
+ for (i from 0 below n)
+ max-perm[i] := perm1[i];
+ end for;
+ end if;
+ end if;
+
+ block(break)
+ while(#t)
+ if (r = n)
+ return(max-flip-count);
+ end if;
+ let perm0 :: <integer> = perm1[0];
+ let i :: <integer> = 0;
+ while (i < r)
+ let j = i + 1;
+ perm1[i] := perm1[j];
+ i := j;
+ end while;
+ perm1[r] := perm0;
+ count[r] := count[r] - 1;
+ if (count[r] > 0)
+ break();
+ end if;
+ r := r + 1;
+ end while;
+ end block;
+
+ end while;
+ end block;
+end function funnkuch;
+
+begin
+ let arg = application-arguments()[0].string-to-integer;
+ format-out("%d\n",funnkuch(arg));
+end;
View
125 fasta.dylan
@@ -0,0 +1,125 @@
+module: fasta
+use-libraries: common-dylan, io
+use-modules: common-dylan, standard-io, streams, format-out
+
+define constant $alu :: <byte-string> =
+ "GGCCGGGCGCGGTGGCTCACGCCTGTAATCCCAGCACTTTGG"
+ "GAGGCCGAGGCGGGCGGATCACCTGAGGTCAGGAGTTCGAGA"
+ "CCAGCCTGGCCAACATGGTGAAACCCCGTCTCTACTAAAAAT"
+ "ACAAAAATTAGCCGGGCGTGGTGGCGCGCGCCTGTAATCCCA"
+ "GCTACTCGGGAGGCTGAGGCAGGAGAATCGCTTGAACCCGGG"
+ "AGGCGGAGGTTGCAGTGAGCCGAGATCGCGCCACTGCACTCC"
+ "AGCCTGGGCGACAGAGCGAGACTCCGTCTCAAAAA";
+
+define sealed class <frequency> (<object>)
+ slot p :: <double-float>, required-init-keyword: p:;
+ constant slot c :: <byte-character>, required-init-keyword: c:;
+end class <frequency>;
+
+define constant $null-freq :: <frequency> = make(<frequency>,c: '\<0>', p: 0.0d0);
+
+define constant <freq-vector> = limited(<vector>, of: <frequency>);
+
+define constant $iub :: <freq-vector> = make(<freq-vector>,size: 15,fill: $null-freq);
+$iub[0] := make(<frequency>,c: 'a',p: 0.27d0);
+$iub[1] := make(<frequency>,c: 'c',p: 0.12d0);
+$iub[2] := make(<frequency>,c: 'g',p: 0.12d0);
+$iub[3] := make(<frequency>,c: 't',p: 0.27d0);
+$iub[4] := make(<frequency>,c: 'B',p: 0.02d0);
+$iub[5] := make(<frequency>,c: 'D',p: 0.02d0);
+$iub[6] := make(<frequency>,c: 'H',p: 0.02d0);
+$iub[7] := make(<frequency>,c: 'K',p: 0.02d0);
+$iub[8] := make(<frequency>,c: 'M',p: 0.02d0);
+$iub[9] := make(<frequency>,c: 'N',p: 0.02d0);
+$iub[10] := make(<frequency>,c: 'R',p: 0.02d0);
+$iub[11] := make(<frequency>,c: 'S',p: 0.02d0);
+$iub[12] := make(<frequency>,c: 'V',p: 0.02d0);
+$iub[13] := make(<frequency>,c: 'W',p: 0.02d0);
+$iub[14] := make(<frequency>,c: 'Y',p: 0.02d0);
+
+define constant $homosapiens :: <freq-vector> = make(<freq-vector>,size: 4,fill: $null-freq);
+$homosapiens[0] := make(<frequency>,c: 'a',p: 0.3029549426680d0);
+$homosapiens[1] := make(<frequency>,c: 'c',p: 0.1979883004921d0);
+$homosapiens[2] := make(<frequency>,c: 'g',p: 0.1975473066391d0);
+$homosapiens[3] := make(<frequency>,c: 't',p: 0.3015094502008d0);
+
+define constant $ia = 3877;
+define constant $ic = 29573;
+define constant $im = 139968;
+define variable *last* :: <double-float> = 42.0d0;
+
+define function gen-random(max-value :: <double-float>)
+ => result :: <double-float>;
+ *last* := modulo((*last* * $ia + $ic), $im);
+ (max-value * *last*) / $im;
+end function gen-random;
+
+define function make-cumulative(tbl :: <freq-vector>)
+ let cp :: <double-float> = 0.0d0;
+ for (i from 0 below size(tbl))
+ cp := cp + tbl[i].p;
+ tbl[i].p := cp;
+ end for;
+end function make-cumulative;
+
+define function make-repeat-fasta
+ (id :: <string>, desc :: <string>, src :: <byte-string>, n :: <integer>)
+ format-out(">%s %s\n",id,desc);
+ let width = 60;
+ let length :: <integer> = size(src);
+ let count :: <integer> = 0;
+ let k :: <integer> = 0;
+ while (n > 0)
+ count := min(n,width);
+ for (i from 0 below count)
+ if (k == length)
+ k := 0;
+ end if;
+ write-element(*standard-output*,src[k]);
+ k := k + 1;
+ end for;
+ write(*standard-output*,"\n");
+ n := n - width;
+ end while;
+end function make-repeat-fasta;
+
+define function select-random-char (tbl :: <freq-vector>, last-index :: <integer>)
+ => result :: <byte-character>;
+ let rnd = gen-random(1.0d0);
+ let result =
+ block(break)
+ for (i from 0 below last-index)
+ if (rnd < tbl[i].p)
+ break(tbl[i].c);
+ end if;
+ end for;
+ tbl[last-index].c;
+ end block;
+ result;
+end function select-random-char;
+
+define function make-random-fasta
+ (id :: <string>, desc :: <string>, tbl :: <freq-vector>, n :: <integer>)
+ format-out(">%s %s\n",id,desc);
+ let width = 60;
+ let m = 0;
+ let sz = size(tbl) - 1;
+ while (n > 0)
+ m := min(n,width);
+ for (i from 0 below m)
+ write-element(*standard-output*,select-random-char(tbl,sz));
+ end for;
+ write(*standard-output*,"\n");
+ n := n - width;
+ end while;
+end function make-random-fasta;
+
+begin
+ let n = application-arguments()[0].string-to-integer;
+ make-cumulative($iub);
+ make-cumulative($homosapiens);
+
+ make-repeat-fasta("ONE", "Homo sapiens alu", $alu, n * 2);
+ make-random-fasta("TWO", "IUB ambiguity codes", $iub, n * 3);
+ make-random-fasta("THREE", "Homo sapiens frequency", $homosapiens, n * 5);
+end;
View
12 harmonic.dylan
@@ -0,0 +1,12 @@
+odule: harmonic
+
+begin
+ let n = application-arguments()[0].string-to-integer;
+ let partial-sum :: <double-float> = 0.0d0;
+ let i :: <double-float> = 1.0d0;
+ while (i < n)
+ partial-sum := partial-sum + 1.0d0 / i;
+ i := i + 1.0d0;
+ end while;
+ format-out("%d\n",partial-sum);
+end;

0 comments on commit 5df9aec

Please sign in to comment.
Something went wrong with that request. Please try again.