Doug Coleman 2008-01-02 01:49:10 -06:00
commit 7c77535824
26 changed files with 464 additions and 209 deletions

View File

@ -27,4 +27,4 @@ DEFER: crc32-table inline
: crc32 ( seq -- n )
>r HEX: ffffffff dup r> [ (crc32) ] each bitxor ;
: file-crc32 ( path -- n ) <file-reader> contents crc32 ;
: file-crc32 ( path -- n ) file-contents crc32 ;

View File

@ -23,11 +23,11 @@ USING: tools.test io.files io threads kernel ;
] unit-test
[ "Hello world.\nHello appender.\n" ] [
"test-foo.txt" resource-path <file-reader> contents
"test-foo.txt" resource-path file-contents
] unit-test
[ "Hello appender.\n" ] [
"test-bar.txt" resource-path <file-reader> contents
"test-bar.txt" resource-path file-contents
] unit-test
[ ] [ "test-foo.txt" resource-path delete-file ] unit-test

View File

@ -1,8 +1,8 @@
! Copyright (C) 2003, 2007 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: hashtables generic kernel math namespaces sequences strings
continuations assocs io.files io.styles sbufs ;
IN: io
USING: hashtables generic kernel math namespaces
sequences strings continuations assocs io.styles sbufs ;
GENERIC: stream-close ( stream -- )
GENERIC: set-timeout ( n stream -- )
@ -90,3 +90,6 @@ SYMBOL: stdio
: contents ( stream -- str )
2048 <sbuf> [ stream-copy ] keep >string ;
: file-contents ( path -- str )
dup <file-reader> swap file-length <sbuf> [ stream-copy ] keep >string ;

View File

@ -63,7 +63,7 @@ uses definitions ;
: reset-checksums ( -- )
source-files get [
swap ?resource-path dup exists?
[ <file-reader> contents record-checksum ] [ 2drop ] if
[ file-contents record-checksum ] [ 2drop ] if
] assoc-each ;
M: pathname where pathname-string 1 2array ;

View File

@ -1,4 +1,4 @@
USING: cryptlib.libcl cryptlib prettyprint kernel alien sequences libc math
USING: cryptlib.libcl cryptlib prettyprint kernel alien sequences libc math
tools.test io io.files continuations alien.c-types splitting generic.math ;
"=========================================================" print
@ -53,12 +53,12 @@ tools.test io io.files continuations alien.c-types splitting generic.math ;
! de-envelope
CRYPT_FORMAT_AUTO [
[ envelope-handle get-pop-buffer get-bytes-copied push-data ] [
dup CRYPT_ENVELOPE_RESOURCE = [
dup CRYPT_ENVELOPE_RESOURCE = [
envelope-handle CRYPT_ENVINFO_PASSWORD
"password" set-attribute-string
] [
"password" set-attribute-string
] [
rethrow
] if
] if
] recover drop
get-bytes-copied .
envelope-handle flush-data
@ -124,17 +124,17 @@ tools.test io io.files continuations alien.c-types splitting generic.math ;
! de-envelope
CRYPT_FORMAT_AUTO [
[ envelope-handle get-pop-buffer get-bytes-copied push-data ] [
dup CRYPT_ENVELOPE_RESOURCE = [
dup CRYPT_ENVELOPE_RESOURCE = [
CRYPT_ALGO_IDEA create-context
context-handle CRYPT_CTXINFO_KEY "0123456789ABCDEF"
set-attribute-string
envelope-handle CRYPT_ENVINFO_SESSIONKEY context-handle *int
envelope-handle CRYPT_ENVINFO_SESSIONKEY context-handle *int
set-attribute
] [
rethrow
] if
] [
rethrow
] if
] recover drop
get-bytes-copied .
destroy-context
envelope-handle flush-data
@ -151,8 +151,8 @@ tools.test io io.files continuations alien.c-types splitting generic.math ;
[
! envelope
CRYPT_FORMAT_CRYPTLIB [
"extra/cryptlib/test/large_data.txt" resource-path <file-reader>
contents set-pop-buffer
"extra/cryptlib/test/large_data.txt" resource-path
file-contents set-pop-buffer
envelope-handle CRYPT_ATTRIBUTE_BUFFERSIZE
get-pop-buffer alien>char-string length 10000 + set-attribute
envelope-handle CRYPT_ENVINFO_DATASIZE
@ -175,9 +175,9 @@ tools.test io io.files continuations alien.c-types splitting generic.math ;
envelope-handle get-bytes-copied pop-data
get-bytes-copied .
! pop-buffer-string .
[ "/opt/local/lib/libcl.dylib(dylib1.o):" ]
[ "/opt/local/lib/libcl.dylib(dylib1.o):" ]
[ pop-buffer-string "\n" split first ] unit-test
[ "00000000 t __mh_dylib_header" ]
[ "00000000 t __mh_dylib_header" ]
[ pop-buffer-string "\n" split last/first first ] unit-test
] with-envelope
] with-cryptlib
@ -192,7 +192,7 @@ tools.test io io.files continuations alien.c-types splitting generic.math ;
CRYPT_FORMAT_CRYPTLIB [
envelope-handle CRYPT_ENVINFO_PASSWORD "password" set-attribute-string
"extra/cryptlib/test/large_data.txt" resource-path
<file-reader> contents set-pop-buffer
file-contents set-pop-buffer
envelope-handle CRYPT_ATTRIBUTE_BUFFERSIZE
get-pop-buffer alien>char-string length 10000 + set-attribute
envelope-handle CRYPT_ENVINFO_DATASIZE
@ -204,17 +204,17 @@ tools.test io io.files continuations alien.c-types splitting generic.math ;
get-bytes-copied .
pop-buffer-string .
] with-envelope
! de-envelope
CRYPT_FORMAT_AUTO [
envelope-handle CRYPT_ATTRIBUTE_BUFFERSIZE 130000 set-attribute
[ envelope-handle get-pop-buffer get-bytes-copied push-data ] [
dup CRYPT_ENVELOPE_RESOURCE = [
dup CRYPT_ENVELOPE_RESOURCE = [
envelope-handle CRYPT_ENVINFO_PASSWORD
"password" set-attribute-string
] [
rethrow
] if
] [
rethrow
] if
] recover drop
get-bytes-copied .
@ -226,7 +226,7 @@ tools.test io io.files continuations alien.c-types splitting generic.math ;
[ "/opt/local/lib/libcl.dylib(dylib1.o):" ]
[ pop-buffer-string "\n" split first ] unit-test
[ "00000000 t __mh_dylib_header" ]
[ "00000000 t __mh_dylib_header" ]
[ pop-buffer-string "\n" split last/first first ] unit-test
] with-envelope
] with-cryptlib
@ -274,7 +274,7 @@ tools.test io io.files continuations alien.c-types splitting generic.math ;
check-certificate
add-public-key
f 0 CRYPT_CERTFORMAT_TEXT_CERTIFICATE export-certificate
get-cert-length *int dup malloc swap
get-cert-length *int dup malloc swap
CRYPT_CERTFORMAT_TEXT_CERTIFICATE export-certificate
get-cert-buffer alien>char-string print
] with-certificate
@ -295,15 +295,15 @@ tools.test io io.files continuations alien.c-types splitting generic.math ;
! ...
! <at> localhost's password: (any password will be accepted)
! If you want to run the test again you should clean the [localhost]:3000
! ssh-rsa entry in the known_hosts file, in your home directory under the .ssh
! If you want to run the test again you should clean the [localhost]:3000
! ssh-rsa entry in the known_hosts file, in your home directory under the .ssh
! folder, since the test generates a new RSA certificate on every run.
[
CRYPT_KEYSET_FILE "extra/cryptlib/test/keys.p15" resource-path
CRYPT_KEYOPT_READONLY [
CRYPT_KEYID_NAME "private key" "password" get-private-key
CRYPT_SESSION_SSH_SERVER [
session-handle CRYPT_SESSINFO_SERVER_NAME "localhost"
@ -312,7 +312,7 @@ tools.test io io.files continuations alien.c-types splitting generic.math ;
session-handle CRYPT_SESSINFO_SERVER_PORT 3000 set-attribute
session-handle CRYPT_SESSINFO_PRIVATEKEY
context-handle *int set-attribute
[ session-handle CRYPT_SESSINFO_ACTIVE 1 set-attribute ] [
@ -328,9 +328,9 @@ tools.test io io.files continuations alien.c-types splitting generic.math ;
length push-data
session-handle flush-data
] [
rethrow
] if
] [
rethrow
] if
] recover drop
] with-session
] with-keyset

View File

@ -81,11 +81,11 @@ IN: html.parser.analyzer
! ] if ;
! clear "/Users/erg/web/fark.html" <file-reader> contents parse-html find-links [ "go.pl" swap start ] subset [ "=" split peek ] map
! clear "/Users/erg/web/fark.html" file-contents parse-html find-links [ "go.pl" swap start ] subset [ "=" split peek ] map
! clear "http://fark.com" http-get parse-html find-links [ "go.pl" swap start ] subset [ "=" split peek ] map
! clear "/Users/erg/web/hostels.html" <file-reader> contents parse-html "Currency" "name" pick find-first-attribute-key-value
! clear "/Users/erg/web/hostels.html" file-contents parse-html "Currency" "name" pick find-first-attribute-key-value
! clear "/Users/erg/web/hostels.html" <file-reader> contents parse-html
! clear "/Users/erg/web/hostels.html" file-contents parse-html
! "Currency" "name" pick find-first-attribute-key-value
! pick find-between remove-blank-text

View File

@ -1,18 +1,14 @@
USING: io io.files io.streams.string http.server.templating
kernel tools.test sequences ;
USING: io io.files io.streams.string http.server.templating kernel tools.test
sequences ;
IN: temporary
: test-template ( path -- ? )
"extra/http/server/templating/test/" swap append
[
".fhtml" append resource-path
[ run-template-file ] string-out
] keep
".html" append resource-path
<file-reader> contents
= ;
".html" append resource-path file-contents = ;
[ t ] [ "example" test-template ] unit-test
[ t ] [ "bug" test-template ] unit-test

View File

@ -82,7 +82,7 @@ DEFER: <% delimiter
templating-vocab use+
dup source-file file set ! so that reload works properly
[
?resource-path <file-reader> contents
?resource-path file-contents
[ eval-template ] [ html-error. drop ] recover
] keep
] with-scope

View File

@ -1,9 +1,7 @@
! Copyright (C) 2007 Gavin Harrison
! See http://factorcode.org/license.txt for BSD license.
USING: kernel math sequences kernel.private namespaces arrays
io io.files splitting io.binary math.functions vectors
quotations combinators.private ;
USING: kernel math sequences kernel.private namespaces arrays io io.files
splitting io.binary math.functions vectors quotations combinators.private ;
IN: icfp.2006
SYMBOL: regs
@ -58,7 +56,7 @@ SYMBOL: open-arrays
>r get-cba r>
swap >r >r [ reg-val ] 2apply swap r> call r>
set-reg f ; inline
: op1 ( opcode -- ? )
[ swap arr-val ] binary-op ;
@ -89,7 +87,7 @@ SYMBOL: open-arrays
: op8 ( opcode -- ? )
?grow-storage
get-cb >r reg-val open-arrays get pop [ new-array ] keep r>
get-cb >r reg-val open-arrays get pop [ new-array ] keep r>
set-reg f ;
: op9 ( opcode -- ? )
@ -111,7 +109,7 @@ SYMBOL: open-arrays
: op13 ( opcode -- ? )
[ get-value ] keep get-special set-reg f ;
: advance ( -- val opcode )
finger get arrays get first nth
finger inc dup get-op ;
@ -129,7 +127,7 @@ SYMBOL: open-arrays
[ run-op exec-loop ] unless ;
: load-platters ( path -- )
<file-reader> contents 4 group [ be> ] map
file-contents 4 group [ be> ] map
0 arrays get set-nth ;
: init ( path -- )

View File

@ -1,11 +1,9 @@
USING: io io.mmap io.files kernel tools.test continuations
sequences ;
USING: io io.mmap io.files kernel tools.test continuations sequences ;
IN: temporary
[ "mmap-test-file.txt" resource-path delete-file ] catch drop
[ ] [ "mmap-test-file.txt" resource-path <file-writer> [ "12345" write ] with-stream ] unit-test
[ ] [ "mmap-test-file.txt" resource-path dup file-length [ CHAR: 2 0 pick set-nth drop ] with-mapped-file ] unit-test
[ 5 ] [ "mmap-test-file.txt" resource-path dup file-length [ length ] with-mapped-file ] unit-test
[ "22345" ] [ "mmap-test-file.txt" resource-path <file-reader> contents ] unit-test
[ "22345" ] [ "mmap-test-file.txt" resource-path file-contents ] unit-test
[ "mmap-test-file.txt" resource-path delete-file ] catch drop

View File

@ -1,7 +1,7 @@
! Copyright (C) 2007 Adam Wendt.
! See http://factorcode.org/license.txt for BSD license.
!
USING: alien alien.c-types byte-arrays io io.binary io.files kernel mad namespaces prettyprint sbufs sequences tools.interpreter vars ;
USING: alien alien.c-types byte-arrays io io.binary io.files kernel mad
namespaces prettyprint sbufs sequences tools.interpreter vars ;
IN: mad.api
VARS: buffer-start buffer-length output-callback-var ;
@ -16,27 +16,27 @@ VARS: buffer-start buffer-length output-callback-var ;
{ "void*" "mad_header*" } create-mad-callback-generic ; inline
: create-filter-callback ( sequence -- alien )
{ "void*" "mad_stream*" "mad_frame*" } create-mad-callback-generic ; inline
{ "void*" "mad_stream*" "mad_frame*" } create-mad-callback-generic ; inline
: create-output-callback ( sequence -- alien )
{ "void*" "mad_header*" "mad_pcm*" } create-mad-callback-generic ; inline
{ "void*" "mad_header*" "mad_pcm*" } create-mad-callback-generic ; inline
: create-error-callback ( sequence -- alien )
{ "void*" "mad_stream*" "mad_frame*" } create-mad-callback-generic ; inline
{ "void*" "mad_stream*" "mad_frame*" } create-mad-callback-generic ; inline
: create-message-callback ( sequence -- alien )
{ "void*" "void*" "uint*" } create-mad-callback-generic ; inline
{ "void*" "void*" "uint*" } create-mad-callback-generic ; inline
: input ( buffer mad_stream -- mad_flow )
"input" print flush
nip ! mad_stream
nip ! mad_stream
buffer-start get ! mad_stream start
buffer-length get ! mad_stream start length
dup 0 = ! mad-stream start length bool
[ 3drop MAD_FLOW_STOP ] ! mad_flow
[ mad_stream_buffer !
0 buffer-length set !
MAD_FLOW_CONTINUE ] if ; ! mad_flow
[ mad_stream_buffer !
0 buffer-length set !
MAD_FLOW_CONTINUE ] if ; ! mad_flow
: input-callback ( -- callback )
[ input ] create-input-callback ;
@ -46,11 +46,11 @@ VARS: buffer-start buffer-length output-callback-var ;
: filter-callback ( -- callback )
[ "filter" print flush 3drop MAD_FLOW_CONTINUE ] create-filter-callback ;
: write-sample ( sample -- )
4 >le write ;
: output ( data header pcm -- mad_flow )
: write-sample ( sample -- )
4 >le write ;
: output ( data header pcm -- mad_flow )
"output" . flush
-rot 2drop output-callback-var> call
[ MAD_FLOW_CONTINUE ] [ MAD_FLOW_STOP ] if ;
@ -80,11 +80,8 @@ VARS: buffer-start buffer-length output-callback-var ;
: make-decoder ( -- decoder )
"mad_decoder" malloc-object ;
: file-contents ( path -- string )
dup <file-reader> swap file-length <sbuf> [ stream-copy ] keep >byte-array ;
: malloc-file-contents ( path -- alien )
file-contents malloc-byte-array ;
file-contents >byte-array malloc-byte-array ;
: mad-run ( -- int )
make-decoder [ mad-init ] keep MAD_DECODER_MODE_SYNC mad_decoder_run ;
@ -98,4 +95,3 @@ VARS: buffer-start buffer-length output-callback-var ;
: mad-test ( -- results )
[ output-stdout ] >output-callback-var
"/home/adam/download/mp3/Misc/wutbf.mp3" decode-mp3 ;

View File

@ -1,6 +1,6 @@
! Copyright (c) 2007 Aaron Schaefer, Samuel Tardieu.
! See http://factorcode.org/license.txt for BSD license.
USING: math.primes sequences ;
USING: kernel math.primes sequences ;
IN: project-euler.010
! http://projecteuler.net/index.php?section=problems&id=10
@ -16,10 +16,8 @@ IN: project-euler.010
! SOLUTION
! --------
! Summing of prime numbers
: euler010 ( -- answer )
1000000 primes-upto sum ;
1000000 primes-upto sum ;
! [ euler010 ] 100 ave-time
! 14 ms run / 0 ms GC ave time - 100 trials

View File

@ -1,6 +1,6 @@
! Copyright (c) 2007 Aaron Schaefer.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel math.functions math.parser sequences ;
USING: kernel math.functions math.parser project-euler.common sequences ;
IN: project-euler.016
! http://projecteuler.net/index.php?section=problems&id=16
@ -16,9 +16,6 @@ IN: project-euler.016
! SOLUTION
! --------
: number>digits ( n -- seq )
number>string string>digits ;
: euler016 ( -- answer )
2 1000 ^ number>digits sum ;

View File

@ -1,6 +1,7 @@
! Copyright (c) 2007 Samuel Tardieu.
! Copyright (c) 2007 Samuel Tardieu, Aaron Schaefer.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel math namespaces sequences strings ;
USING: combinators.lib kernel math math.ranges math.text namespaces sequences
strings ;
IN: project-euler.017
! http://projecteuler.net/index.php?section=problems&id=17
@ -18,6 +19,7 @@ IN: project-euler.017
! forty-two) contains 23 letters and 115 (one hundred and fifteen) contains
! 20 letters.
! SOLUTION
! --------
@ -38,18 +40,18 @@ IN: project-euler.017
DEFER: make-english
: maybe-add ( n sep -- )
over 0 = [ 2drop ] [ % make-english ] if ;
over zero? [ 2drop ] [ % make-english ] if ;
: 0-99 ( n -- )
dup 20 < [ units ] [ 10 /mod swap tenths "-" maybe-add ] if ;
: 0-999 ( n -- )
100 /mod swap
dup 0 = [ drop 0-99 ] [ units " hundred" % " and " maybe-add ] if ;
dup zero? [ drop 0-99 ] [ units " hundred" % " and " maybe-add ] if ;
: make-english ( n -- )
1000 /mod swap
dup 0 = [ drop 0-999 ] [ 0-999 " thousand" % " and " maybe-add ] if ;
dup zero? [ drop 0-999 ] [ 0-999 " thousand" % " and " maybe-add ] if ;
PRIVATE>
@ -57,9 +59,19 @@ PRIVATE>
[ make-english ] "" make ;
: euler017 ( -- answer )
1000 [ 1 + >english [ letter? ] subset length ] map sum ;
1000 [1,b] [ >english [ letter? ] subset length ] map sum ;
! [ euler017 ] 100 ave-time
! 9 ms run / 0 ms GC ave time - 100 trials
! ALTERNATE SOLUTIONS
! -------------------
: euler017a ( -- answer )
1000 [1,b] SBUF" " clone [ number>text over push-all ] reduce [ Letter? ] count ;
! [ euler017a ] 100 ave-time
! 14 ms run / 1 ms GC ave time - 100 trials
MAIN: euler017

View File

@ -1,6 +1,6 @@
! Copyright (c) 2007 Samuel Tardieu.
! Copyright (c) 2007 Samuel Tardieu, Aaron Schaefer.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel math sequences ;
USING: kernel math project-euler.common sequences ;
IN: project-euler.018
! http://projecteuler.net/index.php?section=problems&id=18
@ -8,39 +8,39 @@ IN: project-euler.018
! DESCRIPTION
! -----------
! By starting at the top of the triangle below and moving to adjacent
! numbers on the row below, the maximum total from top to bottom is
! 23.
! By starting at the top of the triangle below and moving to adjacent numbers
! on the row below, the maximum total from top to bottom is 23.
! 3
! 7 5
! 2 4 6
! 8 5 9 3
! 3
! 7 5
! 2 4 6
! 8 5 9 3
! That is, 3 + 7 + 4 + 9 = 23.
! Find the maximum total from top to bottom of the triangle below:
! 75
! 95 64
! 17 47 82
! 18 35 87 10
! 20 04 82 47 65
! 19 01 23 75 03 34
! 88 02 77 73 07 63 67
! 99 65 04 28 06 16 70 92
! 41 41 26 56 83 40 80 70 33
! 41 48 72 33 47 32 37 16 94 29
! 53 71 44 65 25 43 91 52 97 51 14
! 70 11 33 28 77 73 17 78 39 68 17 57
! 91 71 52 38 17 14 91 43 58 50 27 29 48
! 63 66 04 68 89 53 67 30 73 16 69 87 40 31
! 04 62 98 27 23 09 70 98 73 93 38 53 60 04 23
! 75
! 95 64
! 17 47 82
! 18 35 87 10
! 20 04 82 47 65
! 19 01 23 75 03 34
! 88 02 77 73 07 63 67
! 99 65 04 28 06 16 70 92
! 41 41 26 56 83 40 80 70 33
! 41 48 72 33 47 32 37 16 94 29
! 53 71 44 65 25 43 91 52 97 51 14
! 70 11 33 28 77 73 17 78 39 68 17 57
! 91 71 52 38 17 14 91 43 58 50 27 29 48
! 63 66 04 68 89 53 67 30 73 16 69 87 40 31
! 04 62 98 27 23 09 70 98 73 93 38 53 60 04 23
! NOTE: As there are only 16384 routes, it is possible to solve this problem by
! trying every route. However, Problem 67, is the same challenge with a
! triangle containing one-hundred rows; it cannot be solved by brute force, and
! requires a clever method! ;o)
! NOTE: As there are only 16384 routes, it is possible to solve this
! problem by trying every route. However, Problem 67, is the same
! challenge with a triangle containing one-hundred rows; it cannot be
! solved by brute force, and requires a clever method! ;o)
! SOLUTION
! --------
@ -51,40 +51,71 @@ IN: project-euler.018
<PRIVATE
: pyramid ( -- seq )
{
75
95 64
17 47 82
18 35 87 10
20 04 82 47 65
19 01 23 75 03 34
88 02 77 73 07 63 67
99 65 04 28 06 16 70 92
41 41 26 56 83 40 80 70 33
41 48 72 33 47 32 37 16 94 29
53 71 44 65 25 43 91 52 97 51 14
70 11 33 28 77 73 17 78 39 68 17 57
91 71 52 38 17 14 91 43 58 50 27 29 48
63 66 04 68 89 53 67 30 73 16 69 87 40 31
04 62 98 27 23 09 70 98 73 93 38 53 60 04 23
}
15 [ 1+ cut swap ] map nip ;
{
75
95 64
17 47 82
18 35 87 10
20 04 82 47 65
19 01 23 75 03 34
88 02 77 73 07 63 67
99 65 04 28 06 16 70 92
41 41 26 56 83 40 80 70 33
41 48 72 33 47 32 37 16 94 29
53 71 44 65 25 43 91 52 97 51 14
70 11 33 28 77 73 17 78 39 68 17 57
91 71 52 38 17 14 91 43 58 50 27 29 48
63 66 04 68 89 53 67 30 73 16 69 87 40 31
04 62 98 27 23 09 70 98 73 93 38 53 60 04 23
}
15 [ 1+ cut swap ] map nip ;
PRIVATE>
! Propagate one row into the upper one
: propagate ( bottom top -- newtop )
[ over 1 tail rot first2 max rot + ] map nip ;
[ over 1 tail rot first2 max rot + ] map nip ;
! Not strictly needed, but it is nice to be able to dump the pyramid after
! the propagation
: propagate-all ( pyramid -- newpyramid )
reverse [ first dup ] keep 1 tail [ propagate dup ] map nip reverse swap add ;
reverse [ first dup ] keep 1 tail [ propagate dup ] map nip reverse swap add ;
: euler018 ( -- best )
pyramid propagate-all first first ;
: euler018 ( -- answer )
pyramid propagate-all first first ;
! [ euler018 ] 100 ave-time
! 0 ms run / 0 ms GC time
! 0 ms run / 0 ms GC ave time - 100 trials
! ALTERNATE SOLUTIONS
! -------------------
<PRIVATE
: source-018a ( -- triangle )
{ { 75 }
{ 95 64 }
{ 17 47 82 }
{ 18 35 87 10 }
{ 20 04 82 47 65 }
{ 19 01 23 75 03 34 }
{ 88 02 77 73 07 63 67 }
{ 99 65 04 28 06 16 70 92 }
{ 41 41 26 56 83 40 80 70 33 }
{ 41 48 72 33 47 32 37 16 94 29 }
{ 53 71 44 65 25 43 91 52 97 51 14 }
{ 70 11 33 28 77 73 17 78 39 68 17 57 }
{ 91 71 52 38 17 14 91 43 58 50 27 29 48 }
{ 63 66 04 68 89 53 67 30 73 16 69 87 40 31 }
{ 04 62 98 27 23 09 70 98 73 93 38 53 60 04 23 } } ;
PRIVATE>
: euler018a ( -- answer )
source-018a max-path ;
! [ euler018a ] 100 ave-time
! 0 ms run / 0 ms GC ave time - 100 trials
MAIN: euler018

View File

@ -1,6 +1,7 @@
! Copyright (c) 2007 Samuel Tardieu.
! Copyright (c) 2007 Samuel Tardieu, Aaron Schaefer.
! See http://factorcode.org/license.txt for BSD license.
USING: calendar combinators combinators.lib kernel math.ranges sequences ;
USING: calendar combinators combinators.lib kernel math math.ranges namespaces
sequences ;
IN: project-euler.019
! http://projecteuler.net/index.php?section=problems&id=19
@ -12,17 +13,15 @@ IN: project-euler.019
! research for yourself.
! * 1 Jan 1900 was a Monday.
! * Thirty days has September,
! April, June and November.
! All the rest have thirty-one,
! Saving February alone,
! Which has twenty-eight, rain or shine.
! And on leap years, twenty-nine.
! * A leap year occurs on any year evenly divisible by 4, but not
! on a century unless it is divisible by 400.
! * Thirty days has September, April, June and November. All the rest have
! thirty-one, Saving February alone, Which has twenty-eight, rain or
! shine. And on leap years, twenty-nine.
! * A leap year occurs on any year evenly divisible by 4, but not on a
! century unless it is divisible by 400.
! How many Sundays fell on the first of the month during the twentieth century
! (1 Jan 1901 to 31 Dec 2000)?
! How many Sundays fell on the first of the month during the twentieth
! century (1 Jan 1901 to 31 Dec 2000)?
! SOLUTION
! --------
@ -38,4 +37,34 @@ IN: project-euler.019
! [ euler019 ] 100 ave-time
! 1 ms run / 0 ms GC ave time - 100 trials
! ALTERNATE SOLUTIONS
! -------------------
<PRIVATE
: start-date ( -- timestamp )
1901 1 1 0 0 0 0 make-timestamp ;
: end-date ( -- timestamp )
2000 12 31 0 0 0 0 make-timestamp ;
: (first-days) ( end-date start-date -- )
2dup timestamp- 0 >= [
dup day-of-week , 1 +month (first-days)
] [
2drop
] if ;
: first-days ( start-date end-date -- seq )
[ swap (first-days) ] { } make ;
PRIVATE>
: euler019a ( -- answer )
start-date end-date first-days [ zero? ] count ;
! [ euler019a ] 100 ave-time
! 131 ms run / 3 ms GC ave time - 100 trials
MAIN: euler019

View File

@ -0,0 +1,25 @@
! Copyright (c) 2007 Aaron Schaefer.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel math.combinatorics math.parser project-euler.common sequences ;
IN: project-euler.020
! http://projecteuler.net/index.php?section=problems&id=20
! DESCRIPTION
! -----------
! n! means n * (n - 1) * ... * 3 * 2 * 1
! Find the sum of the digits in the number 100!
! SOLUTION
! --------
: euler020 ( -- answer )
100 factorial number>digits sum ;
! [ euler020 ] 100 ave-time
! 0 ms run / 0 ms GC ave time - 100 trials
MAIN: euler020

View File

@ -0,0 +1,38 @@
! Copyright (c) 2007 Aaron Schaefer.
! See http://factorcode.org/license.txt for BSD license.
USING: combinators.lib kernel math math.functions math.ranges namespaces
project-euler.common sequences ;
IN: project-euler.021
! http://projecteuler.net/index.php?section=problems&id=21
! DESCRIPTION
! -----------
! Let d(n) be defined as the sum of proper divisors of n (numbers less than n
! which divide evenly into n).
! If d(a) = b and d(b) = a, where a != b, then a and b are an amicable pair and
! each of a and b are called amicable numbers.
! For example, the proper divisors of 220 are 1, 2, 4, 5, 10, 11, 20, 22, 44,
! 55 and 110; therefore d(220) = 284. The proper divisors of 284 are 1, 2, 4,
! 71 and 142; so d(284) = 220.
! Evaluate the sum of all the amicable numbers under 10000.
! SOLUTION
! --------
: amicable? ( n -- ? )
dup sum-proper-divisors
{ [ 2dup = not ] [ 2dup sum-proper-divisors = ] } && 2nip ;
: euler021 ( -- answer )
10000 [1,b] [ dup amicable? [ drop 0 ] unless ] sigma ;
! [ euler021 ] 100 ave-time
! 328 ms run / 10 ms GC ave time - 100 trials
MAIN: euler021

View File

@ -0,0 +1,60 @@
! Copyright (c) 2007 Aaron Schaefer.
! See http://factorcode.org/license.txt for BSD license.
USING: combinators.lib io io.files kernel math math.parser namespaces sequences
sorting splitting strings system vocabs ;
IN: project-euler.022
! http://projecteuler.net/index.php?section=problems&id=22
! DESCRIPTION
! -----------
! Using names.txt (right click and 'Save Link/Target As...'), a 46K text file
! containing over five-thousand first names, begin by sorting it into
! alphabetical order. Then working out the alphabetical value for each name,
! multiply this value by its alphabetical position in the list to obtain a name
! score.
! For example, when the list is sorted into alphabetical order, COLIN, which is
! worth 3 + 15 + 12 + 9 + 14 = 53, is the 938th name in the list. So, COLIN
! would obtain a score of 938 * 53 = 49714.
! What is the total of all the name scores in the file?
! SOLUTION
! --------
<PRIVATE
: (source-022) ( -- path )
[
"project-euler.022" vocab-root ?resource-path %
os "windows" = [
"\\project-euler\\022\\names.txt" %
] [
"/project-euler/022/names.txt" %
] if
] "" make ;
: source-022 ( -- seq )
(source-022) file-contents [ quotable? ] subset "," split ;
: alpha-value ( str -- n )
string>digits [ 9 - ] sigma ;
: name-scores ( seq -- seq )
dup length [ 1+ swap alpha-value * ] 2map ;
PRIVATE>
: euler022 ( -- answer )
source-022 natural-sort name-scores sum ;
! [ euler022 ] 100 ave-time
! 59 ms run / 1 ms GC ave time - 100 trials
! source-022 [ natural-sort name-scores sum ] curry 100 ave-time
! 45 ms run / 1 ms GC ave time - 100 trials
MAIN: euler022

File diff suppressed because one or more lines are too long

View File

@ -1,6 +1,7 @@
! Copyright (c) 2007 Samuel Tardieu.
! Copyright (c) 2007 Samuel Tardieu, Aaron Schaefer.
! See http://factorcode.org/license.txt for BSD license.
USING: io io.files math.parser project-euler.018 sequences splitting ;
USING: io io.files kernel math.parser namespaces project-euler.018
project-euler.common sequences splitting system vocabs ;
IN: project-euler.067
! http://projecteuler.net/index.php?section=problems&id=67
@ -8,19 +9,25 @@ IN: project-euler.067
! DESCRIPTION
! -----------
! By starting at the top of the triangle below and moving to adjacent
! numbers on the row below, the maximum total from top to bottom is
! 23.
! By starting at the top of the triangle below and moving to adjacent numbers
! on the row below, the maximum total from top to bottom is 23.
! 3
! 7 5
! 2 4 6
! 8 5 9 3
! 3
! 7 5
! 2 4 6
! 8 5 9 3
! That is, 3 + 7 + 4 + 9 = 23.
! Find the maximum total from top to bottom in triangle.txt, a 15K
! text file containing a triangle with one-hundred rows.
! Find the maximum total from top to bottom in triangle.txt (right click and
! 'Save Link/Target As...'), a 15K text file containing a triangle with
! one-hundred rows.
! NOTE: This is a much more difficult version of Problem 18. It is not possible
! to try every route to solve this problem, as there are 2^99 altogether! If you
! could check one trillion (10^12) routes every second it would take over twenty
! billion years to check them all. There is an efficient algorithm to solve it. ;o)
! SOLUTION
! --------
@ -31,15 +38,45 @@ IN: project-euler.067
<PRIVATE
: pyramid ( -- seq )
"resource:extra/project-euler/067/triangle.txt" ?resource-path <file-reader>
lines [ " " split [ string>number ] map ] map ;
"resource:extra/project-euler/067/triangle.txt" ?resource-path
<file-reader> lines [ " " split [ string>number ] map ] map ;
PRIVATE>
: euler067 ( -- best )
pyramid propagate-all first first ;
: euler067 ( -- answer )
pyramid propagate-all first first ;
! [ euler067 ] 100 ave-time
! 18 ms run / 0 ms GC time
MAIN: euler067
! ALTERNATE SOLUTIONS
! -------------------
<PRIVATE
: (source-067a) ( -- path )
[
"project-euler.067" vocab-root ?resource-path %
os "windows" = [
"\\project-euler\\067\\triangle.txt" %
] [
"/project-euler/067/triangle.txt" %
] if
] "" make ;
: source-067a ( -- triangle )
(source-067a) <file-reader> lines [ " " split [ string>number ] map ] map ;
PRIVATE>
: euler067a ( -- answer )
source-067a max-path ;
! [ euler067a ] 100 ave-time
! 15 ms run / 0 ms GC ave time - 100 trials
! source-067a [ max-path ] curry 100 ave-time
! 3 ms run / 0 ms GC ave time - 100 trials
MAIN: euler067a

View File

@ -1,9 +1,12 @@
USING: arrays kernel hashtables math math.functions math.miller-rabin
math.ranges namespaces sequences combinators.lib ;
math.parser math.ranges namespaces sequences combinators.lib ;
IN: project-euler.common
! A collection of words used by more than one Project Euler solution.
: nth-pair ( n seq -- nth next )
over 1+ over nth >r nth r> ;
<PRIVATE
: count-shifts ( seq width -- n )
@ -12,6 +15,9 @@ IN: project-euler.common
: shift-3rd ( seq obj obj -- seq obj obj )
rot 1 tail -rot ;
: max-children ( seq -- seq )
[ dup length 1- [ over nth-pair max , ] each ] { } make nip ;
: >multiplicity ( seq -- seq )
dup prune [
[ 2dup [ = ] curry count 2array , ] each
@ -20,23 +26,29 @@ IN: project-euler.common
: reduce-2s ( n -- r s )
dup even? [ factor-2s >r 1+ r> ] [ 1 swap ] if ;
: tau-limit ( n -- n )
sqrt floor >fixnum ;
PRIVATE>
: divisor? ( n m -- ? )
mod zero? ;
: perfect-square? ( n -- ? )
dup sqrt mod zero? ;
: collect-consecutive ( seq width -- seq )
[
2dup count-shifts [ 2dup head shift-3rd , ] times
] { } make 2nip ;
: divisor? ( n m -- ? )
mod zero? ;
: max-path ( triangle -- n )
dup length 1 > [
2 cut* first2 max-children [ + ] 2map add max-path
] [
first first
] if ;
: number>digits ( n -- seq )
number>string string>digits ;
: perfect-square? ( n -- ? )
dup sqrt divisor? ;
: prime-factorization ( n -- seq )
[
2 [ over 1 > ]
@ -50,12 +62,34 @@ PRIVATE>
: prime-factors ( n -- seq )
prime-factorization prune >array ;
: (sum-divisors) ( n -- sum )
dup sqrt >fixnum [1,b] [
[ 2dup divisor? [ 2dup / + , ] [ drop ] if ] each
dup perfect-square? [ sqrt >fixnum neg , ] [ drop ] if
] { } make sum ;
: sum-divisors ( n -- sum )
dup 4 < [ { 0 1 3 4 } nth ] [ (sum-divisors) ] if ;
: sum-proper-divisors ( n -- sum )
dup sum-divisors swap - ;
: abundant? ( n -- ? )
dup sum-proper-divisors < ;
: deficient? ( n -- ? )
dup sum-proper-divisors > ;
: perfect? ( n -- ? )
dup sum-proper-divisors = ;
! The divisor function, counts the number of divisors
: tau ( n -- n )
prime-factorization* flip second 1 [ 1+ * ] reduce ;
! Optimized brute-force, is often faster than prime factorization
: tau* ( n -- n )
reduce-2s [ perfect-square? -1 0 ? ] keep dup tau-limit [1,b] [
reduce-2s [ perfect-square? -1 0 ? ] keep
dup sqrt >fixnum [1,b] [
dupd divisor? [ >r 2 + r> ] when
] each drop * ;

View File

@ -1,14 +1,13 @@
! Copyright (c) 2007 Aaron Schaefer.
! See http://factorcode.org/license.txt for BSD license.
USING: definitions io io.files kernel math.parser sequences strings
vocabs vocabs.loader
USING: definitions io io.files kernel math.parser sequences vocabs
vocabs.loader project-euler.ave-time project-euler.common
project-euler.001 project-euler.002 project-euler.003 project-euler.004
project-euler.005 project-euler.006 project-euler.007 project-euler.008
project-euler.009 project-euler.010 project-euler.011 project-euler.012
project-euler.013 project-euler.014 project-euler.015 project-euler.016
project-euler.017 project-euler.018 project-euler.019
project-euler.067
project-euler.134 ;
project-euler.017 project-euler.018 project-euler.019 project-euler.020
project-euler.021 project-euler.022 project-euler.067 project-euler.134 ;
IN: project-euler
<PRIVATE
@ -21,8 +20,8 @@ IN: project-euler
number>string 3 CHAR: 0 pad-left ;
: solution-path ( n -- str/f )
number>euler "project-euler." swap append vocab where
dup [ first ?resource-path ] when ;
number>euler "project-euler." swap append
vocab where dup [ first ?resource-path ] when ;
PRIVATE>

View File

@ -10,7 +10,7 @@ USING: rss io kernel io.files tools.test ;
f
"Meerkat"
"http://meerkat.oreillynet.com"
V{
{
T{
entry
f
@ -26,7 +26,7 @@ USING: rss io kernel io.files tools.test ;
f
"dive into mark"
"http://example.org/"
V{
{
T{
entry
f

View File

@ -85,22 +85,26 @@ C: <entry> entry
] if ;
! Atom generation
: simple-tag, ( content name -- )
[ , ] tag, ;
: simple-tag*, ( content name attrs -- )
[ , ] tag*, ;
: entry, ( entry -- )
<< entry >> [
<< title >> [ dup entry-title , ]
<< link [ dup entry-link ] == href // >>
<< published >> [ dup entry-pub-date , ]
<< content >> [ entry-description , ]
] ;
"entry" [
dup entry-title "title" { { "type" "html" } } simple-tag*,
"link" over entry-link "href" associate contained*,
dup entry-pub-date "published" simple-tag,
entry-description [ "content" { { "type" "html" } } simple-tag*, ] when*
] tag, ;
: feed>xml ( feed -- xml )
<XML
<< feed [ "http://www.w3.org/2005/Atom" ] == xmlns >> [
<< title >> [ dup feed-title , ]
<< link [ dup feed-link ] == href // >>
feed-entries [ entry, ] each
]
XML> ;
"feed" { { "xmlns" "http://www.w3.org/2005/Atom" } } [
dup feed-title "title" simple-tag,
"link" over feed-link "href" associate contained*,
feed-entries [ entry, ] each
] make-xml* ;
: write-feed ( feed -- )
feed>xml write-xml ;

View File

@ -1,6 +1,5 @@
USING: xmode.tokens xmode.marker
xmode.catalog kernel html html.elements io io.files
sequences words ;
USING: xmode.tokens xmode.marker xmode.catalog kernel html html.elements io
io.files sequences words ;
IN: xmode.code2html
: htmlize-tokens ( tokens -- )
@ -21,7 +20,7 @@ IN: xmode.code2html
: default-stylesheet ( -- )
<style>
"extra/xmode/code2html/stylesheet.css"
resource-path <file-reader> contents write
resource-path file-contents write
</style> ;
: htmlize-stream ( path stream -- )