Merge branch 'master' of factorcode.org:/git/factor

release
Joe Groff 2010-04-14 21:52:18 -07:00
commit 9be417f21f
7 changed files with 32 additions and 33 deletions

View File

@ -286,7 +286,7 @@ $nl
HELP: accumulate
{ $values { "seq" sequence } { "identity" object } { "quot" { $quotation "( ... prev elt -- ... next )" } } { "final" "the final result" } { "newseq" "a new array" } }
{ $description "Combines successive elements of the sequence using a binary operation, and outputs an array of intermediate results, together with the final result."
{ $description "Combines successive elements of the sequence using a binary operation, and outputs a sequence of intermediate results, together with the final result."
$nl
"The first element of the new sequence is " { $snippet "identity" } ". Then, on the first iteration, the two inputs to the quotation are " { $snippet "identity" } ", and the first element of the old sequence. On successive iterations, the first input is the result of the previous iteration, and the second input is the corresponding element of the old sequence."
$nl

View File

@ -24,6 +24,9 @@ IN: sequences.tests
[ 5040 { 1 1 2 6 24 120 720 } ]
[ { 1 2 3 4 5 6 7 } 1 [ * ] accumulate ] unit-test
[ 64 B{ 1 2 4 16 } ]
[ B{ 2 2 4 4 } 1 [ * ] accumulate ] unit-test
[ 5040 { 1 1 2 6 24 120 720 } ]
[ { 1 2 3 4 5 6 7 } 1 [ * ] accumulate! ] unit-test

View File

@ -436,7 +436,7 @@ PRIVATE>
[ (accumulate) ] dip map-as ; inline
: accumulate ( ... seq identity quot: ( ... prev elt -- ... next ) -- ... final newseq )
{ } accumulate-as ; inline
pick accumulate-as ; inline
: accumulate! ( ... seq identity quot: ( ... prev elt -- ... next ) -- ... final seq )
(accumulate) map! ; inline

View File

@ -1,8 +1,9 @@
! Based on http://shootout.alioth.debian.org/gp4/benchmark.php?test=fasta&lang=java&id=2
USING: alien.c-types math kernel io io.files locals multiline
assocs sequences sequences.private benchmark.reverse-complement
hints io.encodings.ascii byte-arrays specialized-arrays ;
SPECIALIZED-ARRAY: double
USING: assocs benchmark.reverse-complement byte-arrays fry io
io.encodings.ascii io.files locals kernel math sequences
sequences.private specialized-arrays strings typed ;
QUALIFIED-WITH: alien.c-types c
SPECIALIZED-ARRAY: c:double
IN: benchmark.fasta
CONSTANT: IM 139968
@ -11,10 +12,8 @@ CONSTANT: IC 29573
CONSTANT: initial-seed 42
CONSTANT: line-length 60
: random ( seed -- n seed )
>float IA * IC + IM mod [ IM /f ] keep ; inline
HINTS: random fixnum ;
: random ( seed -- seed n )
>float IA * IC + IM mod dup IM /f ; inline
CONSTANT: ALU "GGCCGGGCGCGGTGGCTCACGCCTGTAATCCCAGCACTTTGGGAGGCCGAGGCGGGCGGATCACCTGAGGTCAGGAGTTCGAGACCAGCCTGGCCAACATGGTGAAACCCCGTCTCTACTAAAAATACAAAAATTAGCCGGGCGTGGTGGCGCGCGCCTGTAATCCCAGCTACTCGGGAGGCTGAGGCAGGAGAATCGCTTGAACCCGGGAGGCGGAGGTTGCAGTGAGCCGAGATCGCGCCACTGCACTCCAGCCTGGGCGACAGAGCGAGACTCCGTCTCAAAAA"
@ -46,34 +45,32 @@ CONSTANT: homo-sapiens
{ CHAR: t 0.3015094502008 }
}
: make-cumulative ( freq -- chars floats )
TYPED: make-cumulative ( freq -- chars: byte-array floats: double-array )
[ keys >byte-array ]
[ values >double-array ] bi unclip [ + ] accumulate swap suffix ;
[ values >double-array unclip [ + ] accumulate swap suffix ] bi ;
:: select-random ( seed chars floats -- seed elt )
floats seed random -rot
[ >= ] curry find drop
chars nth-unsafe ; inline
seed random floats [ <= ] with find drop chars nth-unsafe ; inline
: make-random-fasta ( seed len chars floats -- seed )
[ iota ] 2dip [ [ drop ] 2dip select-random ] 2curry "" map-as print ; inline
TYPED: make-random-fasta ( seed: fixnum len: fixnum chars: byte-array floats: double-array -- seed: fixnum )
'[ _ _ select-random ] "" replicate-as print ;
: write-description ( desc id -- )
">" write write bl print ; inline
">" write write bl print ;
:: split-lines ( n quot -- )
n line-length /mod
[ [ line-length quot call ] times ] dip
quot unless-zero ; inline
: write-random-fasta ( seed n chars floats desc id -- seed )
TYPED: write-random-fasta ( seed: fixnum n: fixnum chars: byte-array floats: double-array desc id -- seed: fixnum )
write-description
[ make-random-fasta ] 2curry split-lines ; inline
'[ _ _ make-random-fasta ] split-lines ;
:: make-repeat-fasta ( k len alu -- k' )
TYPED:: make-repeat-fasta ( k: fixnum len: fixnum alu: string -- k': fixnum )
alu length :> kn
len iota [ k + kn mod alu nth-unsafe ] "" map-as print
k len + ; inline
k len + ;
: write-repeat-fasta ( n alu desc id -- )
write-description
@ -81,7 +78,7 @@ CONSTANT: homo-sapiens
:> alu
0 :> k!
[| len | k len alu make-repeat-fasta k! ] split-lines
] ; inline
] ;
: fasta ( n out -- )
homo-sapiens make-cumulative

View File

@ -14,7 +14,7 @@ IN: benchmark.knucleotide
CHAR: \n swap remove >upper ;
: handle-table ( inputs n -- )
clump
<clumps>
[ histogram >alist sort-values reverse ] [ length ] bi
'[
[ first write bl ]
@ -22,7 +22,7 @@ IN: benchmark.knucleotide
] each ;
: handle-n ( input x -- )
[ nip ] [ length clump histogram ] 2bi at 0 or "%d\t" printf ;
[ nip ] [ length <clumps> histogram ] 2bi at 0 or "%d\t" printf ;
: process-input ( input -- )
[ 1 handle-table nl ]

View File

@ -1,8 +1,8 @@
! Factor port of
! http://shootout.alioth.debian.org/gp4/benchmark.php?test=spectralnorm&lang=all
USING: alien.c-types specialized-arrays kernel math
math.functions math.vectors sequences prettyprint words hints
locals ;
math.functions math.vectors sequences sequences.private
prettyprint words typed locals ;
SPECIALIZED-ARRAY: double
IN: benchmark.spectral-norm
@ -19,13 +19,13 @@ IN: benchmark.spectral-norm
+ 1 + recip ; inline
: (eval-A-times-u) ( u i j -- x )
[ swap nth ] [ eval-A ] bi-curry bi* * ; inline
[ swap nth-unsafe ] [ eval-A ] bi-curry bi* * ; inline
: eval-A-times-u ( n u -- seq )
[ (eval-A-times-u) ] inner-loop ; inline
: (eval-At-times-u) ( u i j -- x )
[ swap nth ] [ swap eval-A ] bi-curry bi* * ; inline
[ swap nth-unsafe ] [ swap eval-A ] bi-curry bi* * ; inline
: eval-At-times-u ( u n -- seq )
[ (eval-At-times-u) ] inner-loop ; inline
@ -43,11 +43,9 @@ IN: benchmark.spectral-norm
[ n eval-AtA-times-u ] keep
] times ; inline
: spectral-norm ( n -- norm )
TYPED: spectral-norm ( n: fixnum -- norm )
u/v [ v. ] [ norm-sq ] bi /f sqrt ;
HINTS: spectral-norm fixnum ;
: spectral-norm-main ( -- )
2000 spectral-norm . ;

View File

@ -3,7 +3,7 @@
USING: elf help.markup help.syntax ;
IN: elf.nm
HELP: nm
HELP: elf-nm
{ $values
{ "path" "a pathname string" }
}
@ -17,6 +17,7 @@ HELP: print-symbol
ARTICLE: "elf.nm" "ELF nm"
"The " { $vocab-link "elf.nm" } " vocab prints the values, sections and names of the symbols in a given ELF file. In an ELF executable or shared library, the symbol values are typically their virtual addresses. In a relocatable ELF object, they are section-relative offsets."
{ $subsections elf-nm }
;
ABOUT: "elf.nm"