steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Fix benchmark.knucleotide

release
Slava Pestov 2007-11-25 00:50:12 -05:00
parent 5014cd92b9 ce0bbc78fa
commit d9bdcaf3a2
7 changed files with 16 additions and 27 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
extra/benchmark/knucleotide/authors.txt Normal file
View File

@ -0,0 +1 @@
Eric Mertens

28
extra/benchmark/knucleotide/knucleotide.factor
View File

@ -4,38 +4,32 @@ USING: kernel io io.files splitting strings
IN: benchmark.knucleotide IN: benchmark.knucleotide
: float>string ( float places -- string ) : float>string ( float places -- string )
swap >float number>string swap >float number>string
"." split1 rot "." split1 rot
over length over < over length over <
[ CHAR: 0 pad-right ] [ CHAR: 0 pad-right ]
[ head ] if "." swap 3append [ head ] if "." swap 3append ;
;
: discard-lines ( -- ) : discard-lines ( -- )
readln readln
[ ">THREE" head? [ discard-lines ] unless ] when* [ ">THREE" head? [ discard-lines ] unless ] when* ;
;
: read-input ( -- input ) : read-input ( -- input )
discard-lines discard-lines
">" read-until drop ">" read-until drop
CHAR: \n swap remove >upper CHAR: \n swap remove >upper ;
;
: tally ( x exemplar -- b ) : tally ( x exemplar -- b )
clone tuck clone tuck
[ [
[ [ 1+ ] [ 1 ] if* ] change-at [ [ 1+ ] [ 1 ] if* ] change-at
] curry each ] curry each ;
;
: small-groups ( x n -- b ) : small-groups ( x n -- b )
swap swap
[ length swap - 1+ ] 2keep [ length swap - 1+ ] 2keep
[ >r over + r> subseq ] 2curry map [ >r over + r> subseq ] 2curry map ;
;
: handle-table ( inputs n -- ) : handle-table ( inputs n -- )
small-groups small-groups
@ -46,29 +40,25 @@ IN: benchmark.knucleotide
dup first write bl dup first write bl
second 100 * over / 3 float>string print second 100 * over / 3 float>string print
] each ] each
drop drop ;
;
: handle-n ( inputs x -- ) : handle-n ( inputs x -- )
tuck length tuck length
small-groups H{ } tally small-groups H{ } tally
at [ 0 ] unless* at [ 0 ] unless*
number>string 8 CHAR: \s pad-right write number>string 8 CHAR: \s pad-right write ;
;
: process-input ( input -- ) : process-input ( input -- )
dup 1 handle-table nl dup 1 handle-table nl
dup 2 handle-table nl dup 2 handle-table nl
{ "GGT" "GGTA" "GGTATT" "GGTATTTTAATT" "GGTATTTTAATTTATAGT" } { "GGT" "GGTA" "GGTATT" "GGTATTTTAATT" "GGTATTTTAATTTATAGT" }
[ [ dupd handle-n ] keep print ] each [ [ dupd handle-n ] keep print ] each
drop drop ;
;
: knucleotide ( -- ) : knucleotide ( -- )
"extra/benchmark/knucleotide/knucleotide-input.txt" resource-path "extra/benchmark/knucleotide/knucleotide-input.txt" resource-path
<file-reader> <file-reader>
[ read-input ] with-stream [ read-input ] with-stream
process-input process-input ;
;
MAIN: knucleotide MAIN: knucleotide

2
extra/benchmark/knucleotide/summary.txt Normal file
View File

@ -0,0 +1,2 @@
The Great Computer Language Shootout's knucleotide benchmark to test
hashtables.

2
extra/benchmark/mandel/mandel.factor
View File

@ -64,7 +64,7 @@ SYMBOL: cols
building get >string building get >string
] with-scope ; ] with-scope ;
: mandel-main ( file -- ) : mandel-main ( -- )
"mandel.ppm" resource-path <file-writer> "mandel.ppm" resource-path <file-writer>
[ mandel write ] with-stream ; [ mandel write ] with-stream ;

2
extra/benchmark/spectral-norm/spectral-norm.factor
View File

@ -49,7 +49,7 @@ IN: benchmark.spectral-norm
HINTS: spectral-norm fixnum ; HINTS: spectral-norm fixnum ;
: spectral-norm-main ( n -- ) : spectral-norm-main ( -- )
2000 spectral-norm . ; 2000 spectral-norm . ;
MAIN: spectral-norm-main MAIN: spectral-norm-main

2
extra/benchmark/sum-file/sum-file.factor
View File

@ -4,7 +4,7 @@ IN: benchmark.sum-file
: sum-file-loop ( n -- n' ) : sum-file-loop ( n -- n' )
readln [ string>number + sum-file-loop ] when* ; readln [ string>number + sum-file-loop ] when* ;
: sum-file ( file -- n ) : sum-file ( file -- )
<file-reader> [ 0 sum-file-loop ] with-stream . ; <file-reader> [ 0 sum-file-loop ] with-stream . ;
: sum-file-main ( -- ) : sum-file-main ( -- )

6
extra/editors/gvim/gvim.factor
View File

@ -4,11 +4,7 @@ IN: editors.gvim
TUPLE: gvim ; TUPLE: gvim ;
M: gvim vim-command ( file line -- string ) M: gvim vim-command ( file line -- string )
[ [ "\"" % vim-path get % "\" \"" % swap % "\" +" % # ] "" make ;
"\"" % vim-path get % "\"" %
vim-switches get [ % ] when*
"+" % # " \"" % % "\"" %
] "" make ;
T{ gvim } vim-editor set-global T{ gvim } vim-editor set-global
"gvim" vim-path set-global "gvim" vim-path set-global