} ;
HELP: month-names
-{ $values { "array" array } }
+{ $values { "value" object } }
{ $description "Returns an array with the English names of all the months." }
{ $warning "Do not use this array for looking up a month name directly. Use month-name instead." } ;
PRIVATE>
-: month-names ( -- array )
+CONSTANT: month-names
{
"January" "February" "March" "April" "May" "June"
"July" "August" "September" "October" "November" "December"
- } ;
+ }
: month-name ( n -- string )
check-month 1- month-names nth ;
\r
: read-rfc3339-seconds ( s -- s' ch )\r
"+-Z" read-until [\r
- [ string>number ] [ length 10 swap ^ ] bi / +\r
+ [ string>number ] [ length 10^ ] bi / +\r
] dip ;\r
\r
: (rfc3339>timestamp) ( -- timestamp )\r
[ "." split1 ] dip [ CHAR: 0 pad-tail ] [ head-slice ] bi "." glue ;
: max-digits ( n digits -- n' )
- 10 swap ^ [ * round ] keep / ; inline
+ 10^ [ * round ] keep / ; inline
: >exp ( x -- exp base )
[
: check-fry ( quot -- quot )
dup { load-local load-locals get-local drop-locals } intersect
- empty? [ >r/r>-in-fry-error ] unless ;
+ [ >r/r>-in-fry-error ] unless-empty ;
PREDICATE: fry-specifier < word { _ @ } memq? ;
IN: io.files.info.windows
:: round-up-to ( n multiple -- n' )
- n multiple rem dup 0 = [
- drop n
+ n multiple rem [
+ n
] [
multiple swap - n +
- ] if ;
+ ] if-zero ;
TUPLE: windows-file-info < file-info attributes ;
[ handle-fd ] 2dip 1 <int> "int" heap-size setsockopt io-error ;
M: unix addrinfo-error ( n -- )
- dup zero? [ drop ] [ gai_strerror throw ] if ;
+ [ gai_strerror throw ] unless-zero ;
! Client sockets - TCP and Unix domain
M: object (get-local-address) ( handle remote -- sockaddr )
C: <bits> bits
: make-bits ( number -- bits )
- dup zero? [ drop T{ bits f 0 0 } ] [ dup abs log2 1 + <bits> ] if ; inline
+ [ T{ bits f 0 0 } ] [ dup abs log2 1 + <bits> ] if-zero ; inline
M: bits length length>> ;
{ $subsection exp }
{ $subsection cis }
{ $subsection log }
+{ $subsection log10 }
"Raising a number to a power:"
{ $subsection ^ }
+{ $subsection 10^ }
"Converting between rectangular and polar form:"
{ $subsection abs }
{ $subsection absq }
{ $values { "x" number } { "y" number } }
{ $description "Natural logarithm function. Outputs negative infinity if " { $snippet "x" } " is 0." } ;
+HELP: log10
+{ $values { "x" number } { "y" number } }
+{ $description "Logarithm function base 10. Outputs negative infinity if " { $snippet "x" } " is 0." } ;
+
HELP: sqrt
{ $values { "x" number } { "y" number } }
{ $description "Square root function." } ;
{ $description "Raises " { $snippet "x" } " to the power of " { $snippet "y" } ". If " { $snippet "y" } " is an integer the answer is computed exactly, otherwise a floating point approximation is used." }
{ $errors "Throws an error if " { $snippet "x" } " and " { $snippet "y" } " are both integer 0." } ;
+HELP: 10^
+{ $values { "x" number } { "y" number } }
+{ $description "Raises " { $snippet "x" } " to the power of 10. If " { $snippet "x" } " is an integer the answer is computed exactly, otherwise a floating point approximation is used." } ;
+
HELP: gcd
{ $values { "x" integer } { "y" integer } { "a" integer } { "d" integer } }
{ $description "Computes the positive greatest common divisor " { $snippet "d" } " of " { $snippet "x" } " and " { $snippet "y" } ", and another value " { $snippet "a" } " satisfying:" { $code "a*y = d mod x" } }
2dup [ real? ] both? [ drop 0 >= ] [ 2drop f ] if ; inline
: 0^ ( x -- z )
- dup zero? [ drop 0/0. ] [ 0 < 1/0. 0 ? ] if ; inline
+ [ 0/0. ] [ 0 < 1/0. 0 ? ] if-zero ; inline
: (^mod) ( n x y -- z )
make-bits 1 [
: divisor? ( m n -- ? )
mod 0 = ;
+ERROR: non-trivial-divisor n ;
+
: mod-inv ( x n -- y )
[ nip ] [ gcd 1 = ] 2bi
[ dup 0 < [ + ] [ nip ] if ]
- [ "Non-trivial divisor found" throw ] if ; foldable
+ [ non-trivial-divisor ] if ; foldable
: ^mod ( x y n -- z )
over 0 < [
M: complex log >polar swap flog swap rect> ;
+: 10^ ( x -- y ) 10 swap ^ ; inline
+
+: log10 ( x -- y ) log 10 log / ; inline
+
GENERIC: cos ( x -- y ) foldable
M: complex cos
: round ( x -- y ) dup sgn 2 / + truncate ; inline
: floor ( x -- y )
- dup 1 mod dup zero?
- [ drop ] [ dup 0 < [ - 1 - ] [ - ] if ] if ; foldable
+ dup 1 mod
+ [ ] [ dup 0 < [ - 1 - ] [ - ] if ] if-zero ; foldable
: ceiling ( x -- y ) neg floor neg ; foldable
: floor-to ( x step -- y )
- dup zero? [ drop ] [ [ / floor ] [ * ] bi ] if ;
+ [ [ / floor ] [ * ] bi ] unless-zero ;
: lerp ( a b t -- a_t ) [ over - ] dip * + ; inline
CONSTANT: masks B{ 0 128 0 0 0 0 0 64 0 0 0 32 0 16 0 0 0 8 0 4 0 0 0 2 0 0 0 0 0 1 }
: bit-pos ( n -- byte/f mask/f )
- 30 /mod masks nth-unsafe dup zero? [ 2drop f f ] when ;
+ 30 /mod masks nth-unsafe [ drop f f ] when-zero ;
: marked-unsafe? ( n arr -- ? )
[ bit-pos ] dip swap [ [ nth-unsafe ] [ bitand zero? not ] bi* ] [ 2drop f ] if* ;
: marked-prime? ( n arr -- ? )
2dup upper-bound 2 swap between? [ bounds-error ] unless
- over { 2 3 5 } member? [ 2drop t ] [ marked-unsafe? ] if ;
\ No newline at end of file
+ over { 2 3 5 } member? [ 2drop t ] [ marked-unsafe? ] if ;
! Copyright (C) 2004, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors kernel kernel.private math math.functions math.private ;
+USING: accessors kernel kernel.private math math.functions
+math.private sequences summary ;
IN: math.ratios
: 2>fraction ( a/b c/d -- a c b d )
PRIVATE>
+ERROR: division-by-zero x ;
+
+M: division-by-zero summary
+ drop "Division by zero" ;
+
M: integer /
- dup zero? [
- "Division by zero" throw
+ [
+ division-by-zero
] [
dup 0 < [ [ neg ] bi@ ] when
2dup gcd nip [ /i ] curry bi@ fraction>
- ] if ;
+ ] if-zero ;
M: ratio hashcode*
nip >fraction [ hashcode ] bi@ bitxor ;
! The last case is needed because a very large number would
! otherwise be confused with a small number.
: serialize-cell ( n -- )
- dup zero? [ drop 0 write1 ] [
+ [ 0 write1 ] [
dup HEX: 7e <= [
HEX: 80 bitor write1
] [
] if
>be write
] if
- ] if ;
+ ] if-zero ;
: deserialize-cell ( -- n )
read1 {
drop CHAR: n write1 ;
M: integer (serialize) ( obj -- )
- dup zero? [
- drop CHAR: z write1
+ [
+ CHAR: z write1
] [
dup 0 < [ neg CHAR: m ] [ CHAR: p ] if write1
serialize-cell
- ] if ;
+ ] if-zero ;
M: float (serialize) ( obj -- )
CHAR: F write1
binary [ deserialize ] with-byte-reader ;
: object>bytes ( obj -- bytes )
- binary [ serialize ] with-byte-writer ;
\ No newline at end of file
+ binary [ serialize ] with-byte-writer ;
continuations assocs combinators compiler.errors accessors math.order
definitions sets hints macros stack-checker.state
stack-checker.visitor stack-checker.errors stack-checker.values
-stack-checker.recursive-state ;
+stack-checker.recursive-state summary ;
IN: stack-checker.backend
: push-d ( obj -- ) meta-d push ;
: time-bomb ( error -- )
'[ _ throw ] infer-quot-here ;
-: bad-call ( -- )
- "call must be given a callable" time-bomb ;
+ERROR: bad-call obj ;
+
+M: bad-call summary
+ drop "call must be given a callable" ;
: infer-literal-quot ( literal -- )
dup recursive-quotation? [
[ [ recursion>> ] keep add-local-quotation ]
bi infer-quot
] [
- drop bad-call
+ value>> \ bad-call boa time-bomb
] if
] if ;
\ compose [ infer-compose ] "special" set-word-prop
+ERROR: bad-executable obj ;
+
+M: bad-executable summary
+ drop "execute must be given a word" ;
+
: infer-execute ( -- )
pop-literal nip
dup word? [
apply-object
] [
- drop
- "execute must be given a word" time-bomb
+ \ bad-executable boa time-bomb
] if ;
\ execute [ infer-execute ] "special" set-word-prop
GetLastError n>win32-error-string ;
: (win32-error) ( n -- )
- dup zero? [
- drop
- ] [
- win32-error-string throw
- ] if ;
+ [ win32-error-string throw ] unless-zero ;
: win32-error ( -- )
GetLastError (win32-error) ;
M: object new-sequence drop 0 <array> ;
-M: f new-sequence drop dup zero? [ drop f ] [ 0 <array> ] if ;
+M: f new-sequence drop [ f ] [ 0 <array> ] if-zero ;
M: array equal?
over array? [ sequence= ] [ 2drop f ] if ;
: class= ( first second -- ? )\r
[ class<= ] [ swap class<= ] 2bi and ;\r
\r
+ERROR: topological-sort-failed ;\r
+\r
: largest-class ( seq -- n elt )\r
dup [ [ class< ] with any? not ] curry find-last\r
- [ "Topological sort failed" throw ] unless* ;\r
+ [ topological-sort-failed ] unless* ;\r
\r
: sort-classes ( seq -- newseq )\r
[ name>> ] sort-with >vector\r
: parse-effect-tokens ( end -- tokens )
[ parse-effect-token dup ] curry [ ] produce nip ;
+ERROR: stack-effect-omits-dashes effect ;
+
: parse-effect ( end -- effect )
parse-effect-tokens { "--" } split1 dup
- [ <effect> ] [ "Stack effect declaration must contain --" throw ] if ;
+ [ <effect> ] [ drop stack-effect-omits-dashes ] if ;
: complete-effect ( -- effect )
"(" expect ")" parse-effect ;
: keep-going? ( assoc -- ? )
assumed get swap second first class<= ;
+ERROR: unreachable ;
+
: prune-redundant-predicates ( assoc -- default assoc' )
{
- { [ dup empty? ] [ drop [ "Unreachable" throw ] { } ] }
+ { [ dup empty? ] [ drop [ unreachable ] { } ] }
{ [ dup length 1 = ] [ first second { } ] }
{ [ dup keep-going? ] [ rest-slice prune-redundant-predicates ] }
[ [ first second ] [ rest-slice ] bi ]
PRIVATE>
: code-point-length ( n -- x )
- dup zero? [ drop 1 ] [
+ [ 1 ] [
log2 {
{ [ dup 0 6 between? ] [ 1 ] }
{ [ dup 7 10 between? ] [ 2 ] }
{ [ dup 11 15 between? ] [ 3 ] }
{ [ dup 16 20 between? ] [ 4 ] }
} cond nip
- ] if ;
+ ] if-zero ;
: code-point-offsets ( string -- indices )
0 [ code-point-length + ] accumulate swap suffix ;
over zero? [
2drop 0.0
] [
- dup zero? [
- 2drop 1/0.
+ [
+ drop 1/0.
] [
pre-scale
/f-loop over odd?
[ zero? [ 1 + ] unless ] [ drop ] if
post-scale
- ] if
+ ] if-zero
] if ; inline
M: bignum /f ( m n -- f )
{ $description
"Outputs one of the following:"
{ $list
- "-1 if " { $snippet "x" } " is negative"
- "0 if " { $snippet "x" } " is equal to 0"
- "1 if " { $snippet "x" } " is positive"
+ { "-1 if " { $snippet "x" } " is negative" }
+ { "0 if " { $snippet "x" } " is equal to 0" }
+ { "1 if " { $snippet "x" } " is positive" }
}
} ;
PRIVATE>
+ERROR: log2-expects-positive x ;
+
: log2 ( x -- n )
dup 0 <= [
- "log2 expects positive inputs" throw
+ log2-expects-positive
] [
(log2)
] if ; inline
[
dup 0 < negative? set
abs 1 /mod
- [ dup zero? [ drop "" ] [ (>base) sign append ] if ]
+ [ [ "" ] [ (>base) sign append ] if-zero ]
[
[ numerator (>base) ]
[ denominator (>base) ] bi
}
} ;
-{ if-empty when-empty unless-empty } related-words
+HELP: if-zero
+{ $values { "n" number } { "quot1" quotation } { "quot2" quotation } }
+{ $description "Makes an implicit check if the number is zero. A zero is dropped and " { $snippet "quot1" } " is called. Otherwise, if the number is not zero, " { $snippet "quot2" } " is called on it." }
+{ $example
+ "USING: kernel math prettyprint sequences ;"
+ "3 [ \"zero\" ] [ sq ] if-zero ."
+ "9"
+} ;
+
+HELP: when-zero
+{ $values
+ { "n" number } { "quot" "the first quotation of an " { $link if-zero } } }
+{ $description "Makes an implicit check if the sequence is empty. A zero is dropped and the " { $snippet "quot" } " is called." }
+{ $examples "This word is equivalent to " { $link if-zero } " with an empty second quotation:"
+ { $example
+ "USING: sequences prettyprint ;"
+ "0 [ 4 ] [ ] if-zero ."
+ "4"
+ }
+ { $example
+ "USING: sequences prettyprint ;"
+ "0 [ 4 ] when-zero ."
+ "4"
+ }
+} ;
+
+HELP: unless-zero
+{ $values
+ { "n" number } { "quot" "the second quotation of an " { $link if-empty } } }
+{ $description "Makes an implicit check if the number is zero. A zero is dropped. Otherwise, the " { $snippet "quot" } " is called on the number." }
+{ $examples "This word is equivalent to " { $link if-zero } " with an empty first quotation:"
+ { $example
+ "USING: sequences math prettyprint ;"
+ "3 [ ] [ sq ] if-empty ."
+ "9"
+ }
+ { $example
+ "USING: sequences math prettyprint ;"
+ "3 [ sq ] unless-zero ."
+ "9"
+ }
+} ;
HELP: delete-all
{ $values { "seq" "a resizable sequence" } }
{ $examples "Get random numbers until zero is reached:"
{ $unchecked-example
"USING: random sequences prettyprint math ;"
- "100 [ random dup zero? [ drop f ] when ] follow ."
+ "100 [ random [ f ] when-zero ] follow ."
"{ 100 86 34 32 24 11 7 2 }"
} } ;
$nl
"More elaborate counted loops can be performed with " { $link "math.ranges" } "." ;
+ARTICLE: "sequences-if" "Control flow with sequences"
+"To reduce the boilerplate of checking if a sequence is empty or a number is zero, several combinators are provided."
+$nl
+"Checking if a sequence is empty:"
+{ $subsection if-empty }
+{ $subsection when-empty }
+{ $subsection unless-empty }
+"Checking if a number is zero:"
+{ $subsection if-zero }
+{ $subsection when-zero }
+{ $subsection unless-zero } ;
+
ARTICLE: "sequences-access" "Accessing sequence elements"
{ $subsection ?nth }
"Concise way of extracting one of the first four elements:"
"Using sequences for looping:"
{ $subsection "sequences-integers" }
{ $subsection "math.ranges" }
+"Using sequences for control flow:"
+{ $subsection "sequences-if" }
"For inner loops:"
{ $subsection "sequences-unsafe" } ;
: empty? ( seq -- ? ) length 0 = ; inline
+<PRIVATE
+
+: (if-empty) ( seq quot1 quot2 quot3 -- )
+ [ [ drop ] prepose ] [ ] tri* if ; inline
+
+PRIVATE>
+
: if-empty ( seq quot1 quot2 -- )
- [ dup empty? ] [ [ drop ] prepose ] [ ] tri* if ; inline
+ [ dup empty? ] (if-empty) ; inline
: when-empty ( seq quot -- ) [ ] if-empty ; inline
: unless-empty ( seq quot -- ) [ ] swap if-empty ; inline
+: if-zero ( n quot1 quot2 -- )
+ [ dup zero? ] (if-empty) ; inline
+
+: when-zero ( n quot -- ) [ ] if-zero ; inline
+
+: unless-zero ( n quot -- ) [ ] swap if-zero ; inline
+
: delete-all ( seq -- ) 0 swap set-length ;
: first ( seq -- first ) 0 swap nth ; inline
<PRIVATE
+ERROR: integer-length-expected obj ;
+
: check-length ( n -- n )
#! Ricing.
- dup integer? [ "length not an integer" throw ] unless ; inline
+ dup integer? [ integer-length-expected ] unless ; inline
: ((copy)) ( dst i src j n -- dst i src j n )
dup -roll [
: (split) ( separators n seq -- )
3dup rot [ member? ] curry find-from drop
[ [ swap subseq , ] 2keep 1 + swap (split) ]
- [ swap dup zero? [ drop ] [ tail ] if , drop ] if* ; inline recursive
+ [ swap [ tail ] unless-zero , drop ] if* ; inline recursive
: split, ( seq separators -- ) 0 rot (split) ;
:: split-lines ( n quot -- )
n line-length /mod
[ [ line-length quot call ] times ] dip
- dup zero? [ drop ] quot if ; inline
+ quot unless-zero ; inline
: write-random-fasta ( seed n chars floats desc id -- seed )
write-description
-USING: descriptive kernel math tools.test continuations prettyprint io.streams.string see ;\r
+USING: descriptive kernel math tools.test continuations prettyprint io.streams.string see\r
+math.ratios ;\r
IN: descriptive.tests\r
\r
DESCRIPTIVE: divide ( num denom -- fraction ) / ;\r
\r
[ 3 ] [ 9 3 divide ] unit-test\r
-[ T{ descriptive-error f { { "num" 3 } { "denom" 0 } } "Division by zero" divide } ] [ [ 3 0 divide ] [ ] recover ] unit-test\r
\r
-[ "USING: descriptive math ;\nIN: descriptive.tests\nDESCRIPTIVE: divide ( num denom -- fraction ) / ;\n" ] [ \ divide [ see ] with-string-writer ] unit-test\r
+[\r
+ T{ descriptive-error f\r
+ { { "num" 3 } { "denom" 0 } }\r
+ T{ division-by-zero f 3 }\r
+ divide\r
+ }\r
+] [\r
+ [ 3 0 divide ] [ ] recover\r
+] unit-test\r
+\r
+[ "USING: descriptive math ;\nIN: descriptive.tests\nDESCRIPTIVE: divide ( num denom -- fraction ) / ;\n" ]\r
+[ \ divide [ see ] with-string-writer ] unit-test\r
\r
DESCRIPTIVE:: divide* ( num denom -- fraction ) num denom / ;\r
\r
[ 3 ] [ 9 3 divide* ] unit-test\r
-[ T{ descriptive-error f { { "num" 3 } { "denom" 0 } } "Division by zero" divide* } ] [ [ 3 0 divide* ] [ ] recover ] unit-test\r
+\r
+[\r
+ T{ descriptive-error f\r
+ { { "num" 3 } { "denom" 0 } }\r
+ T{ division-by-zero f 3 }\r
+ divide*\r
+ }\r
+] [ [ 3 0 divide* ] [ ] recover ] unit-test\r
\r
[ "USING: descriptive math ;\nIN: descriptive.tests\nDESCRIPTIVE:: divide* ( num denom -- fraction ) num denom / ;\n" ] [ \ divide* [ see ] with-string-writer ] unit-test\r
USING: accessors calendar continuations destructors kernel math
-math.order namespaces system threads ui ui.gadgets.worlds ;
+math.order namespaces system threads ui ui.gadgets.worlds
+sequences ;
IN: game-loop
TUPLE: game-loop
drop ;
: ?tick ( loop count -- )
- dup zero? [ drop millis >>last-tick drop ] [
+ [ millis >>last-tick drop ] [
over [ since-last-tick ] [ tick-length>> ] bi >=
[ [ drop increment-tick ] [ drop tick ] [ 1- ?tick ] 2tri ]
[ 2drop ] if
- ] if ;
+ ] if-zero ;
: (run-loop) ( loop -- )
dup running?>>
! Copyright (C) 2008 Doug Coleman, Slava Pestov, Aaron Schaefer.
! See http://factorcode.org/license.txt for BSD license.
-USING: combinators.short-circuit kernel math math.constants math.functions
- math.vectors sequences ;
+USING: combinators.short-circuit kernel math math.constants
+math.functions math.vectors sequences ;
IN: math.analysis
<PRIVATE
] if ;
: (number>text) ( n -- str )
- [ negative-text ] [ abs 3digit-groups recombine ] bi append ;
+ [ negative-text ] [ abs 3 digit-groups recombine ] bi append ;
PRIVATE>
} cond ;
: over-1000000 ( n -- str )
- 3digit-groups [ 1+ units nth n-units ] map-index sift
+ 3 digit-groups [ 1+ units nth n-units ] map-index sift
reverse " " join ;
: decompose ( n -- str ) 1000000 /mod [ over-1000000 ] dip complete ;
USING: help.markup help.syntax ;
IN: math.text.utils
-HELP: 3digit-groups
-{ $values { "n" "a positive integer" } { "seq" "a sequence" } }
-{ $description "Decompose a number into 3 digits groups and return them in a sequence, starting with the units, then the tenths, etc." } ;
+HELP: digit-groups
+{ $values { "n" "a positive integer" } { "k" "a positive integer" } { "seq" "a sequence" } }
+{ $description "Decompose a number into groups of " { $snippet "k" } " digits and return them in a sequence starting with the least significant grouped digits first." } ;
USING: math.text.utils tools.test ;
-[ { 1 999 2 } ] [ 2999001 3digit-groups ] unit-test
+[ { 1 999 2 } ] [ 2999001 3 digit-groups ] unit-test
! Copyright (c) 2007, 2008 Aaron Schaefer.
! See http://factorcode.org/license.txt for BSD license.
-USING: kernel math sequences ;
+USING: kernel fry math.functions math sequences ;
IN: math.text.utils
-: 3digit-groups ( n -- seq )
- [ dup 0 > ] [ 1000 /mod ] produce nip ;
+: digit-groups ( n k -- seq )
+ [ dup 0 > ] swap '[ _ 10^ /mod ] produce nip ;
[
[ dup string>number [ nip ] [ not-an-integer ] if* ] bi@
] keep length
- 10 swap ^ / + swap [ neg ] when ;
+ 10^ / + swap [ neg ] when ;
SYNTAX: DECIMAL: scan parse-decimal parsed ;
! Copyright (c) 2008 Aaron Schaefer.
! See http://factorcode.org/license.txt for BSD license.
-USING: kernel math math.functions math.ranges project-euler.common sequences ;
+USING: kernel math math.functions math.ranges
+project-euler.common sequences ;
IN: project-euler.048
! http://projecteuler.net/index.php?section=problems&id=48
! --------
: euler048 ( -- answer )
- 1000 [1,b] [ dup ^ ] sigma 10 10 ^ mod ;
+ 1000 [1,b] [ dup ^ ] sigma 10 10^ mod ;
! [ euler048 ] 100 ave-time
! 276 ms run / 1 ms GC ave time - 100 trials
--- /dev/null
+USING: project-euler.151 tools.test ;
+IN: project-euler.151.tests
+
+[ 12138569781349/26138246400000 ] [ euler151 ] unit-test
: (pick-sheet) ( seq i -- newseq )
[
- <=> sgn
+ <=>
{
- { -1 [ ] }
- { 0 [ 1- ] }
- { 1 [ 1+ ] }
+ { +lt+ [ ] }
+ { +eq+ [ 1- ] }
+ { +gt+ [ 1+ ] }
} case
] curry map-index ;
{ 1 1 1 1 } (euler151)
] with-scope ;
-! TODO: doesn't work currently, problem in area of 'with map' in (euler151)
-
! [ euler151 ] 100 ave-time
! ? ms run time - 100 trials
! Copyright (c) 2007, 2008 Aaron Schaefer.
! See http://factorcode.org/license.txt for BSD license.
-USING: continuations fry io kernel make math math.functions math.parser
- math.statistics memory tools.time ;
+USING: continuations fry io kernel make math math.functions
+math.parser math.statistics memory tools.time ;
IN: project-euler.ave-time
: nth-place ( x n -- y )
- 10 swap ^ [ * round >integer ] keep /f ;
+ 10^ [ * round >integer ] keep /f ;
: collect-benchmarks ( quot n -- seq )
[
: cartesian-product ( seq1 seq2 -- seq1xseq2 )
[ [ 2array ] with map ] curry map concat ;
-: log10 ( m -- n )
- log 10 log / ;
-
: mediant ( a/c b/d -- (a+b)/(c+d) )
2>fraction [ + ] 2bi@ / ;
: svg-string>number ( string -- number )
{ { CHAR: E CHAR: e } } substitute "e" split1
- [ string>number ] [ [ string>number 10 swap ^ ] [ 1 ] if* ] bi* *
+ [ string>number ] [ [ string>number 10^ ] [ 1 ] if* ] bi* *
>float ;
: degrees ( deg -- rad ) pi * 180.0 / ;
projects / factor.git / commitdiff