Doug Coleman
commit
7c77535824
|
|
@ -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 ;
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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 ;
|
||||
|
|
|
|||
|
|
@ -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 ;
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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 -- )
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
||||
|
|
|
|||
|
|
@ -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 ;
|
||||
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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 ;
|
||||
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
@ -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
|
||||
|
|
@ -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
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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 * ;
|
||||
|
|
|
|||
|
|
@ -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>
|
||||
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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 ;
|
||||
|
|
|
|||
|
|
@ -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 -- )
|
||||
|
|
|
|||
Loading…
Reference in New Issue