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

db4
Joe Groff 2009-10-13 17:26:20 -05:00
commit 664185a306
19 changed files with 176 additions and 23 deletions

View File

@ -1,5 +1,5 @@
USING: calendar.format calendar kernel math tools.test USING: calendar.format calendar kernel math tools.test
io.streams.string accessors io math.order ; io.streams.string accessors io math.order sequences ;
IN: calendar.format.tests IN: calendar.format.tests
[ 0 ] [ [ 0 ] [
@ -81,3 +81,5 @@ IN: calendar.format.tests
] [ "Thursday, 02-Oct-2008 23:59:59 GMT" cookie-string>timestamp ] unit-test ] [ "Thursday, 02-Oct-2008 23:59:59 GMT" cookie-string>timestamp ] unit-test
[ ]
[ { 2008 2009 } [ year. ] each ] unit-test

View File

@ -66,7 +66,7 @@ M: array month. ( pair -- )
[ month-name write bl number>string print ] [ month-name write bl number>string print ]
[ 1 zeller-congruence ] [ 1 zeller-congruence ]
[ (days-in-month) day-abbreviations2 " " join print ] 2tri [ (days-in-month) day-abbreviations2 " " join print ] 2tri
over " " <repetition> concat write over " " <repetition> "" concat-as write
[ [
[ 1 + day. ] keep [ 1 + day. ] keep
1 + + 7 mod zero? [ nl ] [ bl ] if 1 + + 7 mod zero? [ nl ] [ bl ] if

View File

@ -49,7 +49,7 @@ M: funky url-of "http://www.funky-town.com/" swap town>> append ;
] make-html-string ] make-html-string
] unit-test ] unit-test
[ "<div style=\"background-color: #ff00ff; white-space: pre; font-family: monospace;\">cdr</div>" ] [ "<div style=\"background-color: #ff00ff; white-space: pre; font-family: monospace; display: inline-block;\">cdr</div>" ]
[ [
[ [
H{ { page-color T{ rgba f 1 0 1 1 } } } H{ { page-color T{ rgba f 1 0 1 1 } } }
@ -57,7 +57,7 @@ M: funky url-of "http://www.funky-town.com/" swap town>> append ;
] make-html-string ] make-html-string
] unit-test ] unit-test
[ "<div style=\"white-space: pre; font-family: monospace;\"></div>" ] [ [ "<div style=\"white-space: pre; font-family: monospace; display: inline-block;\"></div><br/>" ] [
[ H{ } [ ] with-nesting nl ] make-html-string [ H{ } [ ] with-nesting nl ] make-html-string
] unit-test ] unit-test

View File

@ -113,7 +113,7 @@ CONSTANT: pre-css "white-space: pre; font-family: monospace;"
{ inset padding-css, } { inset padding-css, }
} make-css } make-css
] [ wrap-margin swap at [ pre-css append ] unless ] bi ] [ wrap-margin swap at [ pre-css append ] unless ] bi
"display: inline-block;" append ; " display: inline-block;" append ;
: div-tag ( xml style -- xml' ) : div-tag ( xml style -- xml' )
div-css-style div-css-style

View File

@ -41,7 +41,21 @@ $nl
POSTPONE: SIMD: POSTPONE: SIMD:
POSTPONE: SIMDS: POSTPONE: SIMDS:
} }
"The following vector types are supported:" "The following scalar types are supported:"
{ $code
"char"
"uchar"
"short"
"ushort"
"int"
"uint"
"longlong"
"ulonglong"
"float"
"double"
}
"The following vector types are generated from the above scalar types:"
{ $code { $code
"char-16" "char-16"
"uchar-16" "uchar-16"
@ -89,6 +103,7 @@ $nl
{ $code { $code
"""USING: compiler.tree.debugger math.vectors """USING: compiler.tree.debugger math.vectors
math.vectors.simd ; math.vectors.simd ;
SIMD: double
SYMBOLS: x y ; SYMBOLS: x y ;
[ [
@ -107,7 +122,7 @@ IN: simd-demo
{ float-4 float-4 float-4 } declare { float-4 float-4 float-4 } declare
[ v* ] [ [ 1.0 ] dip n-v v* ] bi-curry* bi v+ ; [ v* ] [ [ 1.0 ] dip n-v v* ] bi-curry* bi v+ ;
\ interpolate optimizer-report.""" } \\ interpolate optimizer-report.""" }
"Note that using " { $link declare } " is not recommended. Safer ways of getting type information for the input parameters to a word include defining methods on a generic word (the value being dispatched upon has a statically known type in the method body), as well as using " { $link "hints" } " and " { $link POSTPONE: inline } " declarations." "Note that using " { $link declare } " is not recommended. Safer ways of getting type information for the input parameters to a word include defining methods on a generic word (the value being dispatched upon has a statically known type in the method body), as well as using " { $link "hints" } " and " { $link POSTPONE: inline } " declarations."
$nl $nl
"Here is a better version of the " { $snippet "interpolate" } " words above that uses hints:" "Here is a better version of the " { $snippet "interpolate" } " words above that uses hints:"
@ -122,7 +137,7 @@ IN: simd-demo
HINTS: interpolate float-4 float-4 float-4 ; HINTS: interpolate float-4 float-4 float-4 ;
\ interpolate optimizer-report. """ } \\ interpolate optimizer-report. """ }
"This time, the optimizer report lists calls to both SIMD primitives and high-level vector words, because hints cause two code paths to be generated. The " { $snippet "optimized." } " word can be used to make sure that the fast code path consists entirely of calls to primitives." "This time, the optimizer report lists calls to both SIMD primitives and high-level vector words, because hints cause two code paths to be generated. The " { $snippet "optimized." } " word can be used to make sure that the fast code path consists entirely of calls to primitives."
$nl $nl
"If the " { $snippet "interpolate" } " word was to be used in several places with different types of vectors, it would be best to declare it " { $link POSTPONE: inline } "." "If the " { $snippet "interpolate" } " word was to be used in several places with different types of vectors, it would be best to declare it " { $link POSTPONE: inline } "."
@ -153,13 +168,13 @@ M: actor advance ( dt actor -- )
[ >float ] dip [ >float ] dip
[ update-velocity ] [ update-position ] 2bi ; [ update-velocity ] [ update-position ] 2bi ;
M\ actor advance optimized.""" M\\ actor advance optimized."""
} }
"The " { $vocab-link "compiler.cfg.debugger" } " vocabulary can give a lower-level picture of the generated code, that includes register assignments and other low-level details. To look at low-level optimizer output, call " { $snippet "test-mr mr." } " on a word or quotation:" "The " { $vocab-link "compiler.cfg.debugger" } " vocabulary can give a lower-level picture of the generated code, that includes register assignments and other low-level details. To look at low-level optimizer output, call " { $snippet "test-mr mr." } " on a word or quotation:"
{ $code { $code
"""USE: compiler.tree.debugger """USE: compiler.tree.debugger
M\ actor advance test-mr mr.""" } M\\ actor advance test-mr mr.""" }
"An example of a high-performance algorithm that uses SIMD primitives can be found in the " { $vocab-link "benchmark.nbody-simd" } " vocabulary." ; "An example of a high-performance algorithm that uses SIMD primitives can be found in the " { $vocab-link "benchmark.nbody-simd" } " vocabulary." ;
ARTICLE: "math.vectors.simd.intrinsics" "Low-level SIMD primitives" ARTICLE: "math.vectors.simd.intrinsics" "Low-level SIMD primitives"
@ -206,7 +221,7 @@ ARTICLE: "math.vectors.simd" "Hardware vector arithmetic (SIMD)"
HELP: SIMD: HELP: SIMD:
{ $syntax "SIMD: type" } { $syntax "SIMD: type" }
{ $values { "type" "a scalar C type" } } { $values { "type" "a scalar C type" } }
{ $description "Defines 128-bit and 256-bit SIMD arrays for holding elements of " { $snippet "type" } " into the vocabulary search path. The possible type/length combinations are listed in " { $link "math.vectors.simd.types" } " and the generated words are documented in " { $link "math.vectors.simd.words" } "." } ; { $description "Defines 128-bit and 256-bit SIMD arrays for holding elements of " { $snippet "type" } " into the vocabulary search path. The allowed scalar types, and the auto-generated type/length vector combinations that result, are listed in " { $link "math.vectors.simd.types" } ". Generated words are documented in " { $link "math.vectors.simd.words" } "." } ;
HELP: SIMDS: HELP: SIMDS:
{ $syntax "SIMDS: type type type ... ;" } { $syntax "SIMDS: type type type ... ;" }

View File

@ -0,0 +1,4 @@
USING: project-euler.065 tools.test ;
IN: project-euler.065.tests
[ 272 ] [ euler065 ] unit-test

View File

@ -0,0 +1,77 @@
! Copyright (c) 2009 Guillaume Nargeot.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel math lists lists.lazy project-euler.common sequences ;
IN: project-euler.065
! http://projecteuler.net/index.php?section=problems&id=065
! DESCRIPTION
! -----------
! The square root of 2 can be written as an infinite continued fraction.
! 1
! √2 = 1 + -------------------------
! 1
! 2 + ---------------------
! 1
! 2 + -----------------
! 1
! 2 + -------------
! 2 + ...
! The infinite continued fraction can be written, √2 = [1;(2)], (2) indicates
! that 2 repeats ad infinitum. In a similar way, √23 = [4;(1,3,1,8)].
! It turns out that the sequence of partial values of continued fractions for
! square roots provide the best rational approximations. Let us consider the
! convergents for √2.
! 1 3 1 7 1 17 1 41
! 1 + - = - ; 1 + ----- = - ; 1 + --------- = -- ; 1 + ------------- = --
! 2 2 1 5 1 12 1 29
! 2 + - 2 + ----- 2 + ---------
! 2 1 1
! 2 + - 2 + -----
! 2 1
! 2 + -
! 2
! Hence the sequence of the first ten convergents for √2 are:
! 1, 3/2, 7/5, 17/12, 41/29, 99/70, 239/169, 577/408, 1393/985, 3363/2378, ...
! What is most surprising is that the important mathematical constant,
! e = [2; 1,2,1, 1,4,1, 1,6,1 , ... , 1,2k,1, ...].
! The first ten terms in the sequence of convergents for e are:
! 2, 3, 8/3, 11/4, 19/7, 87/32, 106/39, 193/71, 1264/465, 1457/536, ...
! The sum of digits in the numerator of the 10th convergent is 1+4+5+7=17.
! Find the sum of digits in the numerator of the 100th convergent of the
! continued fraction for e.
! SOLUTION
! --------
<PRIVATE
: (e-frac) ( -- seq )
2 lfrom [
dup 3 mod zero? [ 3 / 2 * ] [ drop 1 ] if
] lazy-map ;
: e-frac ( n -- n )
1 - (e-frac) ltake list>array reverse 0
[ + recip ] reduce 2 + ;
PRIVATE>
: euler065 ( -- answer )
100 e-frac numerator number>digits sum ;
! [ euler065 ] 100 ave-time
! 4 ms ave run time - 0.33 SD (100 trials)
SOLUTION: euler065

View File

@ -0,0 +1 @@
Guillaume Nargeot

View File

@ -30,7 +30,7 @@ IN: project-euler.072
! The answer can be found by adding totient(n) for 2 ≤ n ≤ 1e6 ! The answer can be found by adding totient(n) for 2 ≤ n ≤ 1e6
: euler072 ( -- answer ) : euler072 ( -- answer )
2 1000000 [a,b] [ totient ] [ + ] map-reduce ; 2 1000000 [a,b] [ totient ] sigma ;
! [ euler072 ] 100 ave-time ! [ euler072 ] 100 ave-time
! 5274 ms ave run time - 102.7 SD (100 trials) ! 5274 ms ave run time - 102.7 SD (100 trials)

View File

@ -0,0 +1 @@
Guillaume Nargeot

View File

@ -0,0 +1 @@
Guillaume Nargeot

View File

@ -0,0 +1 @@
Guillaume Nargeot

View File

@ -0,0 +1 @@
Guillaume Nargeot

View File

@ -0,0 +1 @@
Guillaume Nargeot

View File

@ -0,0 +1 @@
Guillaume Nargeot

View File

@ -0,0 +1,4 @@
USING: project-euler.188 tools.test ;
IN: project-euler.188.tests
[ 95962097 ] [ euler188 ] unit-test

View File

@ -0,0 +1,43 @@
! Copyright (c) 2009 Guillaume Nargeot.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel math math.functions project-euler.common ;
IN: project-euler.188
! http://projecteuler.net/index.php?section=problems&id=188
! DESCRIPTION
! -----------
! The hyperexponentiation or tetration of a number a by a positive integer b,
! denoted by a↑↑b or ^(b)a, is recursively defined by:
! a↑↑1 = a,
! a↑↑(k+1) = a^(a↑↑k).
! Thus we have e.g. 3↑↑2 = 3^3 = 27, hence
! 3↑↑3 = 3^27 = 7625597484987 and
! 3↑↑4 is roughly 10^(3.6383346400240996*10^12).
! Find the last 8 digits of 1777↑↑1855.
! SOLUTION
! --------
! Using modular exponentiation.
! http://en.wikipedia.org/wiki/Modular_exponentiation
<PRIVATE
: hyper-exp-mod ( a b m -- e )
1 rot [ [ 2dup ] dip swap ^mod ] times 2nip ;
PRIVATE>
: euler188 ( -- answer )
1777 1855 10 8 ^ hyper-exp-mod ;
! [ euler188 ] 100 ave-time
! 4 ms ave run time - 0.05 SD (100 trials)
SOLUTION: euler188

View File

@ -0,0 +1 @@
Guillaume Nargeot

View File

@ -16,15 +16,15 @@ USING: definitions io io.files io.pathnames kernel math math.parser
project-euler.045 project-euler.046 project-euler.047 project-euler.048 project-euler.045 project-euler.046 project-euler.047 project-euler.048
project-euler.049 project-euler.051 project-euler.052 project-euler.053 project-euler.049 project-euler.051 project-euler.052 project-euler.053
project-euler.054 project-euler.055 project-euler.056 project-euler.057 project-euler.054 project-euler.055 project-euler.056 project-euler.057
project-euler.058 project-euler.059 project-euler.063 project-euler.067 project-euler.058 project-euler.059 project-euler.063 project-euler.065
project-euler.069 project-euler.071 project-euler.072 project-euler.073 project-euler.067 project-euler.069 project-euler.071 project-euler.072
project-euler.074 project-euler.075 project-euler.076 project-euler.079 project-euler.073 project-euler.074 project-euler.075 project-euler.076
project-euler.085 project-euler.092 project-euler.097 project-euler.099 project-euler.079 project-euler.085 project-euler.092 project-euler.097
project-euler.100 project-euler.102 project-euler.112 project-euler.116 project-euler.099 project-euler.100 project-euler.102 project-euler.112
project-euler.117 project-euler.124 project-euler.134 project-euler.148 project-euler.116 project-euler.117 project-euler.124 project-euler.134
project-euler.150 project-euler.151 project-euler.164 project-euler.169 project-euler.148 project-euler.150 project-euler.151 project-euler.164
project-euler.173 project-euler.175 project-euler.186 project-euler.190 project-euler.169 project-euler.173 project-euler.175 project-euler.186
project-euler.203 project-euler.215 ; project-euler.188 project-euler.190 project-euler.203 project-euler.215 ;
IN: project-euler IN: project-euler
<PRIVATE <PRIVATE