diff --git a/core/bootstrap/primitives.factor b/core/bootstrap/primitives.factor index 586d4c0dfa..1c09ae1c60 100755 --- a/core/bootstrap/primitives.factor +++ b/core/bootstrap/primitives.factor @@ -1,4 +1,4 @@ -! Copyright (C) 2004, 2007 Slava Pestov. +! Copyright (C) 2004, 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. IN: bootstrap.primitives USING: alien arrays byte-arrays generic hashtables @@ -476,7 +476,7 @@ builtins get num-tags get tail f union-class define-class { "float<=" "math.private" } { "float>" "math.private" } { "float>=" "math.private" } - { "" "words.private" } + { "" "words" } { "word-xt" "words" } { "drop" "kernel" } { "2drop" "kernel" } diff --git a/core/heaps/heaps.factor b/core/heaps/heaps.factor index f01b436e90..cd00dc0db3 100644 --- a/core/heaps/heaps.factor +++ b/core/heaps/heaps.factor @@ -6,7 +6,6 @@ IN: heaps MIXIN: priority-queue GENERIC: heap-push ( value key heap -- ) -GENERIC: heap-push-all ( assoc heap -- ) GENERIC: heap-peek ( heap -- value key ) GENERIC: heap-pop* ( heap -- ) GENERIC: heap-pop ( heap -- value key ) @@ -107,7 +106,7 @@ M: priority-queue heap-push ( value key heap -- ) [ heap-data ] keep up-heap ; -M: priority-queue heap-push-all ( assoc heap -- ) +: heap-push-all ( assoc heap -- ) [ swapd heap-push ] curry assoc-each ; M: priority-queue heap-peek ( heap -- value key ) diff --git a/core/io/crc32/crc32.factor b/core/io/crc32/crc32.factor index 53da1ed5a5..d253170ac0 100755 --- a/core/io/crc32/crc32.factor +++ b/core/io/crc32/crc32.factor @@ -23,4 +23,4 @@ IN: io.crc32 : crc32 ( seq -- n ) >r HEX: ffffffff dup r> [ (crc32) ] each bitxor ; -: file-crc32 ( path -- n ) contents crc32 ; +: file-crc32 ( path -- n ) file-contents crc32 ; diff --git a/core/io/files/files-tests.factor b/core/io/files/files-tests.factor index 4f071e03b7..3559a3487b 100644 --- a/core/io/files/files-tests.factor +++ b/core/io/files/files-tests.factor @@ -23,11 +23,11 @@ USING: tools.test io.files io threads kernel ; ] unit-test [ "Hello world.\nHello appender.\n" ] [ - "test-foo.txt" resource-path contents + "test-foo.txt" resource-path file-contents ] unit-test [ "Hello appender.\n" ] [ - "test-bar.txt" resource-path contents + "test-bar.txt" resource-path file-contents ] unit-test [ ] [ "test-foo.txt" resource-path delete-file ] unit-test diff --git a/core/io/files/files.factor b/core/io/files/files.factor index 3a01cc7d82..350ea1dfa6 100755 --- a/core/io/files/files.factor +++ b/core/io/files/files.factor @@ -3,7 +3,7 @@ IN: io.files USING: io.backend io.files.private io hashtables kernel math memory namespaces sequences strings assocs arrays definitions -system combinators splitting ; +system combinators splitting sbufs ; HOOK: io-backend ( path -- stream ) @@ -157,3 +157,8 @@ HOOK: binary-roots io-backend ( -- seq ) PRIVATE> : walk-dir ( path -- seq ) [ (walk-dir) ] { } make ; + +: file-lines ( path -- seq ) lines ; + +: file-contents ( path -- str ) + dup swap file-length [ stream-copy ] keep >string ; diff --git a/core/io/io.factor b/core/io/io.factor index 50393f96bb..0336ffda78 100755 --- a/core/io/io.factor +++ b/core/io/io.factor @@ -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.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 -- ) diff --git a/core/source-files/source-files.factor b/core/source-files/source-files.factor index d715fd0c95..601963eebc 100755 --- a/core/source-files/source-files.factor +++ b/core/source-files/source-files.factor @@ -68,7 +68,7 @@ uses definitions ; : reset-checksums ( -- ) source-files get [ swap ?resource-path dup exists? - [ contents record-checksum ] [ 2drop ] if + [ file-contents record-checksum ] [ 2drop ] if ] assoc-each ; M: pathname where pathname-string 1 2array ; diff --git a/extra/assoc-heaps/assoc-heaps-tests.factor b/extra/assoc-heaps/assoc-heaps-tests.factor index 656e7fc15c..24a7730847 100644 --- a/extra/assoc-heaps/assoc-heaps-tests.factor +++ b/extra/assoc-heaps/assoc-heaps-tests.factor @@ -44,3 +44,12 @@ T{ T{ max-heap T{ heap f V{ { 1 2 } { 0 1 } } } } } heap-pop ] unit-test + +[ +T{ + assoc-heap + f + H{ { 1 2 } { 3 4 } } + T{ min-heap T{ heap f V{ { 2 1 } { 4 3 } } } } +} +] [ H{ { 1 2 } { 3 4 } } H{ } clone [ heap-push-all ] keep ] unit-test diff --git a/extra/assoc-heaps/assoc-heaps.factor b/extra/assoc-heaps/assoc-heaps.factor index a5471c213f..55a5aa7f62 100755 --- a/extra/assoc-heaps/assoc-heaps.factor +++ b/extra/assoc-heaps/assoc-heaps.factor @@ -40,9 +40,6 @@ M: assoc-heap heap-peek ( assoc-heap -- value key ) M: assoc-heap heap-push ( value key assoc-heap -- ) set-at ; -M: assoc-heap heap-push-all ( assoc assoc-heap -- ) - swap [ rot set-at ] curry* each ; - M: assoc-heap heap-pop ( assoc-heap -- value key ) dup assoc-heap-heap heap-pop swap rot dupd assoc-heap-assoc delete-at ; diff --git a/extra/combinators/lib/lib.factor b/extra/combinators/lib/lib.factor index 39a04571f7..e9bf49b15a 100755 --- a/extra/combinators/lib/lib.factor +++ b/extra/combinators/lib/lib.factor @@ -72,9 +72,9 @@ MACRO: nfirst ( n -- ) ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -: sigma ( seq quot -- n ) [ rot slip + ] curry 0 swap reduce ; +: sigma ( seq quot -- n ) [ rot slip + ] curry 0 swap reduce ; inline -: count ( seq quot -- n ) [ 1 0 ? ] compose sigma ; +: count ( seq quot -- n ) [ 1 0 ? ] compose sigma ; inline : all-unique? ( seq -- ? ) [ prune ] keep [ length ] 2apply = ; @@ -161,3 +161,8 @@ MACRO: map-call-with2 ( quots -- ) r> length [ narray ] curry append ; MACRO: map-exec-with ( words -- ) [ 1quotation ] map [ map-call-with ] curry ; + +MACRO: construct-slots ( assoc tuple-class -- tuple ) + [ construct-empty ] curry swap [ + [ dip ] curry swap 1quotation [ keep ] curry compose + ] { } assoc>map concat compose ; diff --git a/extra/cryptlib/cryptlib-tests.factor b/extra/cryptlib/cryptlib-tests.factor index 8cce40778e..c404114716 100644 --- a/extra/cryptlib/cryptlib-tests.factor +++ b/extra/cryptlib/cryptlib-tests.factor @@ -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 - 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 - 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 ; ! ... ! 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 diff --git a/extra/delegate/delegate.factor b/extra/delegate/delegate.factor index 44da847d9e..a0b2c7817c 100755 --- a/extra/delegate/delegate.factor +++ b/extra/delegate/delegate.factor @@ -39,11 +39,13 @@ M: tuple-class group-words PROTOCOL: sequence-protocol clone clone-like like new new-resizable nth nth-unsafe - set-nth set-nth-unsafe length immutable set-length lengthen ; + set-nth set-nth-unsafe length set-length lengthen ; PROTOCOL: assoc-protocol - at* assoc-size >alist assoc-find set-at + at* assoc-size >alist set-at assoc-clone-like delete-at clear-assoc new-assoc assoc-like ; + ! assoc-find excluded because GENERIC# 1 + ! everything should work, just slower (with >alist) PROTOCOL: stream-protocol stream-close stream-read1 stream-read stream-read-until diff --git a/extra/faq/faq.factor b/extra/faq/faq.factor index f10e6481fa..1968a9e5f4 100644 --- a/extra/faq/faq.factor +++ b/extra/faq/faq.factor @@ -8,7 +8,7 @@ IN: faq : find-after ( seq quot -- elem after ) over >r find r> rot 1+ tail ; inline -: tag-named? ( tag name -- ? ) +: tag-named*? ( tag name -- ? ) assure-name swap tag-named? ; ! Questions @@ -16,8 +16,8 @@ TUPLE: q/a question answer ; C: q/a : li>q/a ( li -- q/a ) - [ "br" tag-named? not ] subset - [ "strong" tag-named? ] find-after + [ "br" tag-named*? not ] subset + [ "strong" tag-named*? ] find-after >r tag-children r> ; : q/a>li ( q/a -- li ) diff --git a/extra/html/elements/elements.factor b/extra/html/elements/elements.factor index 0b70f5aa5c..d737c113a8 100644 --- a/extra/html/elements/elements.factor +++ b/extra/html/elements/elements.factor @@ -4,7 +4,7 @@ ! See http://factorcode.org/license.txt for BSD license. USING: io kernel namespaces prettyprint quotations -sequences strings words ; +sequences strings words xml.writer ; IN: html.elements @@ -123,7 +123,7 @@ SYMBOL: html " " write-html write-html "='" write-html - write + escape-quoted-string write "'" write-html ; : define-attribute-word ( name -- ) diff --git a/extra/html/html.factor b/extra/html/html.factor index 9e98831482..6def0089c9 100755 --- a/extra/html/html.factor +++ b/extra/html/html.factor @@ -142,7 +142,7 @@ M: html-block-stream stream-close ( quot style stream -- ) table-style " border-collapse: collapse;" append =style ; : do-escaping ( string style -- string ) - html swap at [ chars>entities ] unless ; + html swap at [ escape-string ] unless ; PRIVATE> @@ -151,13 +151,13 @@ M: html-stream stream-write1 ( char stream -- ) >r 1string r> stream-write ; M: html-stream stream-write ( str stream -- ) - >r chars>entities r> delegate stream-write ; + >r escape-string r> delegate stream-write ; M: html-stream make-span-stream ( style stream -- stream' ) html-span-stream ; M: html-stream stream-format ( str style stream -- ) - >r html over at [ >r chars>entities r> ] unless r> + >r html over at [ >r escape-string r> ] unless r> format-html-span ; M: html-stream make-block-stream ( style stream -- stream' ) diff --git a/extra/html/parser/analyzer/analyzer.factor b/extra/html/parser/analyzer/analyzer.factor index 9303b81055..168c2002a8 100755 --- a/extra/html/parser/analyzer/analyzer.factor +++ b/extra/html/parser/analyzer/analyzer.factor @@ -81,11 +81,11 @@ IN: html.parser.analyzer ! ] if ; -! clear "/Users/erg/web/fark.html" 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" 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" 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 diff --git a/extra/http/server/templating/templating-tests.factor b/extra/http/server/templating/templating-tests.factor index 6ccf3ed154..d979a071f2 100644 --- a/extra/http/server/templating/templating-tests.factor +++ b/extra/http/server/templating/templating-tests.factor @@ -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 - contents - = ; + ".html" append resource-path file-contents = ; [ t ] [ "example" test-template ] unit-test [ t ] [ "bug" test-template ] unit-test diff --git a/extra/http/server/templating/templating.factor b/extra/http/server/templating/templating.factor index cd587799c2..680f7b73d5 100755 --- a/extra/http/server/templating/templating.factor +++ b/extra/http/server/templating/templating.factor @@ -82,7 +82,7 @@ DEFER: <% delimiter templating-vocab use+ dup source-file file set ! so that reload works properly [ - ?resource-path contents + ?resource-path file-contents [ eval-template ] [ html-error. drop ] recover ] keep ] with-scope diff --git a/extra/icfp/2006/2006.factor b/extra/icfp/2006/2006.factor index 90ac9dc03e..53c7fd5a9b 100644 --- a/extra/icfp/2006/2006.factor +++ b/extra/icfp/2006/2006.factor @@ -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 -- ) - contents 4 group [ be> ] map + file-contents 4 group [ be> ] map 0 arrays get set-nth ; : init ( path -- ) diff --git a/extra/io/mmap/mmap-tests.factor b/extra/io/mmap/mmap-tests.factor index 729882deeb..a01481ecdc 100644 --- a/extra/io/mmap/mmap-tests.factor +++ b/extra/io/mmap/mmap-tests.factor @@ -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 [ "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 contents ] unit-test +[ "22345" ] [ "mmap-test-file.txt" resource-path file-contents ] unit-test [ "mmap-test-file.txt" resource-path delete-file ] catch drop - diff --git a/extra/lazy-lists/lazy-lists-docs.factor b/extra/lazy-lists/lazy-lists-docs.factor index b66eb6367f..11afc9b6b5 100644 --- a/extra/lazy-lists/lazy-lists-docs.factor +++ b/extra/lazy-lists/lazy-lists-docs.factor @@ -4,70 +4,64 @@ USING: help.markup help.syntax sequences strings ; IN: lazy-lists +{ car cons cdr nil nil? list? uncons } related-words + HELP: cons { $values { "car" "the head of the lazy list" } { "cdr" "the tail of the lazy list" } { "cons" "a cons object" } } -{ $description "Constructs a cons cell." } -{ $see-also cons car cdr nil nil? list? } ; +{ $description "Constructs a cons cell." } ; HELP: car { $values { "cons" "a cons object" } { "car" "the first item in the list" } } -{ $description "Returns the first item in the list." } -{ $see-also cons cdr nil nil? list? } ; +{ $description "Returns the first item in the list." } ; HELP: cdr { $values { "cons" "a cons object" } { "cdr" "a cons object" } } -{ $description "Returns the tail of the list." } -{ $see-also cons car nil nil? list? } ; +{ $description "Returns the tail of the list." } ; HELP: nil { $values { "cons" "An empty cons" } } -{ $description "Returns a representation of an empty list" } -{ $see-also cons car cdr nil? list? } ; +{ $description "Returns a representation of an empty list" } ; HELP: nil? { $values { "cons" "a cons object" } { "?" "a boolean" } } -{ $description "Return true if the cons object is the nil cons." } -{ $see-also cons car cdr nil list? } ; +{ $description "Return true if the cons object is the nil cons." } ; HELP: list? { $values { "object" "an object" } { "?" "a boolean" } } -{ $description "Returns true if the object conforms to the list protocol." } -{ $see-also cons car cdr nil } ; +{ $description "Returns true if the object conforms to the list protocol." } ; + +{ 1list 2list 3list } related-words HELP: 1list { $values { "obj" "an object" } { "cons" "a cons object" } } -{ $description "Create a list with 1 element." } -{ $see-also 2list 3list } ; +{ $description "Create a list with 1 element." } ; HELP: 2list { $values { "a" "an object" } { "b" "an object" } { "cons" "a cons object" } } -{ $description "Create a list with 2 elements." } -{ $see-also 1list 3list } ; +{ $description "Create a list with 2 elements." } ; HELP: 3list { $values { "a" "an object" } { "b" "an object" } { "c" "an object" } { "cons" "a cons object" } } -{ $description "Create a list with 3 elements." } -{ $see-also 1list 2list } ; +{ $description "Create a list with 3 elements." } ; HELP: lazy-cons { $values { "car" "a quotation with stack effect ( -- X )" } { "cdr" "a quotation with stack effect ( -- cons )" } { "promise" "the resulting cons object" } } { $description "Constructs a cons object for a lazy list from two quotations. The " { $snippet "car" } " quotation should return the head of the list, and the " { $snippet "cons" } " quotation the tail when called. When " { $link cons } " or " { $link cdr } " are called on the lazy-cons object then the appropriate quotation is called." } { $see-also cons car cdr nil nil? } ; +{ 1lazy-list 2lazy-list 3lazy-list } related-words + HELP: 1lazy-list { $values { "a" "a quotation with stack effect ( -- X )" } { "lazy-cons" "a lazy-cons object" } } -{ $description "Create a lazy list with 1 element. The element is the result of calling the quotation. The quotation is only called when the list element is requested." } -{ $see-also 2lazy-list 3lazy-list } ; +{ $description "Create a lazy list with 1 element. The element is the result of calling the quotation. The quotation is only called when the list element is requested." } ; HELP: 2lazy-list { $values { "a" "a quotation with stack effect ( -- X )" } { "b" "a quotation with stack effect ( -- X )" } { "lazy-cons" "a lazy-cons object" } } -{ $description "Create a lazy list with 2 elements. The elements are the result of calling the quotations. The quotations are only called when the list elements are requested." } -{ $see-also 1lazy-list 3lazy-list } ; +{ $description "Create a lazy list with 2 elements. The elements are the result of calling the quotations. The quotations are only called when the list elements are requested." } ; HELP: 3lazy-list { $values { "a" "a quotation with stack effect ( -- X )" } { "b" "a quotation with stack effect ( -- X )" } { "c" "a quotation with stack effect ( -- X )" } { "lazy-cons" "a lazy-cons object" } } -{ $description "Create a lazy list with 3 elements. The elements are the result of calling the quotations. The quotations are only called when the list elements are requested." } -{ $see-also 1lazy-list 2lazy-list } ; +{ $description "Create a lazy list with 3 elements. The elements are the result of calling the quotations. The quotations are only called when the list elements are requested." } ; HELP: { $values { "cons" "a cons object" } { "memoized-cons" "the resulting memoized-cons object" } } @@ -86,43 +80,41 @@ HELP: llength HELP: uncons { $values { "cons" "a cons object" } { "car" "the head of the list" } { "cdr" "the tail of the list" } } -{ $description "Put the head and tail of the list on the stack." } -{ $see-also cons car cdr } ; +{ $description "Put the head and tail of the list on the stack." } ; + +{ leach lreduce lmap lmap-with ltake lsubset lappend lfrom lfrom-by lconcat lcartesian-product lcartesian-product* lcomp lcomp* lmerge lreduce lwhile luntil } related-words HELP: leach { $values { "list" "a cons object" } { "quot" "a quotation with stack effect ( obj -- )" } } -{ $description "Call the quotation for each item in the list." } -{ $see-also lmap lmap-with ltake lsubset lappend lfrom lfrom-by lconcat lcartesian-product lcartesian-product* lcomp lcomp* lmerge } ; +{ $description "Call the quotation for each item in the list." } ; + +HELP: lreduce +{ $values { "list" "a cons object" } { "identity" "an object" } { "quot" "a quotation with stack effect ( prev elt -- next )" } { "result" "the final result" } } +{ $description "Combines successive elements of the list using a binary operation, and outputs the final result." } ; HELP: lmap { $values { "list" "a cons object" } { "quot" "a quotation with stack effect ( obj -- X )" } { "result" "resulting cons object" } } -{ $description "Perform a similar functionality to that of the " { $link map } " word, but in a lazy manner. No evaluation of the list elements occurs initially but a " { $link } " object is returned which conforms to the list protocol. Calling " { $link car } ", " { $link cdr } " or " { $link nil? } " on this will evaluate elements as required." } -{ $see-also leach ltake lsubset lappend lmap-with lfrom lfrom-by lconcat lcartesian-product lcartesian-product* lcomp lcomp* lmerge } ; +{ $description "Perform a similar functionality to that of the " { $link map } " word, but in a lazy manner. No evaluation of the list elements occurs initially but a " { $link } " object is returned which conforms to the list protocol. Calling " { $link car } ", " { $link cdr } " or " { $link nil? } " on this will evaluate elements as required." } ; HELP: lmap-with { $values { "value" "an object" } { "list" "a cons object" } { "quot" "a quotation with stack effect ( obj elt -- X )" } { "result" "resulting cons object" } } -{ $description "Variant of " { $link lmap } " which pushes a retained object on each invocation of the quotation." } -{ $see-also leach ltake lsubset lappend lmap lfrom lfrom-by lconcat lcartesian-product lcartesian-product* lcomp lcomp* lmerge } ; +{ $description "Variant of " { $link lmap } " which pushes a retained object on each invocation of the quotation." } ; HELP: ltake { $values { "n" "a non negative integer" } { "list" "a cons object" } { "result" "resulting cons object" } } -{ $description "Outputs a lazy list containing the first n items in the list. This is done a lazy manner. No evaluation of the list elements occurs initially but a " { $link } " object is returned which conforms to the list protocol. Calling " { $link car } ", " { $link cdr } " or " { $link nil? } " on this will evaluate elements as required." } -{ $see-also leach lmap lmap-with lsubset lappend lfrom lfrom-by lconcat lcartesian-product lcartesian-product* lcomp lcomp* lmerge } ; +{ $description "Outputs a lazy list containing the first n items in the list. This is done a lazy manner. No evaluation of the list elements occurs initially but a " { $link } " object is returned which conforms to the list protocol. Calling " { $link car } ", " { $link cdr } " or " { $link nil? } " on this will evaluate elements as required." } ; HELP: lsubset { $values { "list" "a cons object" } { "quot" "a quotation with stack effect ( -- X )" } { "result" "resulting cons object" } } -{ $description "Perform a similar functionality to that of the " { $link subset } " word, but in a lazy manner. No evaluation of the list elements occurs initially but a " { $link } " object is returned which conforms to the list protocol. Calling " { $link car } ", " { $link cdr } " or " { $link nil? } " on this will evaluate elements as required." } -{ $see-also leach lmap lmap-with ltake lappend lfrom lfrom-by lconcat lcartesian-product lcartesian-product* lcomp lcomp* lmerge } ; +{ $description "Perform a similar functionality to that of the " { $link subset } " word, but in a lazy manner. No evaluation of the list elements occurs initially but a " { $link } " object is returned which conforms to the list protocol. Calling " { $link car } ", " { $link cdr } " or " { $link nil? } " on this will evaluate elements as required." } ; HELP: lwhile { $values { "list" "a cons object" } { "quot" "a quotation with stack effect ( X -- bool )" } { "result" "resulting cons object" } } -{ $description "Outputs a lazy list containing the first items in the list as long as " { $snippet "quot" } " evaluates to t. No evaluation of the list elements occurs initially but a " { $link } " object is returned with conforms to the list protocol. Calling " { $link car } ", " { $link cdr } " or " { $link nil? } " on this will evaluate elements as required." } -{ $see-also luntil } ; +{ $description "Outputs a lazy list containing the first items in the list as long as " { $snippet "quot" } " evaluates to t. No evaluation of the list elements occurs initially but a " { $link } " object is returned with conforms to the list protocol. Calling " { $link car } ", " { $link cdr } " or " { $link nil? } " on this will evaluate elements as required." } ; HELP: luntil { $values { "list" "a cons object" } { "quot" "a quotation with stack effect ( X -- bool )" } { "result" "resulting cons object" } } -{ $description "Outputs a lazy list containing the first items in the list until after " { $snippet "quot" } " evaluates to t. No evaluation of the list elements occurs initially but a " { $link } " object is returned with conforms to the list protocol. Calling " { $link car } ", " { $link cdr } " or " { $link nil? } " on this will evaluate elements as required." } -{ $see-also lwhile } ; +{ $description "Outputs a lazy list containing the first items in the list until after " { $snippet "quot" } " evaluates to t. No evaluation of the list elements occurs initially but a " { $link } " object is returned with conforms to the list protocol. Calling " { $link car } ", " { $link cdr } " or " { $link nil? } " on this will evaluate elements as required." } ; HELP: list>vector { $values { "list" "a cons object" } { "vector" "the list converted to a vector" } } @@ -136,18 +128,15 @@ HELP: list>array HELP: lappend { $values { "list1" "a cons object" } { "list2" "a cons object" } { "result" "a lazy list of list2 appended to list1" } } -{ $description "Perform a similar functionality to that of the " { $link append } " word, but in a lazy manner. No evaluation of the list elements occurs initially but a " { $link } " object is returned which conforms to the list protocol. Calling " { $link car } ", " { $link cdr } " or " { $link nil? } " on this will evaluate elements as required. Successive calls to " { $link cdr } " will iterate through list1, followed by list2." } -{ $see-also leach lmap lmap-with ltake lsubset lfrom lfrom-by lconcat lcartesian-product lcartesian-product* lcomp lcomp* lmerge } ; +{ $description "Perform a similar functionality to that of the " { $link append } " word, but in a lazy manner. No evaluation of the list elements occurs initially but a " { $link } " object is returned which conforms to the list protocol. Calling " { $link car } ", " { $link cdr } " or " { $link nil? } " on this will evaluate elements as required. Successive calls to " { $link cdr } " will iterate through list1, followed by list2." } ; HELP: lfrom-by { $values { "n" "an integer" } { "quot" "a quotation with stack effect ( -- int )" } { "list" "a lazy list of integers" } } -{ $description "Return an infinite lazy list of values starting from n, with each successive value being the result of applying quot to n." } -{ $see-also leach lmap lmap-with ltake lsubset lfrom lconcat lcartesian-product lcartesian-product* lcomp lcomp* lmerge } ; +{ $description "Return an infinite lazy list of values starting from n, with each successive value being the result of applying quot to n." } ; HELP: lfrom { $values { "n" "an integer" } { "list" "a lazy list of integers" } } -{ $description "Return an infinite lazy list of incrementing integers starting from n." } -{ $see-also leach lmap lmap-with ltake lsubset lfrom-by lconcat lcartesian-product lcartesian-product* lcomp lcomp* lmerge } ; +{ $description "Return an infinite lazy list of incrementing integers starting from n." } ; HELP: seq>list { $values { "index" "an integer 0 or greater" } { "seq" "a sequence" } { "list" "a list" } } @@ -161,39 +150,33 @@ HELP: >list HELP: lconcat { $values { "list" "a list of lists" } { "result" "a list" } } -{ $description "Concatenates a list of lists together into one list." } -{ $see-also leach lmap lmap-with ltake lsubset lcartesian-product lcartesian-product* lfrom-by lcomp lcomp* lmerge } ; +{ $description "Concatenates a list of lists together into one list." } ; HELP: lcartesian-product { $values { "list1" "a list" } { "list2" "a list" } { "result" "list of cartesian products" } } -{ $description "Given two lists, return a list containing the cartesian product of those lists." } -{ $see-also leach lmap lmap-with lconcat ltake lsubset lfrom-by lcartesian-product* lcomp lcomp* lmerge } ; +{ $description "Given two lists, return a list containing the cartesian product of those lists." } ; HELP: lcartesian-product* { $values { "lists" "a list of lists" } { "result" "list of cartesian products" } } -{ $description "Given a list of lists, return a list containing the cartesian product of those lists." } -{ $see-also leach lmap lmap-with lconcat ltake lsubset lfrom-by lcartesian-product lcomp lcomp* lmerge } ; +{ $description "Given a list of lists, return a list containing the cartesian product of those lists." } ; HELP: lcomp { $values { "list" "a list of lists" } { "quot" "a quotation with stack effect ( seq -- X )" } { "result" "the resulting list" } } -{ $description "Get the cartesian product of the lists in " { $snippet "list" } " and call " { $snippet "quot" } " call with each element from the cartesian product on the stack, the result of which is returned in the final " { $snippet "list" } "." } -{ $see-also leach lmap lmap-with lconcat ltake lsubset lfrom-by lcartesian-product lcomp* lmerge } ; +{ $description "Get the cartesian product of the lists in " { $snippet "list" } " and call " { $snippet "quot" } " call with each element from the cartesian product on the stack, the result of which is returned in the final " { $snippet "list" } "." } ; HELP: lcomp* { $values { "list" "a list of lists" } { "guards" "a sequence of quotations with stack effect ( seq -- bool )" } { "quot" "a quotation with stack effect ( seq -- X )" } { "list" "the resulting list" } { "result" "a list" } } -{ $description "Get the cartesian product of the lists in " { $snippet "list" } ", filter it by applying each guard quotation to it and call " { $snippet "quot" } " call with each element from the remaining cartesian product items on the stack, the result of which is returned in the final " { $snippet "list" } "." } +{ $description "Get the cartesian product of the lists in " { $snippet "list" } ", filter it by applying each guard quotation to it and call " { $snippet "quot" } " call with each element from the remaining cartesian product items on the stack, the result of which is returned in the final " { $snippet "list" } "." } { $examples { $code "{ 1 2 3 } >list { 4 5 6 } >list 2list { [ first odd? ] } [ first2 + ] lcomp*" } -} -{ $see-also leach lmap lmap-with lconcat ltake lsubset lfrom-by lcartesian-product lcomp lmerge } ; +} ; HELP: lmerge { $values { "list1" "a list" } { "list2" "a list" } { "result" "lazy list merging list1 and list2" } } { $description "Return the result of merging the two lists in a lazy manner." } { $examples { $example "USE: lazy-lists" "{ 1 2 3 } >list { 4 5 6 } >list lmerge list>array ." "{ 1 4 2 5 3 6 }" } -} -{ $see-also leach lmap lmap-with lconcat ltake lsubset lfrom-by lcartesian-product lcomp } ; +} ; HELP: lcontents { $values { "stream" "a stream" } { "result" string } } diff --git a/extra/lazy-lists/lazy-lists.factor b/extra/lazy-lists/lazy-lists.factor index 1fb7a18cba..9f2e05c7ba 100644 --- a/extra/lazy-lists/lazy-lists.factor +++ b/extra/lazy-lists/lazy-lists.factor @@ -102,6 +102,9 @@ M: lazy-cons list? ( object -- bool ) : leach ( list quot -- ) swap dup nil? [ 2drop ] [ uncons swapd over 2slip leach ] if ; inline +: lreduce ( list identity quot -- result ) + swapd leach ; inline + TUPLE: memoized-cons original car cdr nil? ; : not-memoized ( -- obj ) @@ -211,17 +214,17 @@ TUPLE: lazy-until cons quot ; C: lazy-until : luntil ( list quot -- result ) - ; + over nil? [ drop ] [ ] if ; M: lazy-until car ( lazy-until -- car ) lazy-until-cons car ; M: lazy-until cdr ( lazy-until -- cdr ) - [ lazy-until-cons uncons ] keep lazy-until-quot - rot over call [ 2drop nil ] [ luntil ] if ; + [ lazy-until-cons uncons swap ] keep lazy-until-quot tuck call + [ 2drop nil ] [ luntil ] if ; M: lazy-until nil? ( lazy-until -- bool ) - lazy-until-cons nil? ; + drop f ; M: lazy-until list? ( lazy-until -- bool ) drop t ; @@ -231,19 +234,16 @@ TUPLE: lazy-while cons quot ; C: lazy-while : lwhile ( list quot -- result ) - -; + over nil? [ drop ] [ ] if ; M: lazy-while car ( lazy-while -- car ) lazy-while-cons car ; M: lazy-while cdr ( lazy-while -- cdr ) - dup lazy-while-cons cdr dup nil? - [ 2drop nil ] [ swap lazy-while-quot lwhile ] if ; + [ lazy-while-cons cdr ] keep lazy-while-quot lwhile ; M: lazy-while nil? ( lazy-while -- bool ) - dup lazy-while-cons nil? - [ nip ] [ [ car ] keep lazy-while-quot call not ] if* ; + [ car ] keep lazy-while-quot call not ; M: lazy-while list? ( lazy-while -- bool ) drop t ; @@ -313,11 +313,7 @@ M: lazy-append cdr ( lazy-append -- cdr ) lazy-append-list2 lappend ; M: lazy-append nil? ( lazy-append -- bool ) - dup lazy-append-list1 nil? [ - lazy-append-list2 nil? - ] [ - drop f - ] if ; + drop f ; M: lazy-append list? ( object -- bool ) drop t ; diff --git a/extra/macros/macros.factor b/extra/macros/macros.factor index 586156c040..2efd38d469 100755 --- a/extra/macros/macros.factor +++ b/extra/macros/macros.factor @@ -2,18 +2,18 @@ ! See http://factorcode.org/license.txt for BSD license. USING: parser kernel sequences words effects inference.transforms - combinators assocs definitions quotations namespaces ; +combinators assocs definitions quotations namespaces memoize ; IN: macros -: (:) +: (:) ( -- word definition effect-in ) CREATE dup reset-generic parse-definition over "declared-effect" word-prop effect-in length ; -: (MACRO:) - >r - 2dup "macro" set-word-prop - 2dup [ call ] append define +: (MACRO:) ( word definition effect-in -- ) + >r 2dup "macro" set-word-prop + 2dup over "declared-effect" word-prop memoize-quot + [ call ] append define r> define-transform ; : MACRO: diff --git a/extra/mad/api/api.factor b/extra/mad/api/api.factor index e3178b95f9..d803fa64e0 100644 --- a/extra/mad/api/api.factor +++ b/extra/mad/api/api.factor @@ -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 swap file-length [ 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 ; - diff --git a/extra/math/algebra/algebra-docs.factor b/extra/math/algebra/algebra-docs.factor new file mode 100644 index 0000000000..a623268403 --- /dev/null +++ b/extra/math/algebra/algebra-docs.factor @@ -0,0 +1,6 @@ +USING: help.markup help.syntax ; +IN: math.algebra + +HELP: chinese-remainder +{ $values { "aseq" "a sequence of integers" } { "nseq" "a sequence of positive integers" } { "x" "an integer" } } +{ $description "If " { $snippet "nseq" } " integers are pairwise coprimes, " { $snippet "x" } " is the smallest positive integer congruent to each element in " { $snippet "aseq" } " modulo the corresponding element in " { $snippet "nseq" } "." } ; diff --git a/extra/math/algebra/algebra-tests.factor b/extra/math/algebra/algebra-tests.factor new file mode 100644 index 0000000000..51aa97995c --- /dev/null +++ b/extra/math/algebra/algebra-tests.factor @@ -0,0 +1,3 @@ +USING: math.algebra tools.test ; + +{ 11 } [ { 2 3 1 } { 3 4 5 } chinese-remainder ] unit-test diff --git a/extra/math/algebra/algebra.factor b/extra/math/algebra/algebra.factor new file mode 100644 index 0000000000..8bb8420d1a --- /dev/null +++ b/extra/math/algebra/algebra.factor @@ -0,0 +1,8 @@ +! Copyright (c) 2007 Samuel Tardieu +! See http://factorcode.org/license.txt for BSD license. +USING: kernel math math.functions sequences ; +IN: math.algebra + +: chinese-remainder ( aseq nseq -- x ) + dup product + [ [ over / [ swap gcd drop ] keep * * ] curry 2map sum ] keep rem ; foldable diff --git a/extra/math/algebra/authors.txt b/extra/math/algebra/authors.txt new file mode 100644 index 0000000000..f3b0233f74 --- /dev/null +++ b/extra/math/algebra/authors.txt @@ -0,0 +1 @@ +Samuel Tardieu diff --git a/extra/math/algebra/summary.txt b/extra/math/algebra/summary.txt new file mode 100644 index 0000000000..5f0748e37a --- /dev/null +++ b/extra/math/algebra/summary.txt @@ -0,0 +1 @@ +Various algebra-related words diff --git a/extra/math/erato/erato.factor b/extra/math/erato/erato.factor index 4993f39e44..9b9ad53469 100644 --- a/extra/math/erato/erato.factor +++ b/extra/math/erato/erato.factor @@ -1,6 +1,7 @@ ! Copyright (c) 2007 Samuel Tardieu. ! See http://factorcode.org/license.txt for BSD license. -USING: bit-arrays kernel lazy-lists math math.functions math.ranges sequences ; +USING: bit-arrays kernel lazy-lists math math.functions math.primes.list + math.ranges sequences ; IN: math.erato : lerato ( n -- lazy-list ) - 2 [ drop next-prime ] curry* lfrom-by [ ] lwhile ; + dup 1000003 < [ + 0 primes-under-million seq>list swap [ <= ] curry lwhile + ] [ + 2 [ drop next-prime ] curry* lfrom-by [ ] lwhile + ] if ; diff --git a/extra/math/primes/authors.txt b/extra/math/primes/authors.txt new file mode 100644 index 0000000000..f3b0233f74 --- /dev/null +++ b/extra/math/primes/authors.txt @@ -0,0 +1 @@ +Samuel Tardieu diff --git a/extra/math/primes/factors/authors.txt b/extra/math/primes/factors/authors.txt new file mode 100644 index 0000000000..f3b0233f74 --- /dev/null +++ b/extra/math/primes/factors/authors.txt @@ -0,0 +1 @@ +Samuel Tardieu diff --git a/extra/math/primes/factors/factors-docs.factor b/extra/math/primes/factors/factors-docs.factor new file mode 100644 index 0000000000..2238420d32 --- /dev/null +++ b/extra/math/primes/factors/factors-docs.factor @@ -0,0 +1,20 @@ +USING: help.markup help.syntax ; +IN: math.primes.factors + +{ factors count-factors unique-factors } related-words + +HELP: factors +{ $values { "n" "a positive integer" } { "seq" "a sequence" } } +{ $description { "Factorize an integer and return an ordered list of factors, possibly repeated." } } ; + +HELP: count-factors +{ $values { "n" "a positive integer" } { "seq" "a sequence" } } +{ $description { "Return a sequence of pairs representing each factor in the number and its corresponding power." } } ; + +HELP: unique-factors +{ $values { "n" "a positive integer" } { "seq" "a sequence" } } +{ $description { "Return an ordered list of unique prime factors." } } ; + +HELP: totient +{ $values { "n" "a positive integer" } { "t" "an integer" } } +{ $description { "Return the number of integers between 1 and " { $snippet "n-1" } " relatively prime to " { $snippet "n" } "." } } ; diff --git a/extra/math/primes/factors/factors-tests.factor b/extra/math/primes/factors/factors-tests.factor new file mode 100644 index 0000000000..71bdd56a81 --- /dev/null +++ b/extra/math/primes/factors/factors-tests.factor @@ -0,0 +1,6 @@ +USING: math.primes.factors tools.test ; + +{ { 999983 999983 1000003 } } [ 999969000187000867 factors ] unit-test +{ { { 999983 2 } { 1000003 1 } } } [ 999969000187000867 count-factors ] unit-test +{ { 999983 1000003 } } [ 999969000187000867 unique-factors ] unit-test +{ 999967000236000612 } [ 999969000187000867 totient ] unit-test diff --git a/extra/math/primes/factors/factors.factor b/extra/math/primes/factors/factors.factor new file mode 100644 index 0000000000..b841d49f7d --- /dev/null +++ b/extra/math/primes/factors/factors.factor @@ -0,0 +1,41 @@ +! Copyright (C) 2007 Samuel Tardieu. +! See http://factorcode.org/license.txt for BSD license. +USING: arrays kernel lazy-lists math math.primes namespaces sequences ; +IN: math.primes.factors + + [ swap uncons >r pick call r> swap (factors) ] [ 3drop ] if ; + +: (decompose) ( n quot -- seq ) + [ lprimes rot (factors) ] { } make ; + +PRIVATE> + +: factors ( n -- seq ) + [ (factor) ] (decompose) ; foldable + +: count-factors ( n -- seq ) + [ (count) ] (decompose) ; foldable + +: unique-factors ( n -- seq ) + [ (unique) ] (decompose) ; foldable + +: totient ( n -- t ) + dup 2 < [ + drop 0 + ] [ + [ unique-factors dup 1 [ 1- * ] reduce swap product / ] keep * + ] if ; foldable diff --git a/extra/math/primes/factors/summary.txt b/extra/math/primes/factors/summary.txt new file mode 100644 index 0000000000..1440dddc7f --- /dev/null +++ b/extra/math/primes/factors/summary.txt @@ -0,0 +1 @@ +Prime factors decomposition diff --git a/extra/math/primes/primes-docs.factor b/extra/math/primes/primes-docs.factor new file mode 100644 index 0000000000..1077659d5e --- /dev/null +++ b/extra/math/primes/primes-docs.factor @@ -0,0 +1,30 @@ +USING: help.markup help.syntax ; +IN: math.primes + +{ next-prime prime? } related-words + +HELP: next-prime +{ $values { "n" "a positive integer" } { "p" "a prime number" } } +{ $description "Return the next prime number greater than " { $snippet "n" } "." } ; + +HELP: prime? +{ $values { "n" "an integer" } { "?" "a boolean" } } +{ $description "Test if an integer is a prime number." } ; + +{ lprimes lprimes-from primes-upto primes-between } related-words + +HELP: lprimes +{ $values { "list" "a lazy list" } } +{ $description "Return a sorted list containing all the prime numbers." } ; + +HELP: lprimes-from +{ $values { "n" "an integer" } { "list" "a lazy list" } } +{ $description "Return a sorted list containing all the prime numbers greater or equal to " { $snippet "n" } "." } ; + +HELP: primes-upto +{ $values { "n" "an integer" } { "seq" "a sequence" } } +{ $description "Return a sequence containing all the prime numbers smaller or equal to " { $snippet "n" } "." } ; + +HELP: primes-between +{ $values { "low" "an integer" } { "high" "an integer" } { "seq" "a sequence" } } +{ $description "Return a sequence containing all the prime numbers between " { $snippet "low" } " and " { $snippet "high" } "." } ; diff --git a/extra/math/primes/primes-tests.factor b/extra/math/primes/primes-tests.factor new file mode 100644 index 0000000000..b1bcf79a49 --- /dev/null +++ b/extra/math/primes/primes-tests.factor @@ -0,0 +1,10 @@ +USING: arrays math.primes tools.test lazy-lists ; + +{ 1237 } [ 1234 next-prime ] unit-test +{ f t } [ 1234 prime? 1237 prime? ] unit-test +{ { 2 3 5 7 11 13 17 19 23 29 } } [ 10 lprimes ltake list>array ] unit-test +{ { 101 103 107 109 113 } } [ 5 100 lprimes-from ltake list>array ] unit-test +{ { 1000117 1000121 } } [ 2 1000100 lprimes-from ltake list>array ] unit-test +{ { 999983 1000003 } } [ 2 999982 lprimes-from ltake list>array ] unit-test +{ { 2 3 5 7 } } [ 10 primes-upto >array ] unit-test +{ { 999983 1000003 } } [ 999982 1000010 primes-between >array ] unit-test diff --git a/extra/math/primes/primes.factor b/extra/math/primes/primes.factor new file mode 100644 index 0000000000..68ab5b3221 --- /dev/null +++ b/extra/math/primes/primes.factor @@ -0,0 +1,49 @@ +! Copyright (C) 2007 Samuel Tardieu. +! See http://factorcode.org/license.txt for BSD license. +USING: combinators kernel lazy-lists math math.functions math.miller-rabin + math.primes.list math.ranges sequences sorting ; +IN: math.primes + + + +: next-prime ( n -- p ) + dup 999983 < [ + primes-under-million [ [ <=> ] binsearch 1+ ] keep nth + ] [ + next-odd find-prime-miller-rabin + ] if ; foldable + +: prime? ( n -- ? ) + dup 1000000 < [ + dup primes-under-million [ <=> ] binsearch* = + ] [ + miller-rabin + ] if ; foldable + +: lprimes ( -- list ) + 0 primes-under-million seq>list + 1000003 [ 2 + find-prime-miller-rabin ] lfrom-by + lappend ; + +: lprimes-from ( n -- list ) + dup 3 < [ drop lprimes ] [ 1- next-prime [ next-prime ] lfrom-by ] if ; + +: primes-upto ( n -- seq ) + { + { [ dup 2 < ] [ drop { } ] } + { [ dup 1000003 < ] + [ primes-under-million [ [ <=> ] binsearch 1+ 0 swap ] keep ] } + { [ t ] + [ primes-under-million 1000003 lprimes-from + rot [ <= ] curry lwhile list>array append ] } + } cond ; foldable + +: primes-between ( low high -- seq ) + primes-upto + >r 1- next-prime r> + [ [ <=> ] binsearch ] keep [ length ] keep ; foldable diff --git a/extra/math/primes/summary.txt b/extra/math/primes/summary.txt new file mode 100644 index 0000000000..41b4197178 --- /dev/null +++ b/extra/math/primes/summary.txt @@ -0,0 +1,2 @@ +Prime numbers test and generation + diff --git a/extra/math/text/authors.txt b/extra/math/text/authors.txt new file mode 100644 index 0000000000..4eec9c9a08 --- /dev/null +++ b/extra/math/text/authors.txt @@ -0,0 +1 @@ +Aaron Schaefer diff --git a/extra/math/text/summary.txt b/extra/math/text/summary.txt new file mode 100644 index 0000000000..96b2f4f151 --- /dev/null +++ b/extra/math/text/summary.txt @@ -0,0 +1 @@ +Convert integers to text diff --git a/extra/math/text/text-docs.factor b/extra/math/text/text-docs.factor new file mode 100644 index 0000000000..6a896b1a82 --- /dev/null +++ b/extra/math/text/text-docs.factor @@ -0,0 +1,7 @@ +USING: help.markup help.syntax math strings ; +IN: math.text + +HELP: number>text +{ $values { "n" integer } { "str" string } } +{ $description "Converts an integer to a text string representation in English, including appropriate punctuation and conjunctions." } +{ $examples { $example "12345 number>text ." "\"Twelve Thousand, Three Hundred and Forty-Five\"" } } ; diff --git a/extra/math/text/text-tests.factor b/extra/math/text/text-tests.factor new file mode 100644 index 0000000000..09c8a0461b --- /dev/null +++ b/extra/math/text/text-tests.factor @@ -0,0 +1,15 @@ +USING: math.functions math.text tools.test ; +IN: temporary + +[ "Zero" ] [ 0 number>text ] unit-test +[ "Twenty-One" ] [ 21 number>text ] unit-test +[ "One Hundred" ] [ 100 number>text ] unit-test +[ "One Hundred and One" ] [ 101 number>text ] unit-test +[ "One Thousand and One" ] [ 1001 number>text ] unit-test +[ "One Thousand, One Hundred and One" ] [ 1101 number>text ] unit-test +[ "One Million, One Thousand and One" ] [ 1001001 number>text ] unit-test +[ "One Million, One Thousand, One Hundred and One" ] [ 1001101 number>text ] unit-test +[ "One Million, One Hundred and Eleven Thousand, One Hundred and Eleven" ] [ 1111111 number>text ] unit-test +[ "One Duotrigintillion" ] [ 10 99 ^ number>text ] unit-test + +[ "Negative One Hundred and Twenty-Three" ] [ -123 number>text ] unit-test diff --git a/extra/math/text/text.factor b/extra/math/text/text.factor new file mode 100644 index 0000000000..7298fd3c15 --- /dev/null +++ b/extra/math/text/text.factor @@ -0,0 +1,103 @@ +! Copyright (c) 2007 Aaron Schaefer. +! See http://factorcode.org/license.txt for BSD license. +USING: combinators.lib kernel math math.functions math.parser namespaces + sequences splitting sequences.lib ; +IN: math.text + + ] + } && and-needed? set drop ; + +: negative-text ( n -- str ) + 0 < "Negative " "" ? ; + +: 3digit-groups ( n -- seq ) + number>string 3 + [ reverse 10 string>integer ] map ; + +: hundreds-place ( n -- str ) + 100 /mod swap dup zero? [ + 2drop "" + ] [ + small-numbers " Hundred" append + swap zero? [ " and " append ] unless + ] if ; + +: tens-place ( n -- str ) + 100 mod dup 20 >= [ + 10 /mod >r tens r> + dup zero? [ drop ] [ "-" swap small-numbers 3append ] if + ] [ + dup zero? [ drop "" ] [ small-numbers ] if + ] if ; + +: 3digits>text ( n -- str ) + dup hundreds-place swap tens-place append ; + +: text-with-scale ( index seq -- str ) + dupd nth 3digits>text swap + scale-numbers dup empty? [ + drop + ] [ + " " swap 3append + ] if ; + +: append-with-conjunction ( str1 str2 -- newstr ) + over length zero? [ + nip + ] [ + and-needed? get " and " ", " ? rot 3append + and-needed? off + ] if ; + +: (recombine) ( str index seq -- newstr seq ) + 2dup nth zero? [ + nip + ] [ + [ text-with-scale ] keep + -rot append-with-conjunction swap + ] if ; + +: recombine ( seq -- str ) + dup singleton? [ + first 3digits>text + ] [ + dup set-conjunction "" swap + dup length [ swap (recombine) ] each drop + ] if ; + +: (number>text) ( n -- str ) + dup negative-text swap abs 3digit-groups recombine append ; + +PRIVATE> + +: number>text ( n -- str ) + dup zero? [ + small-numbers + ] [ + [ (number>text) ] with-scope + ] if ; + diff --git a/extra/memoize/memoize.factor b/extra/memoize/memoize.factor index 75f8ae5ea0..97da6f0a33 100644 --- a/extra/memoize/memoize.factor +++ b/extra/memoize/memoize.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2007 Slava Pestov, Daniel Ehrenberg. ! See http://factorcode.org/license.txt for BSD license. USING: kernel hashtables sequences arrays words namespaces -parser math assocs effects definitions ; +parser math assocs effects definitions quotations ; IN: memoize : packer ( n -- quot ) @@ -46,3 +46,7 @@ PREDICATE: compound memoized "memoize" word-prop ; M: memoized definer drop \ MEMO: \ ; ; M: memoized definition "memo-quot" word-prop ; + +: memoize-quot ( quot effect -- memo-quot ) + gensym swap dupd "declared-effect" set-word-prop + dup rot define-memoized 1quotation ; diff --git a/extra/project-euler/003/003.factor b/extra/project-euler/003/003.factor index 87db922e5f..2b229aa11b 100644 --- a/extra/project-euler/003/003.factor +++ b/extra/project-euler/003/003.factor @@ -1,6 +1,6 @@ ! Copyright (c) 2007 Aaron Schaefer. ! See http://factorcode.org/license.txt for BSD license. -USING: kernel math project-euler.common sequences ; +USING: math.primes.factors sequences ; IN: project-euler.003 ! http://projecteuler.net/index.php?section=problems&id=3 @@ -17,12 +17,12 @@ IN: project-euler.003 ! -------- : largest-prime-factor ( n -- factor ) - prime-factors supremum ; + factors supremum ; : euler003 ( -- answer ) - 317584931803 largest-prime-factor ; + 317584931803 largest-prime-factor ; -! [ euler003 ] 100 ave-time -! 404 ms run / 9 ms GC ave time - 100 trials +! [ euler003 ] time +! 2 ms run / 0 ms GC time MAIN: euler003 diff --git a/extra/project-euler/007/007.factor b/extra/project-euler/007/007.factor index 0a9cd98865..12f06972a9 100644 --- a/extra/project-euler/007/007.factor +++ b/extra/project-euler/007/007.factor @@ -1,6 +1,6 @@ ! Copyright (c) 2007 Aaron Schaefer. ! See http://factorcode.org/license.txt for BSD license. -USING: kernel math math.miller-rabin ; +USING: lazy-lists math math.primes ; IN: project-euler.007 ! http://projecteuler.net/index.php?section=problems&id=7 @@ -18,12 +18,12 @@ IN: project-euler.007 ! -------- : nth-prime ( n -- n ) - 2 swap 1- [ next-prime ] times ; + 1 - lprimes lnth ; : euler007 ( -- answer ) - 10001 nth-prime ; + 10001 nth-prime ; ! [ euler007 ] time -! 19230 ms run / 487 ms GC time +! 22 ms run / 0 ms GC time MAIN: euler007 diff --git a/extra/project-euler/010/010.factor b/extra/project-euler/010/010.factor index 7518eb2f6f..1baf9500a1 100644 --- a/extra/project-euler/010/010.factor +++ b/extra/project-euler/010/010.factor @@ -1,7 +1,6 @@ ! Copyright (c) 2007 Aaron Schaefer, Samuel Tardieu. ! See http://factorcode.org/license.txt for BSD license. -USING: arrays kernel lazy-lists math math.erato math.functions math.ranges - namespaces sequences ; +USING: kernel math.primes sequences ; IN: project-euler.010 ! http://projecteuler.net/index.php?section=problems&id=10 @@ -17,15 +16,10 @@ IN: project-euler.010 ! SOLUTION ! -------- -! Sieve of Eratosthenes and lazy summing - : euler010 ( -- answer ) - 0 1000000 lerato [ + ] leach ; + 1000000 primes-upto sum ; -! TODO: solution is still too slow for 1000000, probably due to seq-diff -! calling member? for each number that we want to remove - -! [ euler010 ] time -! 765 ms run / 7 ms GC time +! [ euler010 ] 100 ave-time +! 14 ms run / 0 ms GC ave time - 100 trials MAIN: euler010 diff --git a/extra/project-euler/011/011.factor b/extra/project-euler/011/011.factor index 9739ee971c..322c361ee0 100644 --- a/extra/project-euler/011/011.factor +++ b/extra/project-euler/011/011.factor @@ -1,6 +1,6 @@ ! Copyright (c) 2007 Aaron Schaefer. ! See http://factorcode.org/license.txt for BSD license. -USING: kernel namespaces project-euler.common sequences ; +USING: kernel namespaces project-euler.common sequences splitting ; IN: project-euler.011 ! http://projecteuler.net/index.php?section=problems&id=11 @@ -45,40 +45,40 @@ IN: project-euler.011 : horizontal ( -- matrix ) { - { 08 02 22 97 38 15 00 40 00 75 04 05 07 78 52 12 50 77 91 08 } - { 49 49 99 40 17 81 18 57 60 87 17 40 98 43 69 48 04 56 62 00 } - { 81 49 31 73 55 79 14 29 93 71 40 67 53 88 30 03 49 13 36 65 } - { 52 70 95 23 04 60 11 42 69 24 68 56 01 32 56 71 37 02 36 91 } - { 22 31 16 71 51 67 63 89 41 92 36 54 22 40 40 28 66 33 13 80 } - { 24 47 32 60 99 03 45 02 44 75 33 53 78 36 84 20 35 17 12 50 } - { 32 98 81 28 64 23 67 10 26 38 40 67 59 54 70 66 18 38 64 70 } - { 67 26 20 68 02 62 12 20 95 63 94 39 63 08 40 91 66 49 94 21 } - { 24 55 58 05 66 73 99 26 97 17 78 78 96 83 14 88 34 89 63 72 } - { 21 36 23 09 75 00 76 44 20 45 35 14 00 61 33 97 34 31 33 95 } - { 78 17 53 28 22 75 31 67 15 94 03 80 04 62 16 14 09 53 56 92 } - { 16 39 05 42 96 35 31 47 55 58 88 24 00 17 54 24 36 29 85 57 } - { 86 56 00 48 35 71 89 07 05 44 44 37 44 60 21 58 51 54 17 58 } - { 19 80 81 68 05 94 47 69 28 73 92 13 86 52 17 77 04 89 55 40 } - { 04 52 08 83 97 35 99 16 07 97 57 32 16 26 26 79 33 27 98 66 } - { 88 36 68 87 57 62 20 72 03 46 33 67 46 55 12 32 63 93 53 69 } - { 04 42 16 73 38 25 39 11 24 94 72 18 08 46 29 32 40 62 76 36 } - { 20 69 36 41 72 30 23 88 34 62 99 69 82 67 59 85 74 04 36 16 } - { 20 73 35 29 78 31 90 01 74 31 49 71 48 86 81 16 23 57 05 54 } - { 01 70 54 71 83 51 54 69 16 92 33 48 61 43 52 01 89 19 67 48 } - } ; + 08 02 22 97 38 15 00 40 00 75 04 05 07 78 52 12 50 77 91 08 + 49 49 99 40 17 81 18 57 60 87 17 40 98 43 69 48 04 56 62 00 + 81 49 31 73 55 79 14 29 93 71 40 67 53 88 30 03 49 13 36 65 + 52 70 95 23 04 60 11 42 69 24 68 56 01 32 56 71 37 02 36 91 + 22 31 16 71 51 67 63 89 41 92 36 54 22 40 40 28 66 33 13 80 + 24 47 32 60 99 03 45 02 44 75 33 53 78 36 84 20 35 17 12 50 + 32 98 81 28 64 23 67 10 26 38 40 67 59 54 70 66 18 38 64 70 + 67 26 20 68 02 62 12 20 95 63 94 39 63 08 40 91 66 49 94 21 + 24 55 58 05 66 73 99 26 97 17 78 78 96 83 14 88 34 89 63 72 + 21 36 23 09 75 00 76 44 20 45 35 14 00 61 33 97 34 31 33 95 + 78 17 53 28 22 75 31 67 15 94 03 80 04 62 16 14 09 53 56 92 + 16 39 05 42 96 35 31 47 55 58 88 24 00 17 54 24 36 29 85 57 + 86 56 00 48 35 71 89 07 05 44 44 37 44 60 21 58 51 54 17 58 + 19 80 81 68 05 94 47 69 28 73 92 13 86 52 17 77 04 89 55 40 + 04 52 08 83 97 35 99 16 07 97 57 32 16 26 26 79 33 27 98 66 + 88 36 68 87 57 62 20 72 03 46 33 67 46 55 12 32 63 93 53 69 + 04 42 16 73 38 25 39 11 24 94 72 18 08 46 29 32 40 62 76 36 + 20 69 36 41 72 30 23 88 34 62 99 69 82 67 59 85 74 04 36 16 + 20 73 35 29 78 31 90 01 74 31 49 71 48 86 81 16 23 57 05 54 + 01 70 54 71 83 51 54 69 16 92 33 48 61 43 52 01 89 19 67 48 + } 20 group ; : vertical ( -- matrix ) horizontal flip ; : pad-front ( matrix -- matrix ) [ - length [ 0 ] each - ] keep [ append ] map ; + length [ 0 ] map + ] keep [ append ] 2map ; : pad-back ( matrix -- matrix ) [ - length [ 0 ] each - ] keep [ append ] map ; + length [ 0 ] map + ] keep [ append ] 2map ; : diagonal/ ( -- matrix ) horizontal reverse pad-front pad-back flip ; @@ -98,9 +98,6 @@ PRIVATE> [ call 4 max-product , ] each ] { } make supremum ; -! TODO: solution works but doesn't completely compile due to the creation of -! the diagonal matrices, there must be a cleaner way to generate those - ! [ euler011 ] 100 ave-time ! 4 ms run / 0 ms GC ave time - 100 trials diff --git a/extra/project-euler/016/016.factor b/extra/project-euler/016/016.factor index a8b2aea0b7..866b0ed522 100644 --- a/extra/project-euler/016/016.factor +++ b/extra/project-euler/016/016.factor @@ -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 ; diff --git a/extra/project-euler/017/017.factor b/extra/project-euler/017/017.factor index 7568872743..1fdb6c5484 100644 --- a/extra/project-euler/017/017.factor +++ b/extra/project-euler/017/017.factor @@ -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 diff --git a/extra/project-euler/018/018.factor b/extra/project-euler/018/018.factor new file mode 100644 index 0000000000..2dc05db1b1 --- /dev/null +++ b/extra/project-euler/018/018.factor @@ -0,0 +1,121 @@ +! Copyright (c) 2007 Samuel Tardieu, Aaron Schaefer. +! See http://factorcode.org/license.txt for BSD license. +USING: kernel math project-euler.common sequences ; +IN: project-euler.018 + +! http://projecteuler.net/index.php?section=problems&id=18 + +! 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. + +! 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 + +! 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 +! -------- + +! Propagate from bottom to top the longest cumulative path. This is very +! efficient and will be reused in problem 67. + + + +! Propagate one row into the upper one +: propagate ( bottom top -- newtop ) + [ 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 ; + +: euler018 ( -- answer ) + pyramid propagate-all first first ; + +! [ euler018 ] 100 ave-time +! 0 ms run / 0 ms GC ave time - 100 trials + + +! ALTERNATE SOLUTIONS +! ------------------- + + + +: euler018a ( -- answer ) + source-018a max-path ; + +! [ euler018a ] 100 ave-time +! 0 ms run / 0 ms GC ave time - 100 trials + +MAIN: euler018 diff --git a/extra/project-euler/019/019.factor b/extra/project-euler/019/019.factor new file mode 100644 index 0000000000..f811b98e10 --- /dev/null +++ b/extra/project-euler/019/019.factor @@ -0,0 +1,70 @@ +! Copyright (c) 2007 Samuel Tardieu, Aaron Schaefer. +! See http://factorcode.org/license.txt for BSD license. +USING: calendar combinators combinators.lib kernel math math.ranges namespaces + sequences ; +IN: project-euler.019 + +! http://projecteuler.net/index.php?section=problems&id=19 + +! DESCRIPTION +! ----------- + +! You are given the following information, but you may prefer to do some +! 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. + +! How many Sundays fell on the first of the month during the twentieth century +! (1 Jan 1901 to 31 Dec 2000)? + + +! SOLUTION +! -------- + +! Use Zeller congruence, which is implemented in the "calendar" module +! already, as "zeller-congruence ( year month day -- n )" where n is +! the day of the week (Sunday is 0). + +: euler019 ( -- count ) + 1901 2000 [a,b] [ 12 [1,b] [ 1 zeller-congruence ] 1 map-withn ] map concat + [ 0 = ] subset length ; + +! [ euler019 ] 100 ave-time +! 1 ms run / 0 ms GC ave time - 100 trials + + +! ALTERNATE SOLUTIONS +! ------------------- + += [ + 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 diff --git a/extra/project-euler/020/020.factor b/extra/project-euler/020/020.factor new file mode 100644 index 0000000000..498aad16ad --- /dev/null +++ b/extra/project-euler/020/020.factor @@ -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 diff --git a/extra/project-euler/021/021.factor b/extra/project-euler/021/021.factor new file mode 100644 index 0000000000..c3859665e7 --- /dev/null +++ b/extra/project-euler/021/021.factor @@ -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 diff --git a/extra/project-euler/022/022.factor b/extra/project-euler/022/022.factor new file mode 100644 index 0000000000..f523f586c5 --- /dev/null +++ b/extra/project-euler/022/022.factor @@ -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 +! -------- + +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 diff --git a/extra/project-euler/022/names.txt b/extra/project-euler/022/names.txt new file mode 100644 index 0000000000..5f9cf17227 --- /dev/null +++ b/extra/project-euler/022/names.txt @@ -0,0 +1 @@ +"MARY","PATRICIA","LINDA","BARBARA","ELIZABETH","JENNIFER","MARIA","SUSAN","MARGARET","DOROTHY","LISA","NANCY","KAREN","BETTY","HELEN","SANDRA","DONNA","CAROL","RUTH","SHARON","MICHELLE","LAURA","SARAH","KIMBERLY","DEBORAH","JESSICA","SHIRLEY","CYNTHIA","ANGELA","MELISSA","BRENDA","AMY","ANNA","REBECCA","VIRGINIA","KATHLEEN","PAMELA","MARTHA","DEBRA","AMANDA","STEPHANIE","CAROLYN","CHRISTINE","MARIE","JANET","CATHERINE","FRANCES","ANN","JOYCE","DIANE","ALICE","JULIE","HEATHER","TERESA","DORIS","GLORIA","EVELYN","JEAN","CHERYL","MILDRED","KATHERINE","JOAN","ASHLEY","JUDITH","ROSE","JANICE","KELLY","NICOLE","JUDY","CHRISTINA","KATHY","THERESA","BEVERLY","DENISE","TAMMY","IRENE","JANE","LORI","RACHEL","MARILYN","ANDREA","KATHRYN","LOUISE","SARA","ANNE","JACQUELINE","WANDA","BONNIE","JULIA","RUBY","LOIS","TINA","PHYLLIS","NORMA","PAULA","DIANA","ANNIE","LILLIAN","EMILY","ROBIN","PEGGY","CRYSTAL","GLADYS","RITA","DAWN","CONNIE","FLORENCE","TRACY","EDNA","TIFFANY","CARMEN","ROSA","CINDY","GRACE","WENDY","VICTORIA","EDITH","KIM","SHERRY","SYLVIA","JOSEPHINE","THELMA","SHANNON","SHEILA","ETHEL","ELLEN","ELAINE","MARJORIE","CARRIE","CHARLOTTE","MONICA","ESTHER","PAULINE","EMMA","JUANITA","ANITA","RHONDA","HAZEL","AMBER","EVA","DEBBIE","APRIL","LESLIE","CLARA","LUCILLE","JAMIE","JOANNE","ELEANOR","VALERIE","DANIELLE","MEGAN","ALICIA","SUZANNE","MICHELE","GAIL","BERTHA","DARLENE","VERONICA","JILL","ERIN","GERALDINE","LAUREN","CATHY","JOANN","LORRAINE","LYNN","SALLY","REGINA","ERICA","BEATRICE","DOLORES","BERNICE","AUDREY","YVONNE","ANNETTE","JUNE","SAMANTHA","MARION","DANA","STACY","ANA","RENEE","IDA","VIVIAN","ROBERTA","HOLLY","BRITTANY","MELANIE","LORETTA","YOLANDA","JEANETTE","LAURIE","KATIE","KRISTEN","VANESSA","ALMA","SUE","ELSIE","BETH","JEANNE","VICKI","CARLA","TARA","ROSEMARY","EILEEN","TERRI","GERTRUDE","LUCY","TONYA","ELLA","STACEY","WILMA","GINA","KRISTIN","JESSIE","NATALIE","AGNES","VERA","WILLIE","CHARLENE","BESSIE","DELORES","MELINDA","PEARL","ARLENE","MAUREEN","COLLEEN","ALLISON","TAMARA","JOY","GEORGIA","CONSTANCE","LILLIE","CLAUDIA","JACKIE","MARCIA","TANYA","NELLIE","MINNIE","MARLENE","HEIDI","GLENDA","LYDIA","VIOLA","COURTNEY","MARIAN","STELLA","CAROLINE","DORA","JO","VICKIE","MATTIE","TERRY","MAXINE","IRMA","MABEL","MARSHA","MYRTLE","LENA","CHRISTY","DEANNA","PATSY","HILDA","GWENDOLYN","JENNIE","NORA","MARGIE","NINA","CASSANDRA","LEAH","PENNY","KAY","PRISCILLA","NAOMI","CAROLE","BRANDY","OLGA","BILLIE","DIANNE","TRACEY","LEONA","JENNY","FELICIA","SONIA","MIRIAM","VELMA","BECKY","BOBBIE","VIOLET","KRISTINA","TONI","MISTY","MAE","SHELLY","DAISY","RAMONA","SHERRI","ERIKA","KATRINA","CLAIRE","LINDSEY","LINDSAY","GENEVA","GUADALUPE","BELINDA","MARGARITA","SHERYL","CORA","FAYE","ADA","NATASHA","SABRINA","ISABEL","MARGUERITE","HATTIE","HARRIET","MOLLY","CECILIA","KRISTI","BRANDI","BLANCHE","SANDY","ROSIE","JOANNA","IRIS","EUNICE","ANGIE","INEZ","LYNDA","MADELINE","AMELIA","ALBERTA","GENEVIEVE","MONIQUE","JODI","JANIE","MAGGIE","KAYLA","SONYA","JAN","LEE","KRISTINE","CANDACE","FANNIE","MARYANN","OPAL","ALISON","YVETTE","MELODY","LUZ","SUSIE","OLIVIA","FLORA","SHELLEY","KRISTY","MAMIE","LULA","LOLA","VERNA","BEULAH","ANTOINETTE","CANDICE","JUANA","JEANNETTE","PAM","KELLI","HANNAH","WHITNEY","BRIDGET","KARLA","CELIA","LATOYA","PATTY","SHELIA","GAYLE","DELLA","VICKY","LYNNE","SHERI","MARIANNE","KARA","JACQUELYN","ERMA","BLANCA","MYRA","LETICIA","PAT","KRISTA","ROXANNE","ANGELICA","JOHNNIE","ROBYN","FRANCIS","ADRIENNE","ROSALIE","ALEXANDRA","BROOKE","BETHANY","SADIE","BERNADETTE","TRACI","JODY","KENDRA","JASMINE","NICHOLE","RACHAEL","CHELSEA","MABLE","ERNESTINE","MURIEL","MARCELLA","ELENA","KRYSTAL","ANGELINA","NADINE","KARI","ESTELLE","DIANNA","PAULETTE","LORA","MONA","DOREEN","ROSEMARIE","ANGEL","DESIREE","ANTONIA","HOPE","GINGER","JANIS","BETSY","CHRISTIE","FREDA","MERCEDES","MEREDITH","LYNETTE","TERI","CRISTINA","EULA","LEIGH","MEGHAN","SOPHIA","ELOISE","ROCHELLE","GRETCHEN","CECELIA","RAQUEL","HENRIETTA","ALYSSA","JANA","KELLEY","GWEN","KERRY","JENNA","TRICIA","LAVERNE","OLIVE","ALEXIS","TASHA","SILVIA","ELVIRA","CASEY","DELIA","SOPHIE","KATE","PATTI","LORENA","KELLIE","SONJA","LILA","LANA","DARLA","MAY","MINDY","ESSIE","MANDY","LORENE","ELSA","JOSEFINA","JEANNIE","MIRANDA","DIXIE","LUCIA","MARTA","FAITH","LELA","JOHANNA","SHARI","CAMILLE","TAMI","SHAWNA","ELISA","EBONY","MELBA","ORA","NETTIE","TABITHA","OLLIE","JAIME","WINIFRED","KRISTIE","MARINA","ALISHA","AIMEE","RENA","MYRNA","MARLA","TAMMIE","LATASHA","BONITA","PATRICE","RONDA","SHERRIE","ADDIE","FRANCINE","DELORIS","STACIE","ADRIANA","CHERI","SHELBY","ABIGAIL","CELESTE","JEWEL","CARA","ADELE","REBEKAH","LUCINDA","DORTHY","CHRIS","EFFIE","TRINA","REBA","SHAWN","SALLIE","AURORA","LENORA","ETTA","LOTTIE","KERRI","TRISHA","NIKKI","ESTELLA","FRANCISCA","JOSIE","TRACIE","MARISSA","KARIN","BRITTNEY","JANELLE","LOURDES","LAUREL","HELENE","FERN","ELVA","CORINNE","KELSEY","INA","BETTIE","ELISABETH","AIDA","CAITLIN","INGRID","IVA","EUGENIA","CHRISTA","GOLDIE","CASSIE","MAUDE","JENIFER","THERESE","FRANKIE","DENA","LORNA","JANETTE","LATONYA","CANDY","MORGAN","CONSUELO","TAMIKA","ROSETTA","DEBORA","CHERIE","POLLY","DINA","JEWELL","FAY","JILLIAN","DOROTHEA","NELL","TRUDY","ESPERANZA","PATRICA","KIMBERLEY","SHANNA","HELENA","CAROLINA","CLEO","STEFANIE","ROSARIO","OLA","JANINE","MOLLIE","LUPE","ALISA","LOU","MARIBEL","SUSANNE","BETTE","SUSANA","ELISE","CECILE","ISABELLE","LESLEY","JOCELYN","PAIGE","JONI","RACHELLE","LEOLA","DAPHNE","ALTA","ESTER","PETRA","GRACIELA","IMOGENE","JOLENE","KEISHA","LACEY","GLENNA","GABRIELA","KERI","URSULA","LIZZIE","KIRSTEN","SHANA","ADELINE","MAYRA","JAYNE","JACLYN","GRACIE","SONDRA","CARMELA","MARISA","ROSALIND","CHARITY","TONIA","BEATRIZ","MARISOL","CLARICE","JEANINE","SHEENA","ANGELINE","FRIEDA","LILY","ROBBIE","SHAUNA","MILLIE","CLAUDETTE","CATHLEEN","ANGELIA","GABRIELLE","AUTUMN","KATHARINE","SUMMER","JODIE","STACI","LEA","CHRISTI","JIMMIE","JUSTINE","ELMA","LUELLA","MARGRET","DOMINIQUE","SOCORRO","RENE","MARTINA","MARGO","MAVIS","CALLIE","BOBBI","MARITZA","LUCILE","LEANNE","JEANNINE","DEANA","AILEEN","LORIE","LADONNA","WILLA","MANUELA","GALE","SELMA","DOLLY","SYBIL","ABBY","LARA","DALE","IVY","DEE","WINNIE","MARCY","LUISA","JERI","MAGDALENA","OFELIA","MEAGAN","AUDRA","MATILDA","LEILA","CORNELIA","BIANCA","SIMONE","BETTYE","RANDI","VIRGIE","LATISHA","BARBRA","GEORGINA","ELIZA","LEANN","BRIDGETTE","RHODA","HALEY","ADELA","NOLA","BERNADINE","FLOSSIE","ILA","GRETA","RUTHIE","NELDA","MINERVA","LILLY","TERRIE","LETHA","HILARY","ESTELA","VALARIE","BRIANNA","ROSALYN","EARLINE","CATALINA","AVA","MIA","CLARISSA","LIDIA","CORRINE","ALEXANDRIA","CONCEPCION","TIA","SHARRON","RAE","DONA","ERICKA","JAMI","ELNORA","CHANDRA","LENORE","NEVA","MARYLOU","MELISA","TABATHA","SERENA","AVIS","ALLIE","SOFIA","JEANIE","ODESSA","NANNIE","HARRIETT","LORAINE","PENELOPE","MILAGROS","EMILIA","BENITA","ALLYSON","ASHLEE","TANIA","TOMMIE","ESMERALDA","KARINA","EVE","PEARLIE","ZELMA","MALINDA","NOREEN","TAMEKA","SAUNDRA","HILLARY","AMIE","ALTHEA","ROSALINDA","JORDAN","LILIA","ALANA","GAY","CLARE","ALEJANDRA","ELINOR","MICHAEL","LORRIE","JERRI","DARCY","EARNESTINE","CARMELLA","TAYLOR","NOEMI","MARCIE","LIZA","ANNABELLE","LOUISA","EARLENE","MALLORY","CARLENE","NITA","SELENA","TANISHA","KATY","JULIANNE","JOHN","LAKISHA","EDWINA","MARICELA","MARGERY","KENYA","DOLLIE","ROXIE","ROSLYN","KATHRINE","NANETTE","CHARMAINE","LAVONNE","ILENE","KRIS","TAMMI","SUZETTE","CORINE","KAYE","JERRY","MERLE","CHRYSTAL","LINA","DEANNE","LILIAN","JULIANA","ALINE","LUANN","KASEY","MARYANNE","EVANGELINE","COLETTE","MELVA","LAWANDA","YESENIA","NADIA","MADGE","KATHIE","EDDIE","OPHELIA","VALERIA","NONA","MITZI","MARI","GEORGETTE","CLAUDINE","FRAN","ALISSA","ROSEANN","LAKEISHA","SUSANNA","REVA","DEIDRE","CHASITY","SHEREE","CARLY","JAMES","ELVIA","ALYCE","DEIRDRE","GENA","BRIANA","ARACELI","KATELYN","ROSANNE","WENDI","TESSA","BERTA","MARVA","IMELDA","MARIETTA","MARCI","LEONOR","ARLINE","SASHA","MADELYN","JANNA","JULIETTE","DEENA","AURELIA","JOSEFA","AUGUSTA","LILIANA","YOUNG","CHRISTIAN","LESSIE","AMALIA","SAVANNAH","ANASTASIA","VILMA","NATALIA","ROSELLA","LYNNETTE","CORINA","ALFREDA","LEANNA","CAREY","AMPARO","COLEEN","TAMRA","AISHA","WILDA","KARYN","CHERRY","QUEEN","MAURA","MAI","EVANGELINA","ROSANNA","HALLIE","ERNA","ENID","MARIANA","LACY","JULIET","JACKLYN","FREIDA","MADELEINE","MARA","HESTER","CATHRYN","LELIA","CASANDRA","BRIDGETT","ANGELITA","JANNIE","DIONNE","ANNMARIE","KATINA","BERYL","PHOEBE","MILLICENT","KATHERYN","DIANN","CARISSA","MARYELLEN","LIZ","LAURI","HELGA","GILDA","ADRIAN","RHEA","MARQUITA","HOLLIE","TISHA","TAMERA","ANGELIQUE","FRANCESCA","BRITNEY","KAITLIN","LOLITA","FLORINE","ROWENA","REYNA","TWILA","FANNY","JANELL","INES","CONCETTA","BERTIE","ALBA","BRIGITTE","ALYSON","VONDA","PANSY","ELBA","NOELLE","LETITIA","KITTY","DEANN","BRANDIE","LOUELLA","LETA","FELECIA","SHARLENE","LESA","BEVERLEY","ROBERT","ISABELLA","HERMINIA","TERRA","CELINA","TORI","OCTAVIA","JADE","DENICE","GERMAINE","SIERRA","MICHELL","CORTNEY","NELLY","DORETHA","SYDNEY","DEIDRA","MONIKA","LASHONDA","JUDI","CHELSEY","ANTIONETTE","MARGOT","BOBBY","ADELAIDE","NAN","LEEANN","ELISHA","DESSIE","LIBBY","KATHI","GAYLA","LATANYA","MINA","MELLISA","KIMBERLEE","JASMIN","RENAE","ZELDA","ELDA","MA","JUSTINA","GUSSIE","EMILIE","CAMILLA","ABBIE","ROCIO","KAITLYN","JESSE","EDYTHE","ASHLEIGH","SELINA","LAKESHA","GERI","ALLENE","PAMALA","MICHAELA","DAYNA","CARYN","ROSALIA","SUN","JACQULINE","REBECA","MARYBETH","KRYSTLE","IOLA","DOTTIE","BENNIE","BELLE","AUBREY","GRISELDA","ERNESTINA","ELIDA","ADRIANNE","DEMETRIA","DELMA","CHONG","JAQUELINE","DESTINY","ARLEEN","VIRGINA","RETHA","FATIMA","TILLIE","ELEANORE","CARI","TREVA","BIRDIE","WILHELMINA","ROSALEE","MAURINE","LATRICE","YONG","JENA","TARYN","ELIA","DEBBY","MAUDIE","JEANNA","DELILAH","CATRINA","SHONDA","HORTENCIA","THEODORA","TERESITA","ROBBIN","DANETTE","MARYJANE","FREDDIE","DELPHINE","BRIANNE","NILDA","DANNA","CINDI","BESS","IONA","HANNA","ARIEL","WINONA","VIDA","ROSITA","MARIANNA","WILLIAM","RACHEAL","GUILLERMINA","ELOISA","CELESTINE","CAREN","MALISSA","LONA","CHANTEL","SHELLIE","MARISELA","LEORA","AGATHA","SOLEDAD","MIGDALIA","IVETTE","CHRISTEN","ATHENA","JANEL","CHLOE","VEDA","PATTIE","TESSIE","TERA","MARILYNN","LUCRETIA","KARRIE","DINAH","DANIELA","ALECIA","ADELINA","VERNICE","SHIELA","PORTIA","MERRY","LASHAWN","DEVON","DARA","TAWANA","OMA","VERDA","CHRISTIN","ALENE","ZELLA","SANDI","RAFAELA","MAYA","KIRA","CANDIDA","ALVINA","SUZAN","SHAYLA","LYN","LETTIE","ALVA","SAMATHA","ORALIA","MATILDE","MADONNA","LARISSA","VESTA","RENITA","INDIA","DELOIS","SHANDA","PHILLIS","LORRI","ERLINDA","CRUZ","CATHRINE","BARB","ZOE","ISABELL","IONE","GISELA","CHARLIE","VALENCIA","ROXANNA","MAYME","KISHA","ELLIE","MELLISSA","DORRIS","DALIA","BELLA","ANNETTA","ZOILA","RETA","REINA","LAURETTA","KYLIE","CHRISTAL","PILAR","CHARLA","ELISSA","TIFFANI","TANA","PAULINA","LEOTA","BREANNA","JAYME","CARMEL","VERNELL","TOMASA","MANDI","DOMINGA","SANTA","MELODIE","LURA","ALEXA","TAMELA","RYAN","MIRNA","KERRIE","VENUS","NOEL","FELICITA","CRISTY","CARMELITA","BERNIECE","ANNEMARIE","TIARA","ROSEANNE","MISSY","CORI","ROXANA","PRICILLA","KRISTAL","JUNG","ELYSE","HAYDEE","ALETHA","BETTINA","MARGE","GILLIAN","FILOMENA","CHARLES","ZENAIDA","HARRIETTE","CARIDAD","VADA","UNA","ARETHA","PEARLINE","MARJORY","MARCELA","FLOR","EVETTE","ELOUISE","ALINA","TRINIDAD","DAVID","DAMARIS","CATHARINE","CARROLL","BELVA","NAKIA","MARLENA","LUANNE","LORINE","KARON","DORENE","DANITA","BRENNA","TATIANA","SAMMIE","LOUANN","LOREN","JULIANNA","ANDRIA","PHILOMENA","LUCILA","LEONORA","DOVIE","ROMONA","MIMI","JACQUELIN","GAYE","TONJA","MISTI","JOE","GENE","CHASTITY","STACIA","ROXANN","MICAELA","NIKITA","MEI","VELDA","MARLYS","JOHNNA","AURA","LAVERN","IVONNE","HAYLEY","NICKI","MAJORIE","HERLINDA","GEORGE","ALPHA","YADIRA","PERLA","GREGORIA","DANIEL","ANTONETTE","SHELLI","MOZELLE","MARIAH","JOELLE","CORDELIA","JOSETTE","CHIQUITA","TRISTA","LOUIS","LAQUITA","GEORGIANA","CANDI","SHANON","LONNIE","HILDEGARD","CECIL","VALENTINA","STEPHANY","MAGDA","KAROL","GERRY","GABRIELLA","TIANA","ROMA","RICHELLE","RAY","PRINCESS","OLETA","JACQUE","IDELLA","ALAINA","SUZANNA","JOVITA","BLAIR","TOSHA","RAVEN","NEREIDA","MARLYN","KYLA","JOSEPH","DELFINA","TENA","STEPHENIE","SABINA","NATHALIE","MARCELLE","GERTIE","DARLEEN","THEA","SHARONDA","SHANTEL","BELEN","VENESSA","ROSALINA","ONA","GENOVEVA","COREY","CLEMENTINE","ROSALBA","RENATE","RENATA","MI","IVORY","GEORGIANNA","FLOY","DORCAS","ARIANA","TYRA","THEDA","MARIAM","JULI","JESICA","DONNIE","VIKKI","VERLA","ROSELYN","MELVINA","JANNETTE","GINNY","DEBRAH","CORRIE","ASIA","VIOLETA","MYRTIS","LATRICIA","COLLETTE","CHARLEEN","ANISSA","VIVIANA","TWYLA","PRECIOUS","NEDRA","LATONIA","LAN","HELLEN","FABIOLA","ANNAMARIE","ADELL","SHARYN","CHANTAL","NIKI","MAUD","LIZETTE","LINDY","KIA","KESHA","JEANA","DANELLE","CHARLINE","CHANEL","CARROL","VALORIE","LIA","DORTHA","CRISTAL","SUNNY","LEONE","LEILANI","GERRI","DEBI","ANDRA","KESHIA","IMA","EULALIA","EASTER","DULCE","NATIVIDAD","LINNIE","KAMI","GEORGIE","CATINA","BROOK","ALDA","WINNIFRED","SHARLA","RUTHANN","MEAGHAN","MAGDALENE","LISSETTE","ADELAIDA","VENITA","TRENA","SHIRLENE","SHAMEKA","ELIZEBETH","DIAN","SHANTA","MICKEY","LATOSHA","CARLOTTA","WINDY","SOON","ROSINA","MARIANN","LEISA","JONNIE","DAWNA","CATHIE","BILLY","ASTRID","SIDNEY","LAUREEN","JANEEN","HOLLI","FAWN","VICKEY","TERESSA","SHANTE","RUBYE","MARCELINA","CHANDA","CARY","TERESE","SCARLETT","MARTY","MARNIE","LULU","LISETTE","JENIFFER","ELENOR","DORINDA","DONITA","CARMAN","BERNITA","ALTAGRACIA","ALETA","ADRIANNA","ZORAIDA","RONNIE","NICOLA","LYNDSEY","KENDALL","JANINA","CHRISSY","AMI","STARLA","PHYLIS","PHUONG","KYRA","CHARISSE","BLANCH","SANJUANITA","RONA","NANCI","MARILEE","MARANDA","CORY","BRIGETTE","SANJUANA","MARITA","KASSANDRA","JOYCELYN","IRA","FELIPA","CHELSIE","BONNY","MIREYA","LORENZA","KYONG","ILEANA","CANDELARIA","TONY","TOBY","SHERIE","OK","MARK","LUCIE","LEATRICE","LAKESHIA","GERDA","EDIE","BAMBI","MARYLIN","LAVON","HORTENSE","GARNET","EVIE","TRESSA","SHAYNA","LAVINA","KYUNG","JEANETTA","SHERRILL","SHARA","PHYLISS","MITTIE","ANABEL","ALESIA","THUY","TAWANDA","RICHARD","JOANIE","TIFFANIE","LASHANDA","KARISSA","ENRIQUETA","DARIA","DANIELLA","CORINNA","ALANNA","ABBEY","ROXANE","ROSEANNA","MAGNOLIA","LIDA","KYLE","JOELLEN","ERA","CORAL","CARLEEN","TRESA","PEGGIE","NOVELLA","NILA","MAYBELLE","JENELLE","CARINA","NOVA","MELINA","MARQUERITE","MARGARETTE","JOSEPHINA","EVONNE","DEVIN","CINTHIA","ALBINA","TOYA","TAWNYA","SHERITA","SANTOS","MYRIAM","LIZABETH","LISE","KEELY","JENNI","GISELLE","CHERYLE","ARDITH","ARDIS","ALESHA","ADRIANE","SHAINA","LINNEA","KAROLYN","HONG","FLORIDA","FELISHA","DORI","DARCI","ARTIE","ARMIDA","ZOLA","XIOMARA","VERGIE","SHAMIKA","NENA","NANNETTE","MAXIE","LOVIE","JEANE","JAIMIE","INGE","FARRAH","ELAINA","CAITLYN","STARR","FELICITAS","CHERLY","CARYL","YOLONDA","YASMIN","TEENA","PRUDENCE","PENNIE","NYDIA","MACKENZIE","ORPHA","MARVEL","LIZBETH","LAURETTE","JERRIE","HERMELINDA","CAROLEE","TIERRA","MIRIAN","META","MELONY","KORI","JENNETTE","JAMILA","ENA","ANH","YOSHIKO","SUSANNAH","SALINA","RHIANNON","JOLEEN","CRISTINE","ASHTON","ARACELY","TOMEKA","SHALONDA","MARTI","LACIE","KALA","JADA","ILSE","HAILEY","BRITTANI","ZONA","SYBLE","SHERRYL","RANDY","NIDIA","MARLO","KANDICE","KANDI","DEB","DEAN","AMERICA","ALYCIA","TOMMY","RONNA","NORENE","MERCY","JOSE","INGEBORG","GIOVANNA","GEMMA","CHRISTEL","AUDRY","ZORA","VITA","VAN","TRISH","STEPHAINE","SHIRLEE","SHANIKA","MELONIE","MAZIE","JAZMIN","INGA","HOA","HETTIE","GERALYN","FONDA","ESTRELLA","ADELLA","SU","SARITA","RINA","MILISSA","MARIBETH","GOLDA","EVON","ETHELYN","ENEDINA","CHERISE","CHANA","VELVA","TAWANNA","SADE","MIRTA","LI","KARIE","JACINTA","ELNA","DAVINA","CIERRA","ASHLIE","ALBERTHA","TANESHA","STEPHANI","NELLE","MINDI","LU","LORINDA","LARUE","FLORENE","DEMETRA","DEDRA","CIARA","CHANTELLE","ASHLY","SUZY","ROSALVA","NOELIA","LYDA","LEATHA","KRYSTYNA","KRISTAN","KARRI","DARLINE","DARCIE","CINDA","CHEYENNE","CHERRIE","AWILDA","ALMEDA","ROLANDA","LANETTE","JERILYN","GISELE","EVALYN","CYNDI","CLETA","CARIN","ZINA","ZENA","VELIA","TANIKA","PAUL","CHARISSA","THOMAS","TALIA","MARGARETE","LAVONDA","KAYLEE","KATHLENE","JONNA","IRENA","ILONA","IDALIA","CANDIS","CANDANCE","BRANDEE","ANITRA","ALIDA","SIGRID","NICOLETTE","MARYJO","LINETTE","HEDWIG","CHRISTIANA","CASSIDY","ALEXIA","TRESSIE","MODESTA","LUPITA","LITA","GLADIS","EVELIA","DAVIDA","CHERRI","CECILY","ASHELY","ANNABEL","AGUSTINA","WANITA","SHIRLY","ROSAURA","HULDA","EUN","BAILEY","YETTA","VERONA","THOMASINA","SIBYL","SHANNAN","MECHELLE","LUE","LEANDRA","LANI","KYLEE","KANDY","JOLYNN","FERNE","EBONI","CORENE","ALYSIA","ZULA","NADA","MOIRA","LYNDSAY","LORRETTA","JUAN","JAMMIE","HORTENSIA","GAYNELL","CAMERON","ADRIA","VINA","VICENTA","TANGELA","STEPHINE","NORINE","NELLA","LIANA","LESLEE","KIMBERELY","ILIANA","GLORY","FELICA","EMOGENE","ELFRIEDE","EDEN","EARTHA","CARMA","BEA","OCIE","MARRY","LENNIE","KIARA","JACALYN","CARLOTA","ARIELLE","YU","STAR","OTILIA","KIRSTIN","KACEY","JOHNETTA","JOEY","JOETTA","JERALDINE","JAUNITA","ELANA","DORTHEA","CAMI","AMADA","ADELIA","VERNITA","TAMAR","SIOBHAN","RENEA","RASHIDA","OUIDA","ODELL","NILSA","MERYL","KRISTYN","JULIETA","DANICA","BREANNE","AUREA","ANGLEA","SHERRON","ODETTE","MALIA","LORELEI","LIN","LEESA","KENNA","KATHLYN","FIONA","CHARLETTE","SUZIE","SHANTELL","SABRA","RACQUEL","MYONG","MIRA","MARTINE","LUCIENNE","LAVADA","JULIANN","JOHNIE","ELVERA","DELPHIA","CLAIR","CHRISTIANE","CHAROLETTE","CARRI","AUGUSTINE","ASHA","ANGELLA","PAOLA","NINFA","LEDA","LAI","EDA","SUNSHINE","STEFANI","SHANELL","PALMA","MACHELLE","LISSA","KECIA","KATHRYNE","KARLENE","JULISSA","JETTIE","JENNIFFER","HUI","CORRINA","CHRISTOPHER","CAROLANN","ALENA","TESS","ROSARIA","MYRTICE","MARYLEE","LIANE","KENYATTA","JUDIE","JANEY","IN","ELMIRA","ELDORA","DENNA","CRISTI","CATHI","ZAIDA","VONNIE","VIVA","VERNIE","ROSALINE","MARIELA","LUCIANA","LESLI","KARAN","FELICE","DENEEN","ADINA","WYNONA","TARSHA","SHERON","SHASTA","SHANITA","SHANI","SHANDRA","RANDA","PINKIE","PARIS","NELIDA","MARILOU","LYLA","LAURENE","LACI","JOI","JANENE","DOROTHA","DANIELE","DANI","CAROLYNN","CARLYN","BERENICE","AYESHA","ANNELIESE","ALETHEA","THERSA","TAMIKO","RUFINA","OLIVA","MOZELL","MARYLYN","MADISON","KRISTIAN","KATHYRN","KASANDRA","KANDACE","JANAE","GABRIEL","DOMENICA","DEBBRA","DANNIELLE","CHUN","BUFFY","BARBIE","ARCELIA","AJA","ZENOBIA","SHAREN","SHAREE","PATRICK","PAGE","MY","LAVINIA","KUM","KACIE","JACKELINE","HUONG","FELISA","EMELIA","ELEANORA","CYTHIA","CRISTIN","CLYDE","CLARIBEL","CARON","ANASTACIA","ZULMA","ZANDRA","YOKO","TENISHA","SUSANN","SHERILYN","SHAY","SHAWANDA","SABINE","ROMANA","MATHILDA","LINSEY","KEIKO","JOANA","ISELA","GRETTA","GEORGETTA","EUGENIE","DUSTY","DESIRAE","DELORA","CORAZON","ANTONINA","ANIKA","WILLENE","TRACEE","TAMATHA","REGAN","NICHELLE","MICKIE","MAEGAN","LUANA","LANITA","KELSIE","EDELMIRA","BREE","AFTON","TEODORA","TAMIE","SHENA","MEG","LINH","KELI","KACI","DANYELLE","BRITT","ARLETTE","ALBERTINE","ADELLE","TIFFINY","STORMY","SIMONA","NUMBERS","NICOLASA","NICHOL","NIA","NAKISHA","MEE","MAIRA","LOREEN","KIZZY","JOHNNY","JAY","FALLON","CHRISTENE","BOBBYE","ANTHONY","YING","VINCENZA","TANJA","RUBIE","RONI","QUEENIE","MARGARETT","KIMBERLI","IRMGARD","IDELL","HILMA","EVELINA","ESTA","EMILEE","DENNISE","DANIA","CARL","CARIE","ANTONIO","WAI","SANG","RISA","RIKKI","PARTICIA","MUI","MASAKO","MARIO","LUVENIA","LOREE","LONI","LIEN","KEVIN","GIGI","FLORENCIA","DORIAN","DENITA","DALLAS","CHI","BILLYE","ALEXANDER","TOMIKA","SHARITA","RANA","NIKOLE","NEOMA","MARGARITE","MADALYN","LUCINA","LAILA","KALI","JENETTE","GABRIELE","EVELYNE","ELENORA","CLEMENTINA","ALEJANDRINA","ZULEMA","VIOLETTE","VANNESSA","THRESA","RETTA","PIA","PATIENCE","NOELLA","NICKIE","JONELL","DELTA","CHUNG","CHAYA","CAMELIA","BETHEL","ANYA","ANDREW","THANH","SUZANN","SPRING","SHU","MILA","LILLA","LAVERNA","KEESHA","KATTIE","GIA","GEORGENE","EVELINE","ESTELL","ELIZBETH","VIVIENNE","VALLIE","TRUDIE","STEPHANE","MICHEL","MAGALY","MADIE","KENYETTA","KARREN","JANETTA","HERMINE","HARMONY","DRUCILLA","DEBBI","CELESTINA","CANDIE","BRITNI","BECKIE","AMINA","ZITA","YUN","YOLANDE","VIVIEN","VERNETTA","TRUDI","SOMMER","PEARLE","PATRINA","OSSIE","NICOLLE","LOYCE","LETTY","LARISA","KATHARINA","JOSELYN","JONELLE","JENELL","IESHA","HEIDE","FLORINDA","FLORENTINA","FLO","ELODIA","DORINE","BRUNILDA","BRIGID","ASHLI","ARDELLA","TWANA","THU","TARAH","SUNG","SHEA","SHAVON","SHANE","SERINA","RAYNA","RAMONITA","NGA","MARGURITE","LUCRECIA","KOURTNEY","KATI","JESUS","JESENIA","DIAMOND","CRISTA","AYANA","ALICA","ALIA","VINNIE","SUELLEN","ROMELIA","RACHELL","PIPER","OLYMPIA","MICHIKO","KATHALEEN","JOLIE","JESSI","JANESSA","HANA","HA","ELEASE","CARLETTA","BRITANY","SHONA","SALOME","ROSAMOND","REGENA","RAINA","NGOC","NELIA","LOUVENIA","LESIA","LATRINA","LATICIA","LARHONDA","JINA","JACKI","HOLLIS","HOLLEY","EMMY","DEEANN","CORETTA","ARNETTA","VELVET","THALIA","SHANICE","NETA","MIKKI","MICKI","LONNA","LEANA","LASHUNDA","KILEY","JOYE","JACQULYN","IGNACIA","HYUN","HIROKO","HENRY","HENRIETTE","ELAYNE","DELINDA","DARNELL","DAHLIA","COREEN","CONSUELA","CONCHITA","CELINE","BABETTE","AYANNA","ANETTE","ALBERTINA","SKYE","SHAWNEE","SHANEKA","QUIANA","PAMELIA","MIN","MERRI","MERLENE","MARGIT","KIESHA","KIERA","KAYLENE","JODEE","JENISE","ERLENE","EMMIE","ELSE","DARYL","DALILA","DAISEY","CODY","CASIE","BELIA","BABARA","VERSIE","VANESA","SHELBA","SHAWNDA","SAM","NORMAN","NIKIA","NAOMA","MARNA","MARGERET","MADALINE","LAWANA","KINDRA","JUTTA","JAZMINE","JANETT","HANNELORE","GLENDORA","GERTRUD","GARNETT","FREEDA","FREDERICA","FLORANCE","FLAVIA","DENNIS","CARLINE","BEVERLEE","ANJANETTE","VALDA","TRINITY","TAMALA","STEVIE","SHONNA","SHA","SARINA","ONEIDA","MICAH","MERILYN","MARLEEN","LURLINE","LENNA","KATHERIN","JIN","JENI","HAE","GRACIA","GLADY","FARAH","ERIC","ENOLA","EMA","DOMINQUE","DEVONA","DELANA","CECILA","CAPRICE","ALYSHA","ALI","ALETHIA","VENA","THERESIA","TAWNY","SONG","SHAKIRA","SAMARA","SACHIKO","RACHELE","PAMELLA","NICKY","MARNI","MARIEL","MAREN","MALISA","LIGIA","LERA","LATORIA","LARAE","KIMBER","KATHERN","KAREY","JENNEFER","JANETH","HALINA","FREDIA","DELISA","DEBROAH","CIERA","CHIN","ANGELIKA","ANDREE","ALTHA","YEN","VIVAN","TERRESA","TANNA","SUK","SUDIE","SOO","SIGNE","SALENA","RONNI","REBBECCA","MYRTIE","MCKENZIE","MALIKA","MAIDA","LOAN","LEONARDA","KAYLEIGH","FRANCE","ETHYL","ELLYN","DAYLE","CAMMIE","BRITTNI","BIRGIT","AVELINA","ASUNCION","ARIANNA","AKIKO","VENICE","TYESHA","TONIE","TIESHA","TAKISHA","STEFFANIE","SINDY","SANTANA","MEGHANN","MANDA","MACIE","LADY","KELLYE","KELLEE","JOSLYN","JASON","INGER","INDIRA","GLINDA","GLENNIS","FERNANDA","FAUSTINA","ENEIDA","ELICIA","DOT","DIGNA","DELL","ARLETTA","ANDRE","WILLIA","TAMMARA","TABETHA","SHERRELL","SARI","REFUGIO","REBBECA","PAULETTA","NIEVES","NATOSHA","NAKITA","MAMMIE","KENISHA","KAZUKO","KASSIE","GARY","EARLEAN","DAPHINE","CORLISS","CLOTILDE","CAROLYNE","BERNETTA","AUGUSTINA","AUDREA","ANNIS","ANNABELL","YAN","TENNILLE","TAMICA","SELENE","SEAN","ROSANA","REGENIA","QIANA","MARKITA","MACY","LEEANNE","LAURINE","KYM","JESSENIA","JANITA","GEORGINE","GENIE","EMIKO","ELVIE","DEANDRA","DAGMAR","CORIE","COLLEN","CHERISH","ROMAINE","PORSHA","PEARLENE","MICHELINE","MERNA","MARGORIE","MARGARETTA","LORE","KENNETH","JENINE","HERMINA","FREDERICKA","ELKE","DRUSILLA","DORATHY","DIONE","DESIRE","CELENA","BRIGIDA","ANGELES","ALLEGRA","THEO","TAMEKIA","SYNTHIA","STEPHEN","SOOK","SLYVIA","ROSANN","REATHA","RAYE","MARQUETTA","MARGART","LING","LAYLA","KYMBERLY","KIANA","KAYLEEN","KATLYN","KARMEN","JOELLA","IRINA","EMELDA","ELENI","DETRA","CLEMMIE","CHERYLL","CHANTELL","CATHEY","ARNITA","ARLA","ANGLE","ANGELIC","ALYSE","ZOFIA","THOMASINE","TENNIE","SON","SHERLY","SHERLEY","SHARYL","REMEDIOS","PETRINA","NICKOLE","MYUNG","MYRLE","MOZELLA","LOUANNE","LISHA","LATIA","LANE","KRYSTA","JULIENNE","JOEL","JEANENE","JACQUALINE","ISAURA","GWENDA","EARLEEN","DONALD","CLEOPATRA","CARLIE","AUDIE","ANTONIETTA","ALISE","ALEX","VERDELL","VAL","TYLER","TOMOKO","THAO","TALISHA","STEVEN","SO","SHEMIKA","SHAUN","SCARLET","SAVANNA","SANTINA","ROSIA","RAEANN","ODILIA","NANA","MINNA","MAGAN","LYNELLE","LE","KARMA","JOEANN","IVANA","INELL","ILANA","HYE","HONEY","HEE","GUDRUN","FRANK","DREAMA","CRISSY","CHANTE","CARMELINA","ARVILLA","ARTHUR","ANNAMAE","ALVERA","ALEIDA","AARON","YEE","YANIRA","VANDA","TIANNA","TAM","STEFANIA","SHIRA","PERRY","NICOL","NANCIE","MONSERRATE","MINH","MELYNDA","MELANY","MATTHEW","LOVELLA","LAURE","KIRBY","KACY","JACQUELYNN","HYON","GERTHA","FRANCISCO","ELIANA","CHRISTENA","CHRISTEEN","CHARISE","CATERINA","CARLEY","CANDYCE","ARLENA","AMMIE","YANG","WILLETTE","VANITA","TUYET","TINY","SYREETA","SILVA","SCOTT","RONALD","PENNEY","NYLA","MICHAL","MAURICE","MARYAM","MARYA","MAGEN","LUDIE","LOMA","LIVIA","LANELL","KIMBERLIE","JULEE","DONETTA","DIEDRA","DENISHA","DEANE","DAWNE","CLARINE","CHERRYL","BRONWYN","BRANDON","ALLA","VALERY","TONDA","SUEANN","SORAYA","SHOSHANA","SHELA","SHARLEEN","SHANELLE","NERISSA","MICHEAL","MERIDITH","MELLIE","MAYE","MAPLE","MAGARET","LUIS","LILI","LEONILA","LEONIE","LEEANNA","LAVONIA","LAVERA","KRISTEL","KATHEY","KATHE","JUSTIN","JULIAN","JIMMY","JANN","ILDA","HILDRED","HILDEGARDE","GENIA","FUMIKO","EVELIN","ERMELINDA","ELLY","DUNG","DOLORIS","DIONNA","DANAE","BERNEICE","ANNICE","ALIX","VERENA","VERDIE","TRISTAN","SHAWNNA","SHAWANA","SHAUNNA","ROZELLA","RANDEE","RANAE","MILAGRO","LYNELL","LUISE","LOUIE","LOIDA","LISBETH","KARLEEN","JUNITA","JONA","ISIS","HYACINTH","HEDY","GWENN","ETHELENE","ERLINE","EDWARD","DONYA","DOMONIQUE","DELICIA","DANNETTE","CICELY","BRANDA","BLYTHE","BETHANN","ASHLYN","ANNALEE","ALLINE","YUKO","VELLA","TRANG","TOWANDA","TESHA","SHERLYN","NARCISA","MIGUELINA","MERI","MAYBELL","MARLANA","MARGUERITA","MADLYN","LUNA","LORY","LORIANN","LIBERTY","LEONORE","LEIGHANN","LAURICE","LATESHA","LARONDA","KATRICE","KASIE","KARL","KALEY","JADWIGA","GLENNIE","GEARLDINE","FRANCINA","EPIFANIA","DYAN","DORIE","DIEDRE","DENESE","DEMETRICE","DELENA","DARBY","CRISTIE","CLEORA","CATARINA","CARISA","BERNIE","BARBERA","ALMETA","TRULA","TEREASA","SOLANGE","SHEILAH","SHAVONNE","SANORA","ROCHELL","MATHILDE","MARGARETA","MAIA","LYNSEY","LAWANNA","LAUNA","KENA","KEENA","KATIA","JAMEY","GLYNDA","GAYLENE","ELVINA","ELANOR","DANUTA","DANIKA","CRISTEN","CORDIE","COLETTA","CLARITA","CARMON","BRYNN","AZUCENA","AUNDREA","ANGELE","YI","WALTER","VERLIE","VERLENE","TAMESHA","SILVANA","SEBRINA","SAMIRA","REDA","RAYLENE","PENNI","PANDORA","NORAH","NOMA","MIREILLE","MELISSIA","MARYALICE","LARAINE","KIMBERY","KARYL","KARINE","KAM","JOLANDA","JOHANA","JESUSA","JALEESA","JAE","JACQUELYNE","IRISH","ILUMINADA","HILARIA","HANH","GENNIE","FRANCIE","FLORETTA","EXIE","EDDA","DREMA","DELPHA","BEV","BARBAR","ASSUNTA","ARDELL","ANNALISA","ALISIA","YUKIKO","YOLANDO","WONDA","WEI","WALTRAUD","VETA","TEQUILA","TEMEKA","TAMEIKA","SHIRLEEN","SHENITA","PIEDAD","OZELLA","MIRTHA","MARILU","KIMIKO","JULIANE","JENICE","JEN","JANAY","JACQUILINE","HILDE","FE","FAE","EVAN","EUGENE","ELOIS","ECHO","DEVORAH","CHAU","BRINDA","BETSEY","ARMINDA","ARACELIS","APRYL","ANNETT","ALISHIA","VEOLA","USHA","TOSHIKO","THEOLA","TASHIA","TALITHA","SHERY","RUDY","RENETTA","REIKO","RASHEEDA","OMEGA","OBDULIA","MIKA","MELAINE","MEGGAN","MARTIN","MARLEN","MARGET","MARCELINE","MANA","MAGDALEN","LIBRADA","LEZLIE","LEXIE","LATASHIA","LASANDRA","KELLE","ISIDRA","ISA","INOCENCIA","GWYN","FRANCOISE","ERMINIA","ERINN","DIMPLE","DEVORA","CRISELDA","ARMANDA","ARIE","ARIANE","ANGELO","ANGELENA","ALLEN","ALIZA","ADRIENE","ADALINE","XOCHITL","TWANNA","TRAN","TOMIKO","TAMISHA","TAISHA","SUSY","SIU","RUTHA","ROXY","RHONA","RAYMOND","OTHA","NORIKO","NATASHIA","MERRIE","MELVIN","MARINDA","MARIKO","MARGERT","LORIS","LIZZETTE","LEISHA","KAILA","KA","JOANNIE","JERRICA","JENE","JANNET","JANEE","JACINDA","HERTA","ELENORE","DORETTA","DELAINE","DANIELL","CLAUDIE","CHINA","BRITTA","APOLONIA","AMBERLY","ALEASE","YURI","YUK","WEN","WANETA","UTE","TOMI","SHARRI","SANDIE","ROSELLE","REYNALDA","RAGUEL","PHYLICIA","PATRIA","OLIMPIA","ODELIA","MITZIE","MITCHELL","MISS","MINDA","MIGNON","MICA","MENDY","MARIVEL","MAILE","LYNETTA","LAVETTE","LAURYN","LATRISHA","LAKIESHA","KIERSTEN","KARY","JOSPHINE","JOLYN","JETTA","JANISE","JACQUIE","IVELISSE","GLYNIS","GIANNA","GAYNELLE","EMERALD","DEMETRIUS","DANYELL","DANILLE","DACIA","CORALEE","CHER","CEOLA","BRETT","BELL","ARIANNE","ALESHIA","YUNG","WILLIEMAE","TROY","TRINH","THORA","TAI","SVETLANA","SHERIKA","SHEMEKA","SHAUNDA","ROSELINE","RICKI","MELDA","MALLIE","LAVONNA","LATINA","LARRY","LAQUANDA","LALA","LACHELLE","KLARA","KANDIS","JOHNA","JEANMARIE","JAYE","HANG","GRAYCE","GERTUDE","EMERITA","EBONIE","CLORINDA","CHING","CHERY","CAROLA","BREANN","BLOSSOM","BERNARDINE","BECKI","ARLETHA","ARGELIA","ARA","ALITA","YULANDA","YON","YESSENIA","TOBI","TASIA","SYLVIE","SHIRL","SHIRELY","SHERIDAN","SHELLA","SHANTELLE","SACHA","ROYCE","REBECKA","REAGAN","PROVIDENCIA","PAULENE","MISHA","MIKI","MARLINE","MARICA","LORITA","LATOYIA","LASONYA","KERSTIN","KENDA","KEITHA","KATHRIN","JAYMIE","JACK","GRICELDA","GINETTE","ERYN","ELINA","ELFRIEDA","DANYEL","CHEREE","CHANELLE","BARRIE","AVERY","AURORE","ANNAMARIA","ALLEEN","AILENE","AIDE","YASMINE","VASHTI","VALENTINE","TREASA","TORY","TIFFANEY","SHERYLL","SHARIE","SHANAE","SAU","RAISA","PA","NEDA","MITSUKO","MIRELLA","MILDA","MARYANNA","MARAGRET","MABELLE","LUETTA","LORINA","LETISHA","LATARSHA","LANELLE","LAJUANA","KRISSY","KARLY","KARENA","JON","JESSIKA","JERICA","JEANELLE","JANUARY","JALISA","JACELYN","IZOLA","IVEY","GREGORY","EUNA","ETHA","DREW","DOMITILA","DOMINICA","DAINA","CREOLA","CARLI","CAMIE","BUNNY","BRITTNY","ASHANTI","ANISHA","ALEEN","ADAH","YASUKO","WINTER","VIKI","VALRIE","TONA","TINISHA","THI","TERISA","TATUM","TANEKA","SIMONNE","SHALANDA","SERITA","RESSIE","REFUGIA","PAZ","OLENE","NA","MERRILL","MARGHERITA","MANDIE","MAN","MAIRE","LYNDIA","LUCI","LORRIANE","LORETA","LEONIA","LAVONA","LASHAWNDA","LAKIA","KYOKO","KRYSTINA","KRYSTEN","KENIA","KELSI","JUDE","JEANICE","ISOBEL","GEORGIANN","GENNY","FELICIDAD","EILENE","DEON","DELOISE","DEEDEE","DANNIE","CONCEPTION","CLORA","CHERILYN","CHANG","CALANDRA","BERRY","ARMANDINA","ANISA","ULA","TIMOTHY","TIERA","THERESSA","STEPHANIA","SIMA","SHYLA","SHONTA","SHERA","SHAQUITA","SHALA","SAMMY","ROSSANA","NOHEMI","NERY","MORIAH","MELITA","MELIDA","MELANI","MARYLYNN","MARISHA","MARIETTE","MALORIE","MADELENE","LUDIVINA","LORIA","LORETTE","LORALEE","LIANNE","LEON","LAVENIA","LAURINDA","LASHON","KIT","KIMI","KEILA","KATELYNN","KAI","JONE","JOANE","JI","JAYNA","JANELLA","JA","HUE","HERTHA","FRANCENE","ELINORE","DESPINA","DELSIE","DEEDRA","CLEMENCIA","CARRY","CAROLIN","CARLOS","BULAH","BRITTANIE","BOK","BLONDELL","BIBI","BEAULAH","BEATA","ANNITA","AGRIPINA","VIRGEN","VALENE","UN","TWANDA","TOMMYE","TOI","TARRA","TARI","TAMMERA","SHAKIA","SADYE","RUTHANNE","ROCHEL","RIVKA","PURA","NENITA","NATISHA","MING","MERRILEE","MELODEE","MARVIS","LUCILLA","LEENA","LAVETA","LARITA","LANIE","KEREN","ILEEN","GEORGEANN","GENNA","GENESIS","FRIDA","EWA","EUFEMIA","EMELY","ELA","EDYTH","DEONNA","DEADRA","DARLENA","CHANELL","CHAN","CATHERN","CASSONDRA","CASSAUNDRA","BERNARDA","BERNA","ARLINDA","ANAMARIA","ALBERT","WESLEY","VERTIE","VALERI","TORRI","TATYANA","STASIA","SHERISE","SHERILL","SEASON","SCOTTIE","SANDA","RUTHE","ROSY","ROBERTO","ROBBI","RANEE","QUYEN","PEARLY","PALMIRA","ONITA","NISHA","NIESHA","NIDA","NEVADA","NAM","MERLYN","MAYOLA","MARYLOUISE","MARYLAND","MARX","MARTH","MARGENE","MADELAINE","LONDA","LEONTINE","LEOMA","LEIA","LAWRENCE","LAURALEE","LANORA","LAKITA","KIYOKO","KETURAH","KATELIN","KAREEN","JONIE","JOHNETTE","JENEE","JEANETT","IZETTA","HIEDI","HEIKE","HASSIE","HAROLD","GIUSEPPINA","GEORGANN","FIDELA","FERNANDE","ELWANDA","ELLAMAE","ELIZ","DUSTI","DOTTY","CYNDY","CORALIE","CELESTA","ARGENTINA","ALVERTA","XENIA","WAVA","VANETTA","TORRIE","TASHINA","TANDY","TAMBRA","TAMA","STEPANIE","SHILA","SHAUNTA","SHARAN","SHANIQUA","SHAE","SETSUKO","SERAFINA","SANDEE","ROSAMARIA","PRISCILA","OLINDA","NADENE","MUOI","MICHELINA","MERCEDEZ","MARYROSE","MARIN","MARCENE","MAO","MAGALI","MAFALDA","LOGAN","LINN","LANNIE","KAYCE","KAROLINE","KAMILAH","KAMALA","JUSTA","JOLINE","JENNINE","JACQUETTA","IRAIDA","GERALD","GEORGEANNA","FRANCHESCA","FAIRY","EMELINE","ELANE","EHTEL","EARLIE","DULCIE","DALENE","CRIS","CLASSIE","CHERE","CHARIS","CAROYLN","CARMINA","CARITA","BRIAN","BETHANIE","AYAKO","ARICA","AN","ALYSA","ALESSANDRA","AKILAH","ADRIEN","ZETTA","YOULANDA","YELENA","YAHAIRA","XUAN","WENDOLYN","VICTOR","TIJUANA","TERRELL","TERINA","TERESIA","SUZI","SUNDAY","SHERELL","SHAVONDA","SHAUNTE","SHARDA","SHAKITA","SENA","RYANN","RUBI","RIVA","REGINIA","REA","RACHAL","PARTHENIA","PAMULA","MONNIE","MONET","MICHAELE","MELIA","MARINE","MALKA","MAISHA","LISANDRA","LEO","LEKISHA","LEAN","LAURENCE","LAKENDRA","KRYSTIN","KORTNEY","KIZZIE","KITTIE","KERA","KENDAL","KEMBERLY","KANISHA","JULENE","JULE","JOSHUA","JOHANNE","JEFFREY","JAMEE","HAN","HALLEY","GIDGET","GALINA","FREDRICKA","FLETA","FATIMAH","EUSEBIA","ELZA","ELEONORE","DORTHEY","DORIA","DONELLA","DINORAH","DELORSE","CLARETHA","CHRISTINIA","CHARLYN","BONG","BELKIS","AZZIE","ANDERA","AIKO","ADENA","YER","YAJAIRA","WAN","VANIA","ULRIKE","TOSHIA","TIFANY","STEFANY","SHIZUE","SHENIKA","SHAWANNA","SHAROLYN","SHARILYN","SHAQUANA","SHANTAY","SEE","ROZANNE","ROSELEE","RICKIE","REMONA","REANNA","RAELENE","QUINN","PHUNG","PETRONILA","NATACHA","NANCEY","MYRL","MIYOKO","MIESHA","MERIDETH","MARVELLA","MARQUITTA","MARHTA","MARCHELLE","LIZETH","LIBBIE","LAHOMA","LADAWN","KINA","KATHELEEN","KATHARYN","KARISA","KALEIGH","JUNIE","JULIEANN","JOHNSIE","JANEAN","JAIMEE","JACKQUELINE","HISAKO","HERMA","HELAINE","GWYNETH","GLENN","GITA","EUSTOLIA","EMELINA","ELIN","EDRIS","DONNETTE","DONNETTA","DIERDRE","DENAE","DARCEL","CLAUDE","CLARISA","CINDERELLA","CHIA","CHARLESETTA","CHARITA","CELSA","CASSY","CASSI","CARLEE","BRUNA","BRITTANEY","BRANDE","BILLI","BAO","ANTONETTA","ANGLA","ANGELYN","ANALISA","ALANE","WENONA","WENDIE","VERONIQUE","VANNESA","TOBIE","TEMPIE","SUMIKO","SULEMA","SPARKLE","SOMER","SHEBA","SHAYNE","SHARICE","SHANEL","SHALON","SAGE","ROY","ROSIO","ROSELIA","RENAY","REMA","REENA","PORSCHE","PING","PEG","OZIE","ORETHA","ORALEE","ODA","NU","NGAN","NAKESHA","MILLY","MARYBELLE","MARLIN","MARIS","MARGRETT","MARAGARET","MANIE","LURLENE","LILLIA","LIESELOTTE","LAVELLE","LASHAUNDA","LAKEESHA","KEITH","KAYCEE","KALYN","JOYA","JOETTE","JENAE","JANIECE","ILLA","GRISEL","GLAYDS","GENEVIE","GALA","FREDDA","FRED","ELMER","ELEONOR","DEBERA","DEANDREA","DAN","CORRINNE","CORDIA","CONTESSA","COLENE","CLEOTILDE","CHARLOTT","CHANTAY","CECILLE","BEATRIS","AZALEE","ARLEAN","ARDATH","ANJELICA","ANJA","ALFREDIA","ALEISHA","ADAM","ZADA","YUONNE","XIAO","WILLODEAN","WHITLEY","VENNIE","VANNA","TYISHA","TOVA","TORIE","TONISHA","TILDA","TIEN","TEMPLE","SIRENA","SHERRIL","SHANTI","SHAN","SENAIDA","SAMELLA","ROBBYN","RENDA","REITA","PHEBE","PAULITA","NOBUKO","NGUYET","NEOMI","MOON","MIKAELA","MELANIA","MAXIMINA","MARG","MAISIE","LYNNA","LILLI","LAYNE","LASHAUN","LAKENYA","LAEL","KIRSTIE","KATHLINE","KASHA","KARLYN","KARIMA","JOVAN","JOSEFINE","JENNELL","JACQUI","JACKELYN","HYO","HIEN","GRAZYNA","FLORRIE","FLORIA","ELEONORA","DWANA","DORLA","DONG","DELMY","DEJA","DEDE","DANN","CRYSTA","CLELIA","CLARIS","CLARENCE","CHIEKO","CHERLYN","CHERELLE","CHARMAIN","CHARA","CAMMY","BEE","ARNETTE","ARDELLE","ANNIKA","AMIEE","AMEE","ALLENA","YVONE","YUKI","YOSHIE","YEVETTE","YAEL","WILLETTA","VONCILE","VENETTA","TULA","TONETTE","TIMIKA","TEMIKA","TELMA","TEISHA","TAREN","TA","STACEE","SHIN","SHAWNTA","SATURNINA","RICARDA","POK","PASTY","ONIE","NUBIA","MORA","MIKE","MARIELLE","MARIELLA","MARIANELA","MARDELL","MANY","LUANNA","LOISE","LISABETH","LINDSY","LILLIANA","LILLIAM","LELAH","LEIGHA","LEANORA","LANG","KRISTEEN","KHALILAH","KEELEY","KANDRA","JUNKO","JOAQUINA","JERLENE","JANI","JAMIKA","JAME","HSIU","HERMILA","GOLDEN","GENEVIVE","EVIA","EUGENA","EMMALINE","ELFREDA","ELENE","DONETTE","DELCIE","DEEANNA","DARCEY","CUC","CLARINDA","CIRA","CHAE","CELINDA","CATHERYN","CATHERIN","CASIMIRA","CARMELIA","CAMELLIA","BREANA","BOBETTE","BERNARDINA","BEBE","BASILIA","ARLYNE","AMAL","ALAYNA","ZONIA","ZENIA","YURIKO","YAEKO","WYNELL","WILLOW","WILLENA","VERNIA","TU","TRAVIS","TORA","TERRILYN","TERICA","TENESHA","TAWNA","TAJUANA","TAINA","STEPHNIE","SONA","SOL","SINA","SHONDRA","SHIZUKO","SHERLENE","SHERICE","SHARIKA","ROSSIE","ROSENA","RORY","RIMA","RIA","RHEBA","RENNA","PETER","NATALYA","NANCEE","MELODI","MEDA","MAXIMA","MATHA","MARKETTA","MARICRUZ","MARCELENE","MALVINA","LUBA","LOUETTA","LEIDA","LECIA","LAURAN","LASHAWNA","LAINE","KHADIJAH","KATERINE","KASI","KALLIE","JULIETTA","JESUSITA","JESTINE","JESSIA","JEREMY","JEFFIE","JANYCE","ISADORA","GEORGIANNE","FIDELIA","EVITA","EURA","EULAH","ESTEFANA","ELSY","ELIZABET","ELADIA","DODIE","DION","DIA","DENISSE","DELORAS","DELILA","DAYSI","DAKOTA","CURTIS","CRYSTLE","CONCHA","COLBY","CLARETTA","CHU","CHRISTIA","CHARLSIE","CHARLENA","CARYLON","BETTYANN","ASLEY","ASHLEA","AMIRA","AI","AGUEDA","AGNUS","YUETTE","VINITA","VICTORINA","TYNISHA","TREENA","TOCCARA","TISH","THOMASENA","TEGAN","SOILA","SHILOH","SHENNA","SHARMAINE","SHANTAE","SHANDI","SEPTEMBER","SARAN","SARAI","SANA","SAMUEL","SALLEY","ROSETTE","ROLANDE","REGINE","OTELIA","OSCAR","OLEVIA","NICHOLLE","NECOLE","NAIDA","MYRTA","MYESHA","MITSUE","MINTA","MERTIE","MARGY","MAHALIA","MADALENE","LOVE","LOURA","LOREAN","LEWIS","LESHA","LEONIDA","LENITA","LAVONE","LASHELL","LASHANDRA","LAMONICA","KIMBRA","KATHERINA","KARRY","KANESHA","JULIO","JONG","JENEVA","JAQUELYN","HWA","GILMA","GHISLAINE","GERTRUDIS","FRANSISCA","FERMINA","ETTIE","ETSUKO","ELLIS","ELLAN","ELIDIA","EDRA","DORETHEA","DOREATHA","DENYSE","DENNY","DEETTA","DAINE","CYRSTAL","CORRIN","CAYLA","CARLITA","CAMILA","BURMA","BULA","BUENA","BLAKE","BARABARA","AVRIL","AUSTIN","ALAINE","ZANA","WILHEMINA","WANETTA","VIRGIL","VI","VERONIKA","VERNON","VERLINE","VASILIKI","TONITA","TISA","TEOFILA","TAYNA","TAUNYA","TANDRA","TAKAKO","SUNNI","SUANNE","SIXTA","SHARELL","SEEMA","RUSSELL","ROSENDA","ROBENA","RAYMONDE","PEI","PAMILA","OZELL","NEIDA","NEELY","MISTIE","MICHA","MERISSA","MAURITA","MARYLN","MARYETTA","MARSHALL","MARCELL","MALENA","MAKEDA","MADDIE","LOVETTA","LOURIE","LORRINE","LORILEE","LESTER","LAURENA","LASHAY","LARRAINE","LAREE","LACRESHA","KRISTLE","KRISHNA","KEVA","KEIRA","KAROLE","JOIE","JINNY","JEANNETTA","JAMA","HEIDY","GILBERTE","GEMA","FAVIOLA","EVELYNN","ENDA","ELLI","ELLENA","DIVINA","DAGNY","COLLENE","CODI","CINDIE","CHASSIDY","CHASIDY","CATRICE","CATHERINA","CASSEY","CAROLL","CARLENA","CANDRA","CALISTA","BRYANNA","BRITTENY","BEULA","BARI","AUDRIE","AUDRIA","ARDELIA","ANNELLE","ANGILA","ALONA","ALLYN","DOUGLAS","ROGER","JONATHAN","RALPH","NICHOLAS","BENJAMIN","BRUCE","HARRY","WAYNE","STEVE","HOWARD","ERNEST","PHILLIP","TODD","CRAIG","ALAN","PHILIP","EARL","DANNY","BRYAN","STANLEY","LEONARD","NATHAN","MANUEL","RODNEY","MARVIN","VINCENT","JEFFERY","JEFF","CHAD","JACOB","ALFRED","BRADLEY","HERBERT","FREDERICK","EDWIN","DON","RICKY","RANDALL","BARRY","BERNARD","LEROY","MARCUS","THEODORE","CLIFFORD","MIGUEL","JIM","TOM","CALVIN","BILL","LLOYD","DEREK","WARREN","DARRELL","JEROME","FLOYD","ALVIN","TIM","GORDON","GREG","JORGE","DUSTIN","PEDRO","DERRICK","ZACHARY","HERMAN","GLEN","HECTOR","RICARDO","RICK","BRENT","RAMON","GILBERT","MARC","REGINALD","RUBEN","NATHANIEL","RAFAEL","EDGAR","MILTON","RAUL","BEN","CHESTER","DUANE","FRANKLIN","BRAD","RON","ROLAND","ARNOLD","HARVEY","JARED","ERIK","DARRYL","NEIL","JAVIER","FERNANDO","CLINTON","TED","MATHEW","TYRONE","DARREN","LANCE","KURT","ALLAN","NELSON","GUY","CLAYTON","HUGH","MAX","DWAYNE","DWIGHT","ARMANDO","FELIX","EVERETT","IAN","WALLACE","KEN","BOB","ALFREDO","ALBERTO","DAVE","IVAN","BYRON","ISAAC","MORRIS","CLIFTON","WILLARD","ROSS","ANDY","SALVADOR","KIRK","SERGIO","SETH","KENT","TERRANCE","EDUARDO","TERRENCE","ENRIQUE","WADE","STUART","FREDRICK","ARTURO","ALEJANDRO","NICK","LUTHER","WENDELL","JEREMIAH","JULIUS","OTIS","TREVOR","OLIVER","LUKE","HOMER","GERARD","DOUG","KENNY","HUBERT","LYLE","MATT","ALFONSO","ORLANDO","REX","CARLTON","ERNESTO","NEAL","PABLO","LORENZO","OMAR","WILBUR","GRANT","HORACE","RODERICK","ABRAHAM","WILLIS","RICKEY","ANDRES","CESAR","JOHNATHAN","MALCOLM","RUDOLPH","DAMON","KELVIN","PRESTON","ALTON","ARCHIE","MARCO","WM","PETE","RANDOLPH","GARRY","GEOFFREY","JONATHON","FELIPE","GERARDO","ED","DOMINIC","DELBERT","COLIN","GUILLERMO","EARNEST","LUCAS","BENNY","SPENCER","RODOLFO","MYRON","EDMUND","GARRETT","SALVATORE","CEDRIC","LOWELL","GREGG","SHERMAN","WILSON","SYLVESTER","ROOSEVELT","ISRAEL","JERMAINE","FORREST","WILBERT","LELAND","SIMON","CLARK","IRVING","BRYANT","OWEN","RUFUS","WOODROW","KRISTOPHER","MACK","LEVI","MARCOS","GUSTAVO","JAKE","LIONEL","GILBERTO","CLINT","NICOLAS","ISMAEL","ORVILLE","ERVIN","DEWEY","AL","WILFRED","JOSH","HUGO","IGNACIO","CALEB","TOMAS","SHELDON","ERICK","STEWART","DOYLE","DARREL","ROGELIO","TERENCE","SANTIAGO","ALONZO","ELIAS","BERT","ELBERT","RAMIRO","CONRAD","NOAH","GRADY","PHIL","CORNELIUS","LAMAR","ROLANDO","CLAY","PERCY","DEXTER","BRADFORD","DARIN","AMOS","MOSES","IRVIN","SAUL","ROMAN","RANDAL","TIMMY","DARRIN","WINSTON","BRENDAN","ABEL","DOMINICK","BOYD","EMILIO","ELIJAH","DOMINGO","EMMETT","MARLON","EMANUEL","JERALD","EDMOND","EMIL","DEWAYNE","WILL","OTTO","TEDDY","REYNALDO","BRET","JESS","TRENT","HUMBERTO","EMMANUEL","STEPHAN","VICENTE","LAMONT","GARLAND","MILES","EFRAIN","HEATH","RODGER","HARLEY","ETHAN","ELDON","ROCKY","PIERRE","JUNIOR","FREDDY","ELI","BRYCE","ANTOINE","STERLING","CHASE","GROVER","ELTON","CLEVELAND","DYLAN","CHUCK","DAMIAN","REUBEN","STAN","AUGUST","LEONARDO","JASPER","RUSSEL","ERWIN","BENITO","HANS","MONTE","BLAINE","ERNIE","CURT","QUENTIN","AGUSTIN","MURRAY","JAMAL","ADOLFO","HARRISON","TYSON","BURTON","BRADY","ELLIOTT","WILFREDO","BART","JARROD","VANCE","DENIS","DAMIEN","JOAQUIN","HARLAN","DESMOND","ELLIOT","DARWIN","GREGORIO","BUDDY","XAVIER","KERMIT","ROSCOE","ESTEBAN","ANTON","SOLOMON","SCOTTY","NORBERT","ELVIN","WILLIAMS","NOLAN","ROD","QUINTON","HAL","BRAIN","ROB","ELWOOD","KENDRICK","DARIUS","MOISES","FIDEL","THADDEUS","CLIFF","MARCEL","JACKSON","RAPHAEL","BRYON","ARMAND","ALVARO","JEFFRY","DANE","JOESPH","THURMAN","NED","RUSTY","MONTY","FABIAN","REGGIE","MASON","GRAHAM","ISAIAH","VAUGHN","GUS","LOYD","DIEGO","ADOLPH","NORRIS","MILLARD","ROCCO","GONZALO","DERICK","RODRIGO","WILEY","RIGOBERTO","ALPHONSO","TY","NOE","VERN","REED","JEFFERSON","ELVIS","BERNARDO","MAURICIO","HIRAM","DONOVAN","BASIL","RILEY","NICKOLAS","MAYNARD","SCOT","VINCE","QUINCY","EDDY","SEBASTIAN","FEDERICO","ULYSSES","HERIBERTO","DONNELL","COLE","DAVIS","GAVIN","EMERY","WARD","ROMEO","JAYSON","DANTE","CLEMENT","COY","MAXWELL","JARVIS","BRUNO","ISSAC","DUDLEY","BROCK","SANFORD","CARMELO","BARNEY","NESTOR","STEFAN","DONNY","ART","LINWOOD","BEAU","WELDON","GALEN","ISIDRO","TRUMAN","DELMAR","JOHNATHON","SILAS","FREDERIC","DICK","IRWIN","MERLIN","CHARLEY","MARCELINO","HARRIS","CARLO","TRENTON","KURTIS","HUNTER","AURELIO","WINFRED","VITO","COLLIN","DENVER","CARTER","LEONEL","EMORY","PASQUALE","MOHAMMAD","MARIANO","DANIAL","LANDON","DIRK","BRANDEN","ADAN","BUFORD","GERMAN","WILMER","EMERSON","ZACHERY","FLETCHER","JACQUES","ERROL","DALTON","MONROE","JOSUE","EDWARDO","BOOKER","WILFORD","SONNY","SHELTON","CARSON","THERON","RAYMUNDO","DAREN","HOUSTON","ROBBY","LINCOLN","GENARO","BENNETT","OCTAVIO","CORNELL","HUNG","ARRON","ANTONY","HERSCHEL","GIOVANNI","GARTH","CYRUS","CYRIL","RONNY","LON","FREEMAN","DUNCAN","KENNITH","CARMINE","ERICH","CHADWICK","WILBURN","RUSS","REID","MYLES","ANDERSON","MORTON","JONAS","FOREST","MITCHEL","MERVIN","ZANE","RICH","JAMEL","LAZARO","ALPHONSE","RANDELL","MAJOR","JARRETT","BROOKS","ABDUL","LUCIANO","SEYMOUR","EUGENIO","MOHAMMED","VALENTIN","CHANCE","ARNULFO","LUCIEN","FERDINAND","THAD","EZRA","ALDO","RUBIN","ROYAL","MITCH","EARLE","ABE","WYATT","MARQUIS","LANNY","KAREEM","JAMAR","BORIS","ISIAH","EMILE","ELMO","ARON","LEOPOLDO","EVERETTE","JOSEF","ELOY","RODRICK","REINALDO","LUCIO","JERROD","WESTON","HERSHEL","BARTON","PARKER","LEMUEL","BURT","JULES","GIL","ELISEO","AHMAD","NIGEL","EFREN","ANTWAN","ALDEN","MARGARITO","COLEMAN","DINO","OSVALDO","LES","DEANDRE","NORMAND","KIETH","TREY","NORBERTO","NAPOLEON","JEROLD","FRITZ","ROSENDO","MILFORD","CHRISTOPER","ALFONZO","LYMAN","JOSIAH","BRANT","WILTON","RICO","JAMAAL","DEWITT","BRENTON","OLIN","FOSTER","FAUSTINO","CLAUDIO","JUDSON","GINO","EDGARDO","ALEC","TANNER","JARRED","DONN","TAD","PRINCE","PORFIRIO","ODIS","LENARD","CHAUNCEY","TOD","MEL","MARCELO","KORY","AUGUSTUS","KEVEN","HILARIO","BUD","SAL","ORVAL","MAURO","ZACHARIAH","OLEN","ANIBAL","MILO","JED","DILLON","AMADO","NEWTON","LENNY","RICHIE","HORACIO","BRICE","MOHAMED","DELMER","DARIO","REYES","MAC","JONAH","JERROLD","ROBT","HANK","RUPERT","ROLLAND","KENTON","DAMION","ANTONE","WALDO","FREDRIC","BRADLY","KIP","BURL","WALKER","TYREE","JEFFEREY","AHMED","WILLY","STANFORD","OREN","NOBLE","MOSHE","MIKEL","ENOCH","BRENDON","QUINTIN","JAMISON","FLORENCIO","DARRICK","TOBIAS","HASSAN","GIUSEPPE","DEMARCUS","CLETUS","TYRELL","LYNDON","KEENAN","WERNER","GERALDO","COLUMBUS","CHET","BERTRAM","MARKUS","HUEY","HILTON","DWAIN","DONTE","TYRON","OMER","ISAIAS","HIPOLITO","FERMIN","ADALBERTO","BO","BARRETT","TEODORO","MCKINLEY","MAXIMO","GARFIELD","RALEIGH","LAWERENCE","ABRAM","RASHAD","KING","EMMITT","DARON","SAMUAL","MIQUEL","EUSEBIO","DOMENIC","DARRON","BUSTER","WILBER","RENATO","JC","HOYT","HAYWOOD","EZEKIEL","CHAS","FLORENTINO","ELROY","CLEMENTE","ARDEN","NEVILLE","EDISON","DESHAWN","NATHANIAL","JORDON","DANILO","CLAUD","SHERWOOD","RAYMON","RAYFORD","CRISTOBAL","AMBROSE","TITUS","HYMAN","FELTON","EZEQUIEL","ERASMO","STANTON","LONNY","LEN","IKE","MILAN","LINO","JAROD","HERB","ANDREAS","WALTON","RHETT","PALMER","DOUGLASS","CORDELL","OSWALDO","ELLSWORTH","VIRGILIO","TONEY","NATHANAEL","DEL","BENEDICT","MOSE","JOHNSON","ISREAL","GARRET","FAUSTO","ASA","ARLEN","ZACK","WARNER","MODESTO","FRANCESCO","MANUAL","GAYLORD","GASTON","FILIBERTO","DEANGELO","MICHALE","GRANVILLE","WES","MALIK","ZACKARY","TUAN","ELDRIDGE","CRISTOPHER","CORTEZ","ANTIONE","MALCOM","LONG","KOREY","JOSPEH","COLTON","WAYLON","VON","HOSEA","SHAD","SANTO","RUDOLF","ROLF","REY","RENALDO","MARCELLUS","LUCIUS","KRISTOFER","BOYCE","BENTON","HAYDEN","HARLAND","ARNOLDO","RUEBEN","LEANDRO","KRAIG","JERRELL","JEROMY","HOBERT","CEDRICK","ARLIE","WINFORD","WALLY","LUIGI","KENETH","JACINTO","GRAIG","FRANKLYN","EDMUNDO","SID","PORTER","LEIF","JERAMY","BUCK","WILLIAN","VINCENZO","SHON","LYNWOOD","JERE","HAI","ELDEN","DORSEY","DARELL","BRODERICK","ALONSO" diff --git a/extra/project-euler/067/067.factor b/extra/project-euler/067/067.factor new file mode 100644 index 0000000000..a675a5635e --- /dev/null +++ b/extra/project-euler/067/067.factor @@ -0,0 +1,82 @@ +! Copyright (c) 2007 Samuel Tardieu, Aaron Schaefer. +! See http://factorcode.org/license.txt for BSD license. +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 + +! 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. + +! 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 (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 +! -------- + +! Propagate from bottom to top the longest cumulative path as is done in +! problem 18. + + lines [ " " split [ string>number ] map ] map ; + +PRIVATE> + +: euler067 ( -- answer ) + pyramid propagate-all first first ; + +! [ euler067 ] 100 ave-time +! 18 ms run / 0 ms GC time + + +! ALTERNATE SOLUTIONS +! ------------------- + + 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 diff --git a/extra/project-euler/067/triangle.txt b/extra/project-euler/067/triangle.txt new file mode 100644 index 0000000000..00f98e3eba --- /dev/null +++ b/extra/project-euler/067/triangle.txt @@ -0,0 +1,100 @@ +59 +73 41 +52 40 09 +26 53 06 34 +10 51 87 86 81 +61 95 66 57 25 68 +90 81 80 38 92 67 73 +30 28 51 76 81 18 75 44 +84 14 95 87 62 81 17 78 58 +21 46 71 58 02 79 62 39 31 09 +56 34 35 53 78 31 81 18 90 93 15 +78 53 04 21 84 93 32 13 97 11 37 51 +45 03 81 79 05 18 78 86 13 30 63 99 95 +39 87 96 28 03 38 42 17 82 87 58 07 22 57 +06 17 51 17 07 93 09 07 75 97 95 78 87 08 53 +67 66 59 60 88 99 94 65 55 77 55 34 27 53 78 28 +76 40 41 04 87 16 09 42 75 69 23 97 30 60 10 79 87 +12 10 44 26 21 36 32 84 98 60 13 12 36 16 63 31 91 35 +70 39 06 05 55 27 38 48 28 22 34 35 62 62 15 14 94 89 86 +66 56 68 84 96 21 34 34 34 81 62 40 65 54 62 05 98 03 02 60 +38 89 46 37 99 54 34 53 36 14 70 26 02 90 45 13 31 61 83 73 47 +36 10 63 96 60 49 41 05 37 42 14 58 84 93 96 17 09 43 05 43 06 59 +66 57 87 57 61 28 37 51 84 73 79 15 39 95 88 87 43 39 11 86 77 74 18 +54 42 05 79 30 49 99 73 46 37 50 02 45 09 54 52 27 95 27 65 19 45 26 45 +71 39 17 78 76 29 52 90 18 99 78 19 35 62 71 19 23 65 93 85 49 33 75 09 02 +33 24 47 61 60 55 32 88 57 55 91 54 46 57 07 77 98 52 80 99 24 25 46 78 79 05 +92 09 13 55 10 67 26 78 76 82 63 49 51 31 24 68 05 57 07 54 69 21 67 43 17 63 12 +24 59 06 08 98 74 66 26 61 60 13 03 09 09 24 30 71 08 88 70 72 70 29 90 11 82 41 34 +66 82 67 04 36 60 92 77 91 85 62 49 59 61 30 90 29 94 26 41 89 04 53 22 83 41 09 74 90 +48 28 26 37 28 52 77 26 51 32 18 98 79 36 62 13 17 08 19 54 89 29 73 68 42 14 08 16 70 37 +37 60 69 70 72 71 09 59 13 60 38 13 57 36 09 30 43 89 30 39 15 02 44 73 05 73 26 63 56 86 12 +55 55 85 50 62 99 84 77 28 85 03 21 27 22 19 26 82 69 54 04 13 07 85 14 01 15 70 59 89 95 10 19 +04 09 31 92 91 38 92 86 98 75 21 05 64 42 62 84 36 20 73 42 21 23 22 51 51 79 25 45 85 53 03 43 22 +75 63 02 49 14 12 89 14 60 78 92 16 44 82 38 30 72 11 46 52 90 27 08 65 78 03 85 41 57 79 39 52 33 48 +78 27 56 56 39 13 19 43 86 72 58 95 39 07 04 34 21 98 39 15 39 84 89 69 84 46 37 57 59 35 59 50 26 15 93 +42 89 36 27 78 91 24 11 17 41 05 94 07 69 51 96 03 96 47 90 90 45 91 20 50 56 10 32 36 49 04 53 85 92 25 65 +52 09 61 30 61 97 66 21 96 92 98 90 06 34 96 60 32 69 68 33 75 84 18 31 71 50 84 63 03 03 19 11 28 42 75 45 45 +61 31 61 68 96 34 49 39 05 71 76 59 62 67 06 47 96 99 34 21 32 47 52 07 71 60 42 72 94 56 82 83 84 40 94 87 82 46 +01 20 60 14 17 38 26 78 66 81 45 95 18 51 98 81 48 16 53 88 37 52 69 95 72 93 22 34 98 20 54 27 73 61 56 63 60 34 63 +93 42 94 83 47 61 27 51 79 79 45 01 44 73 31 70 83 42 88 25 53 51 30 15 65 94 80 44 61 84 12 77 02 62 02 65 94 42 14 94 +32 73 09 67 68 29 74 98 10 19 85 48 38 31 85 67 53 93 93 77 47 67 39 72 94 53 18 43 77 40 78 32 29 59 24 06 02 83 50 60 66 +32 01 44 30 16 51 15 81 98 15 10 62 86 79 50 62 45 60 70 38 31 85 65 61 64 06 69 84 14 22 56 43 09 48 66 69 83 91 60 40 36 61 +92 48 22 99 15 95 64 43 01 16 94 02 99 19 17 69 11 58 97 56 89 31 77 45 67 96 12 73 08 20 36 47 81 44 50 64 68 85 40 81 85 52 09 +91 35 92 45 32 84 62 15 19 64 21 66 06 01 52 80 62 59 12 25 88 28 91 50 40 16 22 99 92 79 87 51 21 77 74 77 07 42 38 42 74 83 02 05 +46 19 77 66 24 18 05 32 02 84 31 99 92 58 96 72 91 36 62 99 55 29 53 42 12 37 26 58 89 50 66 19 82 75 12 48 24 87 91 85 02 07 03 76 86 +99 98 84 93 07 17 33 61 92 20 66 60 24 66 40 30 67 05 37 29 24 96 03 27 70 62 13 04 45 47 59 88 43 20 66 15 46 92 30 04 71 66 78 70 53 99 +67 60 38 06 88 04 17 72 10 99 71 07 42 25 54 05 26 64 91 50 45 71 06 30 67 48 69 82 08 56 80 67 18 46 66 63 01 20 08 80 47 07 91 16 03 79 87 +18 54 78 49 80 48 77 40 68 23 60 88 58 80 33 57 11 69 55 53 64 02 94 49 60 92 16 35 81 21 82 96 25 24 96 18 02 05 49 03 50 77 06 32 84 27 18 38 +68 01 50 04 03 21 42 94 53 24 89 05 92 26 52 36 68 11 85 01 04 42 02 45 15 06 50 04 53 73 25 74 81 88 98 21 67 84 79 97 99 20 95 04 40 46 02 58 87 +94 10 02 78 88 52 21 03 88 60 06 53 49 71 20 91 12 65 07 49 21 22 11 41 58 99 36 16 09 48 17 24 52 36 23 15 72 16 84 56 02 99 43 76 81 71 29 39 49 17 +64 39 59 84 86 16 17 66 03 09 43 06 64 18 63 29 68 06 23 07 87 14 26 35 17 12 98 41 53 64 78 18 98 27 28 84 80 67 75 62 10 11 76 90 54 10 05 54 41 39 66 +43 83 18 37 32 31 52 29 95 47 08 76 35 11 04 53 35 43 34 10 52 57 12 36 20 39 40 55 78 44 07 31 38 26 08 15 56 88 86 01 52 62 10 24 32 05 60 65 53 28 57 99 +03 50 03 52 07 73 49 92 66 80 01 46 08 67 25 36 73 93 07 42 25 53 13 96 76 83 87 90 54 89 78 22 78 91 73 51 69 09 79 94 83 53 09 40 69 62 10 79 49 47 03 81 30 +71 54 73 33 51 76 59 54 79 37 56 45 84 17 62 21 98 69 41 95 65 24 39 37 62 03 24 48 54 64 46 82 71 78 33 67 09 16 96 68 52 74 79 68 32 21 13 78 96 60 09 69 20 36 +73 26 21 44 46 38 17 83 65 98 07 23 52 46 61 97 33 13 60 31 70 15 36 77 31 58 56 93 75 68 21 36 69 53 90 75 25 82 39 50 65 94 29 30 11 33 11 13 96 02 56 47 07 49 02 +76 46 73 30 10 20 60 70 14 56 34 26 37 39 48 24 55 76 84 91 39 86 95 61 50 14 53 93 64 67 37 31 10 84 42 70 48 20 10 72 60 61 84 79 69 65 99 73 89 25 85 48 92 56 97 16 +03 14 80 27 22 30 44 27 67 75 79 32 51 54 81 29 65 14 19 04 13 82 04 91 43 40 12 52 29 99 07 76 60 25 01 07 61 71 37 92 40 47 99 66 57 01 43 44 22 40 53 53 09 69 26 81 07 +49 80 56 90 93 87 47 13 75 28 87 23 72 79 32 18 27 20 28 10 37 59 21 18 70 04 79 96 03 31 45 71 81 06 14 18 17 05 31 50 92 79 23 47 09 39 47 91 43 54 69 47 42 95 62 46 32 85 +37 18 62 85 87 28 64 05 77 51 47 26 30 65 05 70 65 75 59 80 42 52 25 20 44 10 92 17 71 95 52 14 77 13 24 55 11 65 26 91 01 30 63 15 49 48 41 17 67 47 03 68 20 90 98 32 04 40 68 +90 51 58 60 06 55 23 68 05 19 76 94 82 36 96 43 38 90 87 28 33 83 05 17 70 83 96 93 06 04 78 47 80 06 23 84 75 23 87 72 99 14 50 98 92 38 90 64 61 58 76 94 36 66 87 80 51 35 61 38 +57 95 64 06 53 36 82 51 40 33 47 14 07 98 78 65 39 58 53 06 50 53 04 69 40 68 36 69 75 78 75 60 03 32 39 24 74 47 26 90 13 40 44 71 90 76 51 24 36 50 25 45 70 80 61 80 61 43 90 64 11 +18 29 86 56 68 42 79 10 42 44 30 12 96 18 23 18 52 59 02 99 67 46 60 86 43 38 55 17 44 93 42 21 55 14 47 34 55 16 49 24 23 29 96 51 55 10 46 53 27 92 27 46 63 57 30 65 43 27 21 20 24 83 +81 72 93 19 69 52 48 01 13 83 92 69 20 48 69 59 20 62 05 42 28 89 90 99 32 72 84 17 08 87 36 03 60 31 36 36 81 26 97 36 48 54 56 56 27 16 91 08 23 11 87 99 33 47 02 14 44 73 70 99 43 35 33 +90 56 61 86 56 12 70 59 63 32 01 15 81 47 71 76 95 32 65 80 54 70 34 51 40 45 33 04 64 55 78 68 88 47 31 47 68 87 03 84 23 44 89 72 35 08 31 76 63 26 90 85 96 67 65 91 19 14 17 86 04 71 32 95 +37 13 04 22 64 37 37 28 56 62 86 33 07 37 10 44 52 82 52 06 19 52 57 75 90 26 91 24 06 21 14 67 76 30 46 14 35 89 89 41 03 64 56 97 87 63 22 34 03 79 17 45 11 53 25 56 96 61 23 18 63 31 37 37 47 +77 23 26 70 72 76 77 04 28 64 71 69 14 85 96 54 95 48 06 62 99 83 86 77 97 75 71 66 30 19 57 90 33 01 60 61 14 12 90 99 32 77 56 41 18 14 87 49 10 14 90 64 18 50 21 74 14 16 88 05 45 73 82 47 74 44 +22 97 41 13 34 31 54 61 56 94 03 24 59 27 98 77 04 09 37 40 12 26 87 09 71 70 07 18 64 57 80 21 12 71 83 94 60 39 73 79 73 19 97 32 64 29 41 07 48 84 85 67 12 74 95 20 24 52 41 67 56 61 29 93 35 72 69 +72 23 63 66 01 11 07 30 52 56 95 16 65 26 83 90 50 74 60 18 16 48 43 77 37 11 99 98 30 94 91 26 62 73 45 12 87 73 47 27 01 88 66 99 21 41 95 80 02 53 23 32 61 48 32 43 43 83 14 66 95 91 19 81 80 67 25 88 +08 62 32 18 92 14 83 71 37 96 11 83 39 99 05 16 23 27 10 67 02 25 44 11 55 31 46 64 41 56 44 74 26 81 51 31 45 85 87 09 81 95 22 28 76 69 46 48 64 87 67 76 27 89 31 11 74 16 62 03 60 94 42 47 09 34 94 93 72 +56 18 90 18 42 17 42 32 14 86 06 53 33 95 99 35 29 15 44 20 49 59 25 54 34 59 84 21 23 54 35 90 78 16 93 13 37 88 54 19 86 67 68 55 66 84 65 42 98 37 87 56 33 28 58 38 28 38 66 27 52 21 81 15 08 22 97 32 85 27 +91 53 40 28 13 34 91 25 01 63 50 37 22 49 71 58 32 28 30 18 68 94 23 83 63 62 94 76 80 41 90 22 82 52 29 12 18 56 10 08 35 14 37 57 23 65 67 40 72 39 93 39 70 89 40 34 07 46 94 22 20 05 53 64 56 30 05 56 61 88 27 +23 95 11 12 37 69 68 24 66 10 87 70 43 50 75 07 62 41 83 58 95 93 89 79 45 39 02 22 05 22 95 43 62 11 68 29 17 40 26 44 25 71 87 16 70 85 19 25 59 94 90 41 41 80 61 70 55 60 84 33 95 76 42 63 15 09 03 40 38 12 03 32 +09 84 56 80 61 55 85 97 16 94 82 94 98 57 84 30 84 48 93 90 71 05 95 90 73 17 30 98 40 64 65 89 07 79 09 19 56 36 42 30 23 69 73 72 07 05 27 61 24 31 43 48 71 84 21 28 26 65 65 59 65 74 77 20 10 81 61 84 95 08 52 23 70 +47 81 28 09 98 51 67 64 35 51 59 36 92 82 77 65 80 24 72 53 22 07 27 10 21 28 30 22 48 82 80 48 56 20 14 43 18 25 50 95 90 31 77 08 09 48 44 80 90 22 93 45 82 17 13 96 25 26 08 73 34 99 06 49 24 06 83 51 40 14 15 10 25 01 +54 25 10 81 30 64 24 74 75 80 36 75 82 60 22 69 72 91 45 67 03 62 79 54 89 74 44 83 64 96 66 73 44 30 74 50 37 05 09 97 70 01 60 46 37 91 39 75 75 18 58 52 72 78 51 81 86 52 08 97 01 46 43 66 98 62 81 18 70 93 73 08 32 46 34 +96 80 82 07 59 71 92 53 19 20 88 66 03 26 26 10 24 27 50 82 94 73 63 08 51 33 22 45 19 13 58 33 90 15 22 50 36 13 55 06 35 47 82 52 33 61 36 27 28 46 98 14 73 20 73 32 16 26 80 53 47 66 76 38 94 45 02 01 22 52 47 96 64 58 52 39 +88 46 23 39 74 63 81 64 20 90 33 33 76 55 58 26 10 46 42 26 74 74 12 83 32 43 09 02 73 55 86 54 85 34 28 23 29 79 91 62 47 41 82 87 99 22 48 90 20 05 96 75 95 04 43 28 81 39 81 01 28 42 78 25 39 77 90 57 58 98 17 36 73 22 63 74 51 +29 39 74 94 95 78 64 24 38 86 63 87 93 06 70 92 22 16 80 64 29 52 20 27 23 50 14 13 87 15 72 96 81 22 08 49 72 30 70 24 79 31 16 64 59 21 89 34 96 91 48 76 43 53 88 01 57 80 23 81 90 79 58 01 80 87 17 99 86 90 72 63 32 69 14 28 88 69 +37 17 71 95 56 93 71 35 43 45 04 98 92 94 84 96 11 30 31 27 31 60 92 03 48 05 98 91 86 94 35 90 90 08 48 19 33 28 68 37 59 26 65 96 50 68 22 07 09 49 34 31 77 49 43 06 75 17 81 87 61 79 52 26 27 72 29 50 07 98 86 01 17 10 46 64 24 18 56 +51 30 25 94 88 85 79 91 40 33 63 84 49 67 98 92 15 26 75 19 82 05 18 78 65 93 61 48 91 43 59 41 70 51 22 15 92 81 67 91 46 98 11 11 65 31 66 10 98 65 83 21 05 56 05 98 73 67 46 74 69 34 08 30 05 52 07 98 32 95 30 94 65 50 24 63 28 81 99 57 +19 23 61 36 09 89 71 98 65 17 30 29 89 26 79 74 94 11 44 48 97 54 81 55 39 66 69 45 28 47 13 86 15 76 74 70 84 32 36 33 79 20 78 14 41 47 89 28 81 05 99 66 81 86 38 26 06 25 13 60 54 55 23 53 27 05 89 25 23 11 13 54 59 54 56 34 16 24 53 44 06 +13 40 57 72 21 15 60 08 04 19 11 98 34 45 09 97 86 71 03 15 56 19 15 44 97 31 90 04 87 87 76 08 12 30 24 62 84 28 12 85 82 53 99 52 13 94 06 65 97 86 09 50 94 68 69 74 30 67 87 94 63 07 78 27 80 36 69 41 06 92 32 78 37 82 30 05 18 87 99 72 19 99 +44 20 55 77 69 91 27 31 28 81 80 27 02 07 97 23 95 98 12 25 75 29 47 71 07 47 78 39 41 59 27 76 13 15 66 61 68 35 69 86 16 53 67 63 99 85 41 56 08 28 33 40 94 76 90 85 31 70 24 65 84 65 99 82 19 25 54 37 21 46 33 02 52 99 51 33 26 04 87 02 08 18 96 +54 42 61 45 91 06 64 79 80 82 32 16 83 63 42 49 19 78 65 97 40 42 14 61 49 34 04 18 25 98 59 30 82 72 26 88 54 36 21 75 03 88 99 53 46 51 55 78 22 94 34 40 68 87 84 25 30 76 25 08 92 84 42 61 40 38 09 99 40 23 29 39 46 55 10 90 35 84 56 70 63 23 91 39 +52 92 03 71 89 07 09 37 68 66 58 20 44 92 51 56 13 71 79 99 26 37 02 06 16 67 36 52 58 16 79 73 56 60 59 27 44 77 94 82 20 50 98 33 09 87 94 37 40 83 64 83 58 85 17 76 53 02 83 52 22 27 39 20 48 92 45 21 09 42 24 23 12 37 52 28 50 78 79 20 86 62 73 20 59 +54 96 80 15 91 90 99 70 10 09 58 90 93 50 81 99 54 38 36 10 30 11 35 84 16 45 82 18 11 97 36 43 96 79 97 65 40 48 23 19 17 31 64 52 65 65 37 32 65 76 99 79 34 65 79 27 55 33 03 01 33 27 61 28 66 08 04 70 49 46 48 83 01 45 19 96 13 81 14 21 31 79 93 85 50 05 +92 92 48 84 59 98 31 53 23 27 15 22 79 95 24 76 05 79 16 93 97 89 38 89 42 83 02 88 94 95 82 21 01 97 48 39 31 78 09 65 50 56 97 61 01 07 65 27 21 23 14 15 80 97 44 78 49 35 33 45 81 74 34 05 31 57 09 38 94 07 69 54 69 32 65 68 46 68 78 90 24 28 49 51 45 86 35 +41 63 89 76 87 31 86 09 46 14 87 82 22 29 47 16 13 10 70 72 82 95 48 64 58 43 13 75 42 69 21 12 67 13 64 85 58 23 98 09 37 76 05 22 31 12 66 50 29 99 86 72 45 25 10 28 19 06 90 43 29 31 67 79 46 25 74 14 97 35 76 37 65 46 23 82 06 22 30 76 93 66 94 17 96 13 20 72 +63 40 78 08 52 09 90 41 70 28 36 14 46 44 85 96 24 52 58 15 87 37 05 98 99 39 13 61 76 38 44 99 83 74 90 22 53 80 56 98 30 51 63 39 44 30 91 91 04 22 27 73 17 35 53 18 35 45 54 56 27 78 48 13 69 36 44 38 71 25 30 56 15 22 73 43 32 69 59 25 93 83 45 11 34 94 44 39 92 +12 36 56 88 13 96 16 12 55 54 11 47 19 78 17 17 68 81 77 51 42 55 99 85 66 27 81 79 93 42 65 61 69 74 14 01 18 56 12 01 58 37 91 22 42 66 83 25 19 04 96 41 25 45 18 69 96 88 36 93 10 12 98 32 44 83 83 04 72 91 04 27 73 07 34 37 71 60 59 31 01 54 54 44 96 93 83 36 04 45 +30 18 22 20 42 96 65 79 17 41 55 69 94 81 29 80 91 31 85 25 47 26 43 49 02 99 34 67 99 76 16 14 15 93 08 32 99 44 61 77 67 50 43 55 87 55 53 72 17 46 62 25 50 99 73 05 93 48 17 31 70 80 59 09 44 59 45 13 74 66 58 94 87 73 16 14 85 38 74 99 64 23 79 28 71 42 20 37 82 31 23 +51 96 39 65 46 71 56 13 29 68 53 86 45 33 51 49 12 91 21 21 76 85 02 17 98 15 46 12 60 21 88 30 92 83 44 59 42 50 27 88 46 86 94 73 45 54 23 24 14 10 94 21 20 34 23 51 04 83 99 75 90 63 60 16 22 33 83 70 11 32 10 50 29 30 83 46 11 05 31 17 86 42 49 01 44 63 28 60 07 78 95 40 +44 61 89 59 04 49 51 27 69 71 46 76 44 04 09 34 56 39 15 06 94 91 75 90 65 27 56 23 74 06 23 33 36 69 14 39 05 34 35 57 33 22 76 46 56 10 61 65 98 09 16 69 04 62 65 18 99 76 49 18 72 66 73 83 82 40 76 31 89 91 27 88 17 35 41 35 32 51 32 67 52 68 74 85 80 57 07 11 62 66 47 22 67 +65 37 19 97 26 17 16 24 24 17 50 37 64 82 24 36 32 11 68 34 69 31 32 89 79 93 96 68 49 90 14 23 04 04 67 99 81 74 70 74 36 96 68 09 64 39 88 35 54 89 96 58 66 27 88 97 32 14 06 35 78 20 71 06 85 66 57 02 58 91 72 05 29 56 73 48 86 52 09 93 22 57 79 42 12 01 31 68 17 59 63 76 07 77 +73 81 14 13 17 20 11 09 01 83 08 85 91 70 84 63 62 77 37 07 47 01 59 95 39 69 39 21 99 09 87 02 97 16 92 36 74 71 90 66 33 73 73 75 52 91 11 12 26 53 05 26 26 48 61 50 90 65 01 87 42 47 74 35 22 73 24 26 56 70 52 05 48 41 31 18 83 27 21 39 80 85 26 08 44 02 71 07 63 22 05 52 19 08 20 +17 25 21 11 72 93 33 49 64 23 53 82 03 13 91 65 85 02 40 05 42 31 77 42 05 36 06 54 04 58 07 76 87 83 25 57 66 12 74 33 85 37 74 32 20 69 03 97 91 68 82 44 19 14 89 28 85 85 80 53 34 87 58 98 88 78 48 65 98 40 11 57 10 67 70 81 60 79 74 72 97 59 79 47 30 20 54 80 89 91 14 05 33 36 79 39 +60 85 59 39 60 07 57 76 77 92 06 35 15 72 23 41 45 52 95 18 64 79 86 53 56 31 69 11 91 31 84 50 44 82 22 81 41 40 30 42 30 91 48 94 74 76 64 58 74 25 96 57 14 19 03 99 28 83 15 75 99 01 89 85 79 50 03 95 32 67 44 08 07 41 62 64 29 20 14 76 26 55 48 71 69 66 19 72 44 25 14 01 48 74 12 98 07 +64 66 84 24 18 16 27 48 20 14 47 69 30 86 48 40 23 16 61 21 51 50 26 47 35 33 91 28 78 64 43 68 04 79 51 08 19 60 52 95 06 68 46 86 35 97 27 58 04 65 30 58 99 12 12 75 91 39 50 31 42 64 70 04 46 07 98 73 98 93 37 89 77 91 64 71 64 65 66 21 78 62 81 74 42 20 83 70 73 95 78 45 92 27 34 53 71 15 +30 11 85 31 34 71 13 48 05 14 44 03 19 67 23 73 19 57 06 90 94 72 57 69 81 62 59 68 88 57 55 69 49 13 07 87 97 80 89 05 71 05 05 26 38 40 16 62 45 99 18 38 98 24 21 26 62 74 69 04 85 57 77 35 58 67 91 79 79 57 86 28 66 34 72 51 76 78 36 95 63 90 08 78 47 63 45 31 22 70 52 48 79 94 15 77 61 67 68 +23 33 44 81 80 92 93 75 94 88 23 61 39 76 22 03 28 94 32 06 49 65 41 34 18 23 08 47 62 60 03 63 33 13 80 52 31 54 73 43 70 26 16 69 57 87 83 31 03 93 70 81 47 95 77 44 29 68 39 51 56 59 63 07 25 70 07 77 43 53 64 03 94 42 95 39 18 01 66 21 16 97 20 50 90 16 70 10 95 69 29 06 25 61 41 26 15 59 63 35 diff --git a/extra/project-euler/134/134.factor b/extra/project-euler/134/134.factor new file mode 100644 index 0000000000..55f8a8dab8 --- /dev/null +++ b/extra/project-euler/134/134.factor @@ -0,0 +1,42 @@ +! Copyright (c) 2007 Samuel Tardieu. +! See http://factorcode.org/license.txt for BSD license. +USING: arrays kernel lazy-lists math.algebra math math.functions math.primes + math.ranges sequences ; +IN: project-euler.134 + +! http://projecteuler.net/index.php?section=problems&id=134 + +! DESCRIPTION +! ----------- + +! Consider the consecutive primes p1 = 19 and p2 = 23. It can be +! verified that 1219 is the smallest number such that the last digits +! are formed by p1 whilst also being divisible by p2. + +! In fact, with the exception of p1 = 3 and p2 = 5, for every pair of +! consecutive primes, p2 p1, there exist values of n for which the last +! digits are formed by p1 and n is divisible by p2. Let S be the +! smallest of these values of n. + +! Find S for every pair of consecutive primes with 5 p1 1000000. + +! SOLUTION +! -------- + +! Compute the smallest power of 10 greater than m or equal to it +: next-power-of-10 ( m -- n ) + 10 swap log 10 log / ceiling >integer ^ ; foldable + +! Compute S for a given pair (p1, p2) -- that is the smallest positive +! number such that X = p1 [npt] and X = 0 [p2] (npt being the smallest +! power of 10 above p1) +: s ( p1 p2 -- s ) + over 0 2array rot next-power-of-10 rot 2array chinese-remainder ; + +: euler134 ( -- answer ) + 0 5 lprimes-from uncons [ 1000000 > ] luntil [ [ s + ] keep ] leach drop ; + +! [ euler134 ] 10 ave-time +! 3797 ms run / 30 ms GC ave time - 10 trials + +MAIN: euler134 diff --git a/extra/project-euler/169/169.factor b/extra/project-euler/169/169.factor new file mode 100644 index 0000000000..959715e4f9 --- /dev/null +++ b/extra/project-euler/169/169.factor @@ -0,0 +1,41 @@ +! Copyright (c) 2007 Samuel Tardieu. +! See http://factorcode.org/license.txt for BSD license. +IN: project-euler.169 +USING: combinators kernel math math.functions memoize ; + +! http://projecteuler.net/index.php?section=problems&id=169 + +! DESCRIPTION +! ----------- + +! Define f(0)=1 and f(n) to be the number of different ways n can be +! expressed as a sum of integer powers of 2 using each power no more +! than twice. + +! For example, f(10)=5 since there are five different ways to express 10: + +! 1 + 1 + 8 +! 1 + 1 + 4 + 4 +! 1 + 1 + 2 + 2 + 4 +! 2 + 4 + 4 +! 2 + 8 + +! What is f(1025)? + +! SOLUTION +! -------- + +MEMO: fn ( n -- x ) + { + { [ dup 2 < ] [ drop 1 ] } + { [ dup odd? ] [ 2/ fn ] } + { [ t ] [ 2/ [ fn ] keep 1- fn + ] } + } cond ; + +: euler169 ( -- result ) + 10 25 ^ fn ; + +! [ euler169 ] 100 ave-time +! 0 ms run / 0 ms GC ave time - 100 trials + +MAIN: euler169 diff --git a/extra/project-euler/173/173.factor b/extra/project-euler/173/173.factor new file mode 100644 index 0000000000..4eef3ec3e2 --- /dev/null +++ b/extra/project-euler/173/173.factor @@ -0,0 +1,34 @@ +! Copyright (c) 2007 Aaron Schaefer. +! See http://factorcode.org/license.txt for BSD license. +USING: kernel math math.functions math.ranges sequences ; +IN: project-euler.173 + +! http://projecteuler.net/index.php?section=problems&id=173 + +! DESCRIPTION +! ----------- + +! We shall define a square lamina to be a square outline with a square +! "hole" so that the shape possesses vertical and horizontal +! symmetry. For example, using exactly thirty-two square tiles we can +! form two different square laminae: [see URL for figure] + +! With one-hundred tiles, and not necessarily using all of the tiles at +! one time, it is possible to form forty-one different square laminae. + +! Using up to one million tiles how many different square laminae can be +! formed? + +! SOLUTION +! -------- + +: laminaes ( upper -- n ) + 4 / dup sqrt [1,b] 0 rot [ over /mod drop - - ] curry reduce ; + +: euler173 ( -- answer ) + 1000000 laminaes ; + +! [ euler173 ] 100 ave-time +! 0 ms run / 0 ms GC ave time - 100 trials + +MAIN: euler173 diff --git a/extra/project-euler/175/175.factor b/extra/project-euler/175/175.factor new file mode 100644 index 0000000000..db1760c017 --- /dev/null +++ b/extra/project-euler/175/175.factor @@ -0,0 +1,54 @@ +! Copyright (c) 2007 Samuel Tardieu. +! See http://factorcode.org/license.txt for BSD license. +USING: combinators kernel math math.parser math.ranges sequences vectors ; +IN: project-euler.175 + +! http://projecteuler.net/index.php?section=problems&id=175 + +! DESCRIPTION +! ----------- + +! Define f(0)=1 and f(n) to be the number of ways to write n as a sum of +! powers of 2 where no power occurs more than twice. + +! For example, f(10)=5 since there are five different ways to express +! 10: 10 = 8+2 = 8+1+1 = 4+4+2 = 4+2+2+1+1 = 4+4+1+1 + +! It can be shown that for every fraction p/q (p0, q0) there exists at +! least one integer n such that f(n)/f(n-1)=p/q. + +! For instance, the smallest n for which f(n)/f(n-1)=13/17 is 241. The +! binary expansion of 241 is 11110001. Reading this binary number from +! the most significant bit to the least significant bit there are 4 +! one's, 3 zeroes and 1 one. We shall call the string 4,3,1 the +! Shortened Binary Expansion of 241. + +! Find the Shortened Binary Expansion of the smallest n for which +! f(n)/f(n-1)=123456789/987654321. + +! Give your answer as comma separated integers, without any whitespaces. + +! SOLUTION +! -------- + +: add-bits ( vec n b -- ) + over zero? [ + 3drop + ] [ + pick length 1 bitand = [ over pop + ] when swap push + ] if ; + +: compute ( vec ratio -- ) + { + { [ dup integer? ] [ 1- 0 add-bits ] } + { [ dup 1 < ] [ 1 over - / dupd compute 1 1 add-bits ] } + { [ t ] [ [ 1 mod compute ] 2keep >integer 0 add-bits ] } + } cond ; + +: euler175 ( -- result ) + V{ 1 } clone dup 123456789/987654321 compute [ number>string ] map "," join ; + +! [ euler175 ] 100 ave-time +! 0 ms run / 0 ms GC ave time - 100 trials + +MAIN: euler175 diff --git a/extra/project-euler/ave-time/ave-time.factor b/extra/project-euler/ave-time/ave-time.factor index d481b30c84..b908dbd7b0 100644 --- a/extra/project-euler/ave-time/ave-time.factor +++ b/extra/project-euler/ave-time/ave-time.factor @@ -1,23 +1,21 @@ ! Copyright (c) 2007 Aaron Schaefer ! See http://factorcode.org/license.txt for BSD license. -USING: arrays effects inference io kernel math math.functions math.parser +USING: arrays combinators io kernel math math.functions math.parser math.statistics namespaces sequences tools.time ; IN: project-euler.ave-time : collect-benchmarks ( quot n -- seq ) - [ - 1- [ [ benchmark ] keep -rot 2array , [ clean-stack ] keep ] times - ] curry { } make >r benchmark 2array r> swap add ; inline + [ + >r >r datastack r> [ benchmark 2array , ] curry tuck + [ with-datastack drop ] 2curry r> swap times call + ] { } make ; : ave-time ( quot n -- ) [ collect-benchmarks ] keep swap ave-benchmarks [ diff --git a/extra/project-euler/common/common.factor b/extra/project-euler/common/common.factor index 73de3a7208..2e18d744fc 100644 --- a/extra/project-euler/common/common.factor +++ b/extra/project-euler/common/common.factor @@ -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> ; + 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 * ; diff --git a/extra/project-euler/project-euler.factor b/extra/project-euler/project-euler.factor index c35101785a..250a92b953 100644 --- a/extra/project-euler/project-euler.factor +++ b/extra/project-euler/project-euler.factor @@ -1,11 +1,13 @@ ! Copyright (c) 2007 Aaron Schaefer. ! See http://factorcode.org/license.txt for BSD license. -USING: io io.files kernel math.parser namespaces sequences strings - vocabs vocabs.loader system project-euler.ave-time +USING: definitions io io.files kernel math.parser sequences vocabs + vocabs.loader project-euler.ave-time project-euler.common math 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.013 project-euler.014 project-euler.015 project-euler.016 + 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 number ; : number>euler ( n -- str ) - number>string string>digits 3 0 pad-left [ number>string ] map concat ; + number>string 3 CHAR: 0 pad-left ; -: solution-path ( n -- str ) - number>euler dup [ - "project-euler" vocab-root ?resource-path % - os "windows" = [ - "\\project-euler\\" % % "\\" % % ".factor" % - ] [ - "/project-euler/" % % "/" % % ".factor" % - ] if - ] "" make ; +: solution-path ( n -- str/f ) + number>euler "project-euler." swap append + vocab where dup [ first ?resource-path ] when ; PRIVATE> : problem-solved? ( n -- ? ) - solution-path exists? ; + solution-path ; : run-project-euler ( -- ) problem-prompt dup problem-solved? [ dup number>euler "project-euler." swap append run - "Answer: " swap number>string append print + "Answer: " swap dup number? [ number>string ] when append print "Source: " swap solution-path append print ] [ drop "That problem has not been solved yet..." print diff --git a/extra/rss/rss-tests.factor b/extra/rss/rss-tests.factor index 18aa8440b9..68a40704b3 100644 --- a/extra/rss/rss-tests.factor +++ b/extra/rss/rss-tests.factor @@ -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 diff --git a/extra/rss/rss.factor b/extra/rss/rss.factor index cfb1c903e8..39018a9912 100644 --- a/extra/rss/rss.factor +++ b/extra/rss/rss.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2006 Chris Double, Daniel Ehrenberg. ! See http://factorcode.org/license.txt for BSD license. IN: rss -USING: xml.utilities kernel assocs +USING: xml.utilities kernel assocs xml.generator strings sequences xml.data xml.writer io.streams.string combinators xml xml.entities io.files io http.client namespaces xml.generator hashtables ; diff --git a/extra/sequences/deep/authors.txt b/extra/sequences/deep/authors.txt new file mode 100644 index 0000000000..f990dd0ed2 --- /dev/null +++ b/extra/sequences/deep/authors.txt @@ -0,0 +1 @@ +Daniel Ehrenberg diff --git a/extra/sequences/deep/deep-docs.factor b/extra/sequences/deep/deep-docs.factor new file mode 100644 index 0000000000..7a27bbdc1d --- /dev/null +++ b/extra/sequences/deep/deep-docs.factor @@ -0,0 +1,29 @@ +USING: help.syntax help.markup sequences.deep ; + +HELP: deep-each +{ $values { "obj" "an object" } { "quot" "a quotation ( elt -- ) " } } +{ $description "Execute a quotation on each nested element of an object and its children, in preorder." } ; + +HELP: deep-map +{ $values { "obj" "an object" } { "quot" "a quotation ( elt -- newelt )" } { "newobj" "the mapped object" } } +{ $description "Execute a quotation on each nested element of an object and its children, in preorder. That is, the result of the execution of the quotation on the outer is used to map the inner elements." } ; + +HELP: deep-subset +{ $values { "obj" "an object" } { "quot" "a quotation ( elt -- ? )" } { "seq" "a sequence" } } +{ $description "Creates a sequence of sub-nodes in the object which satisfy the given quotation, in preorder. This includes the object itself, if it passes the quotation." } ; + +HELP: deep-find +{ $values { "obj" "an object" } { "quot" "a quotation ( elt -- ? )" } { "elt" "an element" } } +{ $description "Gets the first sub-node of the object, in preorder, which satisfies the quotation. If nothing satisifies it, it returns " { $link f } "." } ; + +HELP: deep-contains? +{ $values { "obj" "an object" } { "quot" "a quotation ( elt -- ? )" } { "?" "a boolean" } } +{ $description "Tests whether the given object or any subnode satisfies the given quotation." } ; + +HELP: flatten +{ $values { "obj" "an object" } { "seq" "a sequence" } } +{ $description "Creates a sequence of all of the leaf nodes (non-sequence nodes, but including strings and numbers) in the object." } ; + +HELP: deep-change-each +{ $values { "obj" "an object" } { "quot" "a quotation ( elt -- newelt )" } } +{ $description "Modifies each sub-node of an object in place, in preorder." } ; diff --git a/extra/sequences/deep/deep-tests.factor b/extra/sequences/deep/deep-tests.factor new file mode 100644 index 0000000000..9c02d52089 --- /dev/null +++ b/extra/sequences/deep/deep-tests.factor @@ -0,0 +1,25 @@ +USING: sequences.deep kernel tools.test strings math arrays +namespaces sequences ; + +[ [ "hello" 3 4 swap ] ] [ [ { "hello" V{ 3 4 } } swap ] flatten ] unit-test + +[ "foo" t ] [ { { "foo" } "bar" } [ string? ] deep-find* ] unit-test + +[ f f ] [ { { "foo" } "bar" } [ number? ] deep-find* ] unit-test + +[ { { "foo" } "bar" } t ] [ { { "foo" } "bar" } [ array? ] deep-find* ] unit-test + +: change-something ( seq -- newseq ) + dup array? [ "hi" add ] [ "hello" append ] if ; + +[ { { "heyhello" "hihello" } "hihello" } ] +[ "hey" 1array 1array [ change-something ] deep-map ] unit-test + +[ { { "heyhello" "hihello" } } ] +[ "hey" 1array 1array [ [ change-something ] deep-change-each ] keep ] unit-test + +[ t ] [ "foo" [ string? ] deep-contains? ] unit-test + +[ "foo" ] [ "foo" [ string? ] deep-find ] unit-test + +[ { { 1 2 } 1 2 } ] [ [ { 1 2 } [ , ] deep-each ] { } make ] unit-test diff --git a/extra/sequences/deep/deep.factor b/extra/sequences/deep/deep.factor new file mode 100644 index 0000000000..c55647bbcb --- /dev/null +++ b/extra/sequences/deep/deep.factor @@ -0,0 +1,43 @@ +! Copyright (C) 2007 Daniel Ehrenberg +! See http://factorcode.org/license.txt for BSD license. +USING: sequences kernel strings math ; +IN: sequences.deep + +! All traversal goes in postorder + +: branch? ( object -- ? ) + dup sequence? [ + dup string? swap number? or not + ] [ drop f ] if ; + +: deep-each ( obj quot -- ) + [ call ] 2keep over branch? + [ [ deep-each ] curry each ] [ 2drop ] if ; inline + +: deep-map ( obj quot -- newobj ) + [ call ] keep over branch? + [ [ deep-map ] curry map ] [ drop ] if ; inline + +: deep-subset ( obj quot -- seq ) + over >r + pusher >r deep-each r> + r> dup branch? [ like ] [ drop ] if ; inline + +: deep-find* ( obj quot -- elt ? ) + [ call ] 2keep rot [ drop t ] [ + over branch? [ + f -rot [ >r nip r> deep-find* ] curry find drop >boolean + ] [ 2drop f f ] if + ] if ; inline + +: deep-find ( obj quot -- elt ) deep-find* drop ; inline + +: deep-contains? ( obj quot -- ? ) deep-find* nip ; inline + +: deep-change-each ( obj quot -- ) + over branch? [ [ + [ call ] keep over >r deep-change-each r> + ] curry change-each ] [ 2drop ] if ; inline + +: flatten ( obj -- seq ) + [ branch? not ] deep-subset ; diff --git a/extra/sequences/deep/summary.txt b/extra/sequences/deep/summary.txt new file mode 100644 index 0000000000..60ad867782 --- /dev/null +++ b/extra/sequences/deep/summary.txt @@ -0,0 +1 @@ +Sequence/tree combinators like deep-map, deep-each, etc diff --git a/extra/sequences/lib/lib-tests.factor b/extra/sequences/lib/lib-tests.factor index 72cf9ad9c4..717f463c45 100644 --- a/extra/sequences/lib/lib-tests.factor +++ b/extra/sequences/lib/lib-tests.factor @@ -46,3 +46,10 @@ math.functions tools.test strings ; [ { { 0 0 } { 1 0 } { 0 1 } { 1 1 } } ] [ 2 2 exact-strings ] unit-test [ t ] [ "ab" 4 strings [ >string ] map "abab" swap member? ] unit-test [ { { } { 1 } { 2 } { 1 2 } } ] [ { 1 2 } power-set ] unit-test + +[ f ] [ { } ?first ] unit-test +[ f ] [ { } ?fourth ] unit-test +[ 1 ] [ { 1 2 3 } ?first ] unit-test +[ 2 ] [ { 1 2 3 } ?second ] unit-test +[ 3 ] [ { 1 2 3 } ?third ] unit-test +[ f ] [ { 1 2 3 } ?fourth ] unit-test diff --git a/extra/sequences/lib/lib.factor b/extra/sequences/lib/lib.factor index 269c22e811..1aefee7321 100755 --- a/extra/sequences/lib/lib.factor +++ b/extra/sequences/lib/lib.factor @@ -64,6 +64,10 @@ IN: sequences.lib : delete-random ( seq -- value ) [ length random ] keep [ nth ] 2keep delete-nth ; +: split-around ( seq quot -- before elem after ) + dupd find over [ "Element not found" throw ] unless + >r cut-slice 1 tail r> swap ; inline + : (map-until) ( quot pred -- quot ) [ dup ] swap 3compose [ [ drop t ] [ , f ] if ] compose [ find 2drop ] curry ; @@ -131,3 +135,8 @@ PRIVATE> : human-sort ( seq -- newseq ) [ dup [ digit? ] [ string>number ] cut-all ] { } map>assoc sort-values keys ; + +: ?first ( seq -- first/f ) 0 swap ?nth ; inline +: ?second ( seq -- second/f ) 1 swap ?nth ; inline +: ?third ( seq -- third/f ) 2 swap ?nth ; inline +: ?fourth ( seq -- fourth/f ) 3 swap ?nth ; inline diff --git a/extra/shufflers/shufflers-tests.factor b/extra/shufflers/shufflers-tests.factor index d59e18d0dc..5bcdab8068 100644 --- a/extra/shufflers/shufflers-tests.factor +++ b/extra/shufflers/shufflers-tests.factor @@ -1,7 +1,5 @@ USING: shufflers tools.test ; -[ { 1 1 0 0 1 0 } ] [ BIN: 010011 2 6 translate ] unit-test - SHUFFLE: abcd 4 [ ] [ 1 2 3 4 abcd- ] unit-test [ 1 2 1 2 ] [ 1 2 3 abc-abab ] unit-test diff --git a/extra/trees/authors.txt b/extra/trees/authors.txt index e9c193bac7..39c1f37d37 100644 --- a/extra/trees/authors.txt +++ b/extra/trees/authors.txt @@ -1 +1,2 @@ Alex Chapman +Daniel Ehrenberg diff --git a/extra/trees/avl/authors.txt b/extra/trees/avl/authors.txt new file mode 100644 index 0000000000..39c1f37d37 --- /dev/null +++ b/extra/trees/avl/authors.txt @@ -0,0 +1,2 @@ +Alex Chapman +Daniel Ehrenberg diff --git a/extra/trees/avl/avl-docs.factor b/extra/trees/avl/avl-docs.factor new file mode 100644 index 0000000000..12465eec98 --- /dev/null +++ b/extra/trees/avl/avl-docs.factor @@ -0,0 +1,27 @@ +USING: help.syntax help.markup trees.avl assocs ; + +HELP: AVL{ +{ $syntax "AVL{ { key value }... }" } +{ $values { "key" "a key" } { "value" "a value" } } +{ $description "Literal syntax for an AVL tree." } ; + +HELP: +{ $values { "tree" avl } } +{ $description "Creates an empty AVL tree" } ; + +HELP: >avl +{ $values { "assoc" assoc } { "avl" avl } } +{ $description "Converts any " { $link assoc } " into an AVL tree." } ; + +HELP: avl +{ $class-description "This is the class for AVL trees. These conform to the assoc protocol and have efficient (logarithmic time) storage and retrieval operations." } ; + +ARTICLE: { "avl" "intro" } "AVL trees" +"This is a library for AVL trees, with logarithmic time storage and retrieval operations. These trees conform to the assoc protocol." +{ $subsection avl } +{ $subsection } +{ $subsection >avl } +{ $subsection POSTPONE: AVL{ } ; + +IN: trees.avl +ABOUT: { "avl" "intro" } diff --git a/extra/trees/avl/avl-tests.factor b/extra/trees/avl/avl-tests.factor index aba97ad043..0964ea7e56 100644 --- a/extra/trees/avl/avl-tests.factor +++ b/extra/trees/avl/avl-tests.factor @@ -1,10 +1,34 @@ -USING: kernel tools.test trees trees.avl math random sequences ; +USING: kernel tools.test trees trees.avl math random sequences assocs ; IN: temporary -[ "key1" 0 "key2" 0 ] [ T{ avl-node T{ node f "key1" f f T{ avl-node T{ node f "key2" } 1 } } 2 } [ single-rotate ] go-left [ node-left dup node-key swap avl-node-balance ] keep dup node-key swap avl-node-balance ] unit-test -[ "key1" 0 "key2" 0 ] [ T{ avl-node T{ node f "key1" f f T{ avl-node T{ node f "key2" } 1 } } 2 } [ select-rotate ] go-left [ node-left dup node-key swap avl-node-balance ] keep dup node-key swap avl-node-balance ] unit-test -[ "key1" 0 "key2" 0 ] [ T{ avl-node T{ node f "key1" f T{ avl-node T{ node f "key2" } -1 } } -2 } [ single-rotate ] go-right [ node-right dup node-key swap avl-node-balance ] keep dup node-key swap avl-node-balance ] unit-test -[ "key1" 0 "key2" 0 ] [ T{ avl-node T{ node f "key1" f T{ avl-node T{ node f "key2" } -1 } } -2 } [ select-rotate ] go-right [ node-right dup node-key swap avl-node-balance ] keep dup node-key swap avl-node-balance ] unit-test +[ "key1" 0 "key2" 0 ] [ + T{ avl-node T{ node f "key1" f f T{ avl-node T{ node f "key2" } 1 } } 2 } + [ single-rotate ] go-left + [ node-left dup node-key swap avl-node-balance ] keep + dup node-key swap avl-node-balance +] unit-test + +[ "key1" 0 "key2" 0 ] [ + T{ avl-node T{ node f "key1" f f T{ avl-node T{ node f "key2" } 1 } } 2 } + [ select-rotate ] go-left + [ node-left dup node-key swap avl-node-balance ] keep + dup node-key swap avl-node-balance +] unit-test + +[ "key1" 0 "key2" 0 ] [ + T{ avl-node T{ node f "key1" f T{ avl-node T{ node f "key2" } -1 } } -2 } + [ single-rotate ] go-right + [ node-right dup node-key swap avl-node-balance ] keep + dup node-key swap avl-node-balance +] unit-test + +[ "key1" 0 "key2" 0 ] [ + T{ avl-node T{ node f "key1" f T{ avl-node T{ node f "key2" } -1 } } -2 } + [ select-rotate ] go-right + [ node-right dup node-key swap avl-node-balance ] keep + dup node-key swap avl-node-balance +] unit-test + [ "key1" -1 "key2" 0 "key3" 0 ] [ T{ avl-node T{ node f "key1" f f T{ avl-node T{ node f "key2" f @@ -61,77 +85,38 @@ IN: temporary [ node-left dup node-key swap avl-node-balance ] keep dup node-key swap avl-node-balance ] unit-test -! random testing uncovered this little bugger -[ t t ] [ f "d" T{ avl-node - T{ node f "e" f - T{ avl-node - T{ node f "b" f - T{ avl-node T{ node f "a" } 0 } - T{ avl-node T{ node f "c" f } 0 } - 0 } - 0 } - T{ avl-node T{ node f "f" } 0 } } - -1 } node-set dup valid-avl-node? nip swap valid-node? ] unit-test +[ "eight" ] [ + "seven" 7 pick set-at + "eight" 8 pick set-at "nine" 9 pick set-at + tree-root node-value +] unit-test -[ "eight" ] [ "seven" 7 pick tree-insert "eight" 8 pick tree-insert "nine" 9 pick tree-insert tree-root node-value ] unit-test -[ "another eight" ] [ "seven" 7 pick tree-set "eight" 8 pick tree-set "another eight" 8 pick tree-set 8 swap tree-get ] unit-test -! [ "seven" 7 pick tree-insert -[ t t ] [ 3 increasing-tree dup valid-avl-tree? swap valid-tree? ] unit-test -[ t t ] [ 9 increasing-tree dup valid-avl-tree? swap valid-tree? ] unit-test ! fails when tree growth isn't terminated after a rebalance -[ t t ] [ 10 increasing-tree dup valid-avl-tree? swap valid-tree? ] unit-test +[ "another eight" ] [ ! ERROR! + "seven" 7 pick set-at + "another eight" 8 pick set-at 8 swap at +] unit-test -[ t t ] [ 3 decreasing-tree dup valid-avl-tree? swap valid-tree? ] unit-test -[ t t ] [ 4 decreasing-tree dup valid-avl-tree? swap valid-tree? ] unit-test -[ t t ] [ 5 decreasing-tree dup valid-avl-tree? swap valid-tree? ] unit-test -[ t t ] [ 10 decreasing-tree dup valid-avl-tree? swap valid-tree? ] unit-test - -[ t t ] [ 5 random-tree dup valid-avl-tree? swap valid-tree? ] unit-test -[ t t ] [ 19 random-tree dup valid-avl-tree? swap valid-tree? ] unit-test -[ t t ] [ 30 random-tree dup valid-avl-tree? swap valid-tree? ] unit-test -[ t t ] [ 82 random-tree dup valid-avl-tree? swap valid-tree? ] unit-test -[ t t ] [ 100 random-tree dup valid-avl-tree? swap valid-tree? ] unit-test - -! borrowed from tests/bst.factor : test-tree ( -- tree ) - - "seven" 7 pick tree-insert - "nine" 9 pick tree-insert - "four" 4 pick tree-insert - "another four" 4 pick tree-insert - "replaced seven" 7 pick tree-set ; + AVL{ + { 7 "seven" } + { 9 "nine" } + { 4 "four" } + { 4 "replaced four" } + { 7 "replaced seven" } + } clone ; -! test tree-insert, tree-set, tree-get, tree-get*, and tree-get-all -[ "seven" ] [ "seven" 7 pick tree-insert 7 swap tree-get ] unit-test -[ "seven" t ] [ "seven" 7 pick tree-insert 7 swap tree-get* ] unit-test -[ f f ] [ "seven" 7 pick tree-insert 8 swap tree-get* ] unit-test -[ "seven" ] [ "seven" 7 pick tree-set 7 swap tree-get ] unit-test -[ "replacement" ] [ "seven" 7 pick tree-insert "replacement" 7 pick tree-set 7 swap tree-get ] unit-test -[ "nine" ] [ test-tree 9 swap tree-get ] unit-test -[ t ] [ test-tree 4 swap tree-get-all { "another four" "four" } sequence= ] unit-test -[ t ] [ test-tree 11 swap tree-get-all empty? ] unit-test -[ t ] [ test-tree 7 swap tree-get-all { "replaced seven" } sequence= ] unit-test - -! test tree-delete -[ f ] [ test-tree 9 over tree-delete 9 swap tree-get ] unit-test -[ "replaced seven" ] [ test-tree 9 over tree-delete 7 swap tree-get ] unit-test -[ f ] [ test-tree 4 over tree-delete-all 4 swap tree-get ] unit-test -[ "nine" ] [ test-tree 7 over tree-delete 4 over tree-delete 9 swap tree-get ] unit-test -[ "nine" ] [ test-tree 7 over tree-delete 4 over tree-delete-all 9 swap tree-get ] unit-test - -: test-random-deletions ( tree -- ? ) - #! deletes one node at random from the tree, checking avl and tree - #! properties after each deletion, until the tree is empty - dup stump? [ - drop t - ] [ - dup tree-keys random over tree-delete dup valid-avl-tree? over valid-tree? and [ - test-random-deletions - ] [ - dup print-tree - ] if - ] if ; - -[ t ] [ 5 random-tree test-random-deletions ] unit-test -[ t ] [ 30 random-tree test-random-deletions ] unit-test -[ t ] [ 100 random-tree test-random-deletions ] unit-test +! test set-at, at, at* +[ t ] [ test-tree avl? ] unit-test +[ "seven" ] [ "seven" 7 pick set-at 7 swap at ] unit-test +[ "seven" t ] [ "seven" 7 pick set-at 7 swap at* ] unit-test +[ f f ] [ "seven" 7 pick set-at 8 swap at* ] unit-test +[ "seven" ] [ "seven" 7 pick set-at 7 swap at ] unit-test +[ "replacement" ] [ "seven" 7 pick set-at "replacement" 7 pick set-at 7 swap at ] unit-test +[ "nine" ] [ test-tree 9 swap at ] unit-test +[ "replaced four" ] [ test-tree 4 swap at ] unit-test +[ "replaced seven" ] [ test-tree 7 swap at ] unit-test +! test delete-at--all errors! +[ f ] [ test-tree 9 over delete-at 9 swap at ] unit-test +[ "replaced seven" ] [ test-tree 9 over delete-at 7 swap at ] unit-test +[ "nine" ] [ test-tree 7 over delete-at 4 over delete-at 9 swap at ] unit-test diff --git a/extra/trees/avl/avl.factor b/extra/trees/avl/avl.factor index 654a078a23..0c4bf5af28 100644 --- a/extra/trees/avl/avl.factor +++ b/extra/trees/avl/avl.factor @@ -1,35 +1,20 @@ ! Copyright (C) 2007 Alex Chapman ! See http://factorcode.org/license.txt for BSD license. -USING: combinators kernel generic math math.functions math.parser namespaces io -sequences trees ; +USING: combinators kernel generic math math.functions math.parser +namespaces io prettyprint.backend sequences trees assocs parser ; IN: trees.avl -TUPLE: avl-tree ; +TUPLE: avl ; -: ( -- tree ) - avl-tree construct-empty over set-delegate ; +INSTANCE: avl assoc + +: ( -- tree ) + avl construct-empty over set-delegate ; TUPLE: avl-node balance ; -: ( value key -- node ) - 0 avl-node construct-boa tuck set-delegate ; - -M: avl-tree create-node ( value key tree -- node ) drop ; - -GENERIC: valid-avl-node? ( obj -- height valid? ) - -M: f valid-avl-node? ( f -- height valid? ) drop 0 t ; - -: check-balance ( node left-height right-height -- node height valid? ) - 2dup max 1+ >r swap - over avl-node-balance = r> swap ; - -M: avl-node valid-avl-node? ( node -- height valid? ) - #! check that this avl node has the right balance marked, and that it isn't unbalanced. - dup node-left valid-avl-node? >r over node-right valid-avl-node? >r - check-balance r> r> and and - rot avl-node-balance abs 2 < and ; - -: valid-avl-tree? ( tree -- valid? ) tree-root valid-avl-node? nip ; +: ( key value -- node ) + swap 0 avl-node construct-boa tuck set-delegate ; : change-balance ( node amount -- ) over avl-node-balance + swap set-avl-node-balance ; @@ -65,30 +50,25 @@ M: avl-node valid-avl-node? ( node -- height valid? ) { [ drop t ] [ t ] } ! balance is -1 or 1, tree is taller } cond ; -DEFER: avl-insert +DEFER: avl-set -: avl-set ( value key node -- node taller? ) +: avl-insert ( value key node -- node taller? ) + 2dup node-key key< left right ? [ + [ node-link avl-set ] keep swap + >r tuck set-node-link r> + [ dup current-side get change-balance balance-insert ] [ f ] if + ] with-side ; + +: (avl-set) ( value key node -- node taller? ) 2dup node-key key= [ -rot pick set-node-key over set-node-value f ] [ avl-insert ] if ; -: avl-insert-or-set ( value key node -- node taller? ) - "setting" get [ avl-set ] [ avl-insert ] if ; +: avl-set ( value key node -- node taller? ) + [ (avl-set) ] [ t ] if* ; -: (avl-insert) ( value key node -- node taller? ) - [ avl-insert-or-set ] [ t ] if* ; - -: avl-insert ( value key node -- node taller? ) - 2dup node-key key< left right ? [ - [ node-link (avl-insert) ] keep swap - >r tuck set-node-link r> [ dup current-side get change-balance balance-insert ] [ f ] if - ] with-side ; - -M: avl-node node-insert ( value key node -- node ) - [ f "setting" set avl-insert-or-set ] with-scope drop ; - -M: avl-node node-set ( value key node -- node ) - [ t "setting" set avl-insert-or-set ] with-scope drop ; +M: avl set-at ( value key node -- node ) + [ avl-set drop ] change-root ; : delete-select-rotate ( node -- node shorter? ) dup node+link avl-node-balance zero? [ @@ -114,7 +94,8 @@ M: avl-node node-set ( value key node -- node ) : avl-replace-with-extremity ( to-replace node -- node shorter? ) dup node-link [ - swapd avl-replace-with-extremity >r over set-node-link r> [ balance-delete ] [ f ] if + swapd avl-replace-with-extremity >r over set-node-link r> + [ balance-delete ] [ f ] if ] [ tuck copy-node-contents node+link t ] if* ; @@ -122,11 +103,8 @@ M: avl-node node-set ( value key node -- node ) : replace-with-a-child ( node -- node shorter? ) #! assumes that node is not a leaf, otherwise will recurse forever dup node-link [ - dupd [ avl-replace-with-extremity ] with-other-side >r over set-node-link r> [ - balance-delete - ] [ - f - ] if + dupd [ avl-replace-with-extremity ] with-other-side + >r over set-node-link r> [ balance-delete ] [ f ] if ] [ [ replace-with-a-child ] with-other-side ] if* ; @@ -137,7 +115,7 @@ M: avl-node node-set ( value key node -- node ) dup leaf? [ drop f t ] [ - random-side [ replace-with-a-child ] with-side ! random not necessary, just for fun + left [ replace-with-a-child ] with-side ] if ; GENERIC: avl-delete ( key node -- node shorter? deleted? ) @@ -145,30 +123,36 @@ GENERIC: avl-delete ( key node -- node shorter? deleted? ) M: f avl-delete ( key f -- f f f ) nip f f ; : (avl-delete) ( key node -- node shorter? deleted? ) - tuck node-link avl-delete >r >r over set-node-link r> [ balance-delete r> ] [ f r> ] if ; + tuck node-link avl-delete >r >r over set-node-link r> + [ balance-delete r> ] [ f r> ] if ; M: avl-node avl-delete ( key node -- node shorter? deleted? ) 2dup node-key key-side dup zero? [ drop nip avl-delete-node t ] [ - [ - (avl-delete) - ] with-side + [ (avl-delete) ] with-side ] if ; -M: avl-node node-delete ( key node -- node ) avl-delete 2drop ; +M: avl delete-at ( key node -- ) + [ avl-delete 2drop ] change-root ; -M: avl-node node-delete-all ( key node -- node ) - #! deletes until there are no more. not optimal. - dupd [ avl-delete nip ] with-scope [ - node-delete-all - ] [ - nip - ] if ; +M: avl new-assoc 2drop ; -M: avl-node print-node ( depth node -- ) - over 1+ over node-right print-node - over [ drop " " write ] each - dup avl-node-balance number>string write " " write dup node-key number>string print - >r 1+ r> node-left print-node ; +: >avl ( assoc -- avl ) + T{ avl T{ tree f f 0 } } assoc-clone-like ; +M: avl assoc-like + drop dup avl? [ >avl ] unless ; + +: AVL{ + \ } [ >avl ] parse-literal ; parsing + +M: avl pprint-delims drop \ AVL{ \ } ; + +! When tuple inheritance is used, the following lines won't be necessary +M: avl assoc-size tree-count ; +M: avl clear-assoc delegate clear-assoc ; +M: avl assoc-find >r tree-root r> find-node ; +M: avl clone dup assoc-clone-like ; +M: avl >pprint-sequence >alist ; +M: avl pprint-narrow? drop t ; diff --git a/extra/trees/avl/summary.txt b/extra/trees/avl/summary.txt new file mode 100644 index 0000000000..c2360c2ed3 --- /dev/null +++ b/extra/trees/avl/summary.txt @@ -0,0 +1 @@ +Balanced AVL trees diff --git a/extra/trees/binary/binary-tests.factor b/extra/trees/binary/binary-tests.factor deleted file mode 100644 index 7abf2f0da5..0000000000 --- a/extra/trees/binary/binary-tests.factor +++ /dev/null @@ -1,45 +0,0 @@ -USING: trees trees.binary tools.test kernel sequences ; -IN: temporary - -: test-tree ( -- tree ) - - "seven" 7 pick tree-insert - "nine" 9 pick tree-insert - "four" 4 pick tree-insert - "another four" 4 pick tree-insert - "replaced seven" 7 pick tree-set ; - -! test tree-insert, tree-set, tree-get, tree-get*, and tree-get-all -[ "seven" ] [ "seven" 7 pick tree-insert 7 swap tree-get ] unit-test -[ "seven" t ] [ "seven" 7 pick tree-insert 7 swap tree-get* ] unit-test -[ f f ] [ "seven" 7 pick tree-insert 8 swap tree-get* ] unit-test -[ "seven" ] [ "seven" 7 pick tree-set 7 swap tree-get ] unit-test -[ "replacement" ] [ "seven" 7 pick tree-insert "replacement" 7 pick tree-set 7 swap tree-get ] unit-test -[ "four" ] [ test-tree 4 swap tree-get ] unit-test -[ "nine" ] [ test-tree 9 swap tree-get ] unit-test -[ t ] [ test-tree 4 swap tree-get-all { "another four" "four" } sequence= ] unit-test -[ t ] [ test-tree 11 swap tree-get-all empty? ] unit-test -[ t ] [ test-tree 7 swap tree-get-all { "replaced seven" } sequence= ] unit-test - -! test tree-delete -[ f ] [ test-tree 9 over tree-delete 9 swap tree-get ] unit-test -[ "replaced seven" ] [ test-tree 9 over tree-delete 7 swap tree-get ] unit-test -[ "four" ] [ test-tree 9 over tree-delete 4 swap tree-get ] unit-test -! TODO: sometimes this shows up as "another four" because of randomisation -! [ "nine" "four" ] [ test-tree 7 over tree-delete 9 over tree-get 4 rot tree-get ] unit-test -! [ "another four" ] [ test-tree 4 over tree-delete 4 swap tree-get ] unit-test -[ f ] [ test-tree 4 over tree-delete-all 4 swap tree-get ] unit-test -[ "nine" ] [ test-tree 7 over tree-delete 4 over tree-delete 9 swap tree-get ] unit-test -[ "nine" ] [ test-tree 7 over tree-delete 4 over tree-delete-all 9 swap tree-get ] unit-test - -! test valid-node? -[ t ] [ T{ node f 0 } valid-node? ] unit-test -[ t ] [ T{ node f 0 f T{ node f -1 } } valid-node? ] unit-test -[ t ] [ T{ node f 0 f f T{ node f 1 } } valid-node? ] unit-test -[ t ] [ T{ node f 0 f T{ node f -1 } T{ node f 1 } } valid-node? ] unit-test -[ f ] [ T{ node f 0 f T{ node f 1 } } valid-node? ] unit-test -[ f ] [ T{ node f 0 f f T{ node f -1 } } valid-node? ] unit-test - -! random testing -[ t ] [ 10 random-tree valid-tree? ] unit-test - diff --git a/extra/trees/binary/binary.factor b/extra/trees/binary/binary.factor deleted file mode 100644 index 5fc7abc636..0000000000 --- a/extra/trees/binary/binary.factor +++ /dev/null @@ -1,88 +0,0 @@ -! Copyright (C) 2007 Alex Chapman -! See http://factorcode.org/license.txt for BSD license. -USING: kernel generic math trees ; -IN: trees.binary - -TUPLE: bst ; - -: ( -- tree ) bst construct-empty over set-delegate ; - -TUPLE: bst-node ; - -: ( value key -- node ) - bst-node construct-empty tuck set-delegate ; - -M: bst create-node ( value key tree -- node ) drop ; - -M: bst-node node-insert ( value key node -- node ) - 2dup node-key key-side [ - [ node-link [ node-insert ] [ ] if* ] keep tuck set-node-link - ] with-side ; - -M: bst-node node-set ( value key node -- node ) - 2dup node-key key-side dup 0 = [ - drop nip [ set-node-value ] keep - ] [ - [ [ node-link [ node-set ] [ ] if* ] keep tuck set-node-link ] with-side - ] if ; - -DEFER: delete-node - -: (prune-extremity) ( parent node -- new-extremity ) - dup node-link [ - rot drop (prune-extremity) - ] [ - tuck delete-node swap set-node-link - ] if* ; - -: prune-extremity ( node -- new-extremity ) - #! remove and return the leftmost or rightmost child of this node. - #! assumes at least one child - dup node-link (prune-extremity) ; - -: replace-with-child ( node -- node ) - dup dup node-link copy-node-contents dup node-link delete-node over set-node-link ; - -: replace-with-extremity ( node -- node ) - dup node-link dup node+link [ - ! predecessor/successor is not the immediate child - [ prune-extremity ] with-other-side dupd copy-node-contents - ] [ - ! node-link is the predecessor/successor - drop replace-with-child - ] if ; - -: delete-node-with-two-children ( node -- node ) - #! randomised to minimise tree unbalancing - random-side [ replace-with-extremity ] with-side ; - -: delete-node ( node -- node ) - #! delete this node, returning its replacement - dup node-left [ - dup node-right [ - delete-node-with-two-children - ] [ - node-left ! left but no right - ] if - ] [ - dup node-right [ - node-right ! right but not left - ] [ - drop f ! no children - ] if - ] if ; - -M: bst-node node-delete ( key node -- node ) - 2dup node-key key-side dup zero? [ - drop nip delete-node - ] [ - [ tuck node-link node-delete over set-node-link ] with-side - ] if ; - -M: bst-node node-delete-all ( key node -- node ) - 2dup node-key key-side dup zero? [ - drop delete-node node-delete-all - ] [ - [ tuck node-link node-delete-all over set-node-link ] with-side - ] if ; - diff --git a/extra/trees/splay/authors.txt b/extra/trees/splay/authors.txt index 09839c9c91..06a7cfb215 100644 --- a/extra/trees/splay/authors.txt +++ b/extra/trees/splay/authors.txt @@ -1 +1,2 @@ Mackenzie Straight +Daniel Ehrenberg diff --git a/extra/trees/splay/splay-docs.factor b/extra/trees/splay/splay-docs.factor new file mode 100644 index 0000000000..b621155e73 --- /dev/null +++ b/extra/trees/splay/splay-docs.factor @@ -0,0 +1,27 @@ +USING: help.syntax help.markup trees.splay assocs ; + +HELP: SPLAY{ +{ $syntax "SPLAY{ { key value }... }" } +{ $values { "key" "a key" } { "value" "a value" } } +{ $description "Literal syntax for an splay tree." } ; + +HELP: +{ $values { "tree" splay } } +{ $description "Creates an empty splay tree" } ; + +HELP: >splay +{ $values { "assoc" assoc } { "splay" splay } } +{ $description "Converts any " { $link assoc } " into an splay tree." } ; + +HELP: splay +{ $class-description "This is the class for splay trees. Splay trees have amortized average-case logarithmic time storage and retrieval operations, and better complexity on more skewed lookup distributions, though in bad situations they can degrade to linear time, resembling a linked list. These conform to the assoc protocol." } ; + +ARTICLE: { "splay" "intro" } "Splay trees" +"This is a library for splay trees. Splay trees have amortized average-case logarithmic time storage and retrieval operations, and better complexity on more skewed lookup distributions, though in bad situations they can degrade to linear time, resembling a linked list. These trees conform to the assoc protocol." +{ $subsection splay } +{ $subsection } +{ $subsection >splay } +{ $subsection POSTPONE: SPLAY{ } ; + +IN: trees.splay +ABOUT: { "splay" "intro" } diff --git a/extra/trees/splay/splay-tests.factor b/extra/trees/splay/splay-tests.factor index f3548947a8..eb2dafb1d2 100644 --- a/extra/trees/splay/splay-tests.factor +++ b/extra/trees/splay/splay-tests.factor @@ -8,7 +8,7 @@ IN: temporary 100 [ drop 100 random swap at drop ] curry* each ; : make-numeric-splay-tree ( n -- splay-tree ) - dup -rot [ pick set-at ] 2each ; + [ [ dupd set-at ] curry each ] keep ; [ t ] [ 100 make-numeric-splay-tree dup randomize-numeric-splay-tree @@ -18,10 +18,10 @@ IN: temporary [ 10 ] [ 10 make-numeric-splay-tree keys length ] unit-test [ 10 ] [ 10 make-numeric-splay-tree values length ] unit-test -[ f ] [ f 4 pick set-at 4 swap at ] unit-test +[ f ] [ f 4 pick set-at 4 swap at ] unit-test ! Ensure that f can be a value -[ t ] [ f 4 pick set-at 4 swap key? ] unit-test +[ t ] [ f 4 pick set-at 4 swap key? ] unit-test [ { { 1 "a" } { 2 "b" } { 3 "c" } { 4 "d" } { 5 "e" } { 6 "f" } } @@ -29,5 +29,5 @@ IN: temporary { { 4 "d" } { 5 "e" } { 6 "f" } { 1 "a" } { 2 "b" } { 3 "c" } -} >splay-tree >alist +} >splay >alist ] unit-test diff --git a/extra/trees/splay/splay.factor b/extra/trees/splay/splay.factor index 4249bbd564..5f7c50cfb2 100644 --- a/extra/trees/splay/splay.factor +++ b/extra/trees/splay/splay.factor @@ -1,59 +1,56 @@ ! Copyright (c) 2005 Mackenzie Straight. -! See http://factorcode.org/license.txt for BSD license. -USING: kernel math combinators assocs parser ; +! See http://factor.sf.net/license.txt for BSD license. +USING: arrays kernel math namespaces sequences assocs parser +prettyprint.backend trees generic ; IN: trees.splay -TUPLE: splay-tree r count ; -INSTANCE: splay-tree assoc +TUPLE: splay ; -: ( -- splay-tree ) - 0 { set-splay-tree-count } splay-tree construct ; +: ( -- splay-tree ) + \ splay construct-empty + over set-delegate ; - splay-node +INSTANCE: splay assoc : rotate-right ( node -- node ) - dup splay-node-l - [ splay-node-r swap set-splay-node-l ] 2keep - [ set-splay-node-r ] keep ; + dup node-left + [ node-right swap set-node-left ] 2keep + [ set-node-right ] keep ; : rotate-left ( node -- node ) - dup splay-node-r - [ splay-node-l swap set-splay-node-r ] 2keep - [ set-splay-node-l ] keep ; + dup node-right + [ node-left swap set-node-right ] 2keep + [ set-node-left ] keep ; : link-right ( left right key node -- left right key node ) - swap >r [ swap set-splay-node-l ] 2keep - nip dup splay-node-l r> swap ; + swap >r [ swap set-node-left ] 2keep + nip dup node-left r> swap ; : link-left ( left right key node -- left right key node ) - swap >r rot [ set-splay-node-r ] 2keep - drop dup splay-node-r swapd r> swap ; + swap >r rot [ set-node-right ] 2keep + drop dup node-right swapd r> swap ; : cmp ( key node -- obj node -1/0/1 ) - 2dup splay-node-k <=> ; + 2dup node-key <=> ; : lcmp ( key node -- obj node -1/0/1 ) - 2dup splay-node-l splay-node-k <=> ; + 2dup node-left node-key <=> ; : rcmp ( key node -- obj node -1/0/1 ) - 2dup splay-node-r splay-node-k <=> ; + 2dup node-right node-key <=> ; DEFER: (splay) : splay-left ( left right key node -- left right key node ) - dup splay-node-l [ + dup node-left [ lcmp 0 < [ rotate-right ] when - dup splay-node-l [ link-right (splay) ] when + dup node-left [ link-right (splay) ] when ] when ; : splay-right ( left right key node -- left right key node ) - dup splay-node-r [ + dup node-right [ rcmp 0 > [ rotate-left ] when - dup splay-node-r [ link-left (splay) ] when + dup node-right [ link-left (splay) ] when ] when ; : (splay) ( left right key node -- left right key node ) @@ -61,118 +58,96 @@ DEFER: (splay) [ drop splay-left ] [ 0 > [ splay-right ] when ] if ; : assemble ( head left right node -- root ) - [ splay-node-r swap set-splay-node-l ] keep - [ splay-node-l swap set-splay-node-r ] keep - [ swap splay-node-l swap set-splay-node-r ] 2keep - [ swap splay-node-r swap set-splay-node-l ] keep ; + [ node-right swap set-node-left ] keep + [ node-left swap set-node-right ] keep + [ swap node-left swap set-node-right ] 2keep + [ swap node-right swap set-node-left ] keep ; : splay-at ( key node -- node ) - >r >r T{ splay-node } clone dup dup r> r> + >r >r T{ node } clone dup dup r> r> (splay) nip assemble ; : splay ( key tree -- ) - [ splay-tree-r splay-at ] keep set-splay-tree-r ; + [ tree-root splay-at ] keep set-tree-root ; : splay-split ( key tree -- node node ) - 2dup splay splay-tree-r cmp 0 < [ - nip dup splay-node-l swap f over set-splay-node-l + 2dup splay tree-root cmp 0 < [ + nip dup node-left swap f over set-node-left ] [ - nip dup splay-node-r swap f over set-splay-node-r swap + nip dup node-right swap f over set-node-right swap ] if ; -: (get-splay) ( key tree -- node ? ) - 2dup splay splay-tree-r cmp 0 = [ +: get-splay ( key tree -- node ? ) + 2dup splay tree-root cmp 0 = [ nip t ] [ 2drop f f ] if ; : get-largest ( node -- node ) - dup [ dup splay-node-r [ nip get-largest ] when* ] when ; + dup [ dup node-right [ nip get-largest ] when* ] when ; : splay-largest - dup [ dup get-largest splay-node-k swap splay-at ] when ; + dup [ dup get-largest node-key swap splay-at ] when ; : splay-join ( n2 n1 -- node ) splay-largest [ - [ set-splay-node-r ] keep + [ set-node-right ] keep ] [ drop f ] if* ; -: (remove-splay) ( key tree -- ) - tuck (get-splay) nip [ - dup splay-tree-count 1- over set-splay-tree-count - dup splay-node-r swap splay-node-l splay-join - swap set-splay-tree-r +: remove-splay ( key tree -- ) + tuck get-splay nip [ + dup dec-count + dup node-right swap node-left splay-join + swap set-tree-root ] [ drop ] if* ; -: (set-splay) ( value key tree -- ) - 2dup (get-splay) [ 2nip set-splay-node-v ] [ - drop dup splay-tree-count 1+ over set-splay-tree-count +: set-splay ( value key tree -- ) + 2dup get-splay [ 2nip set-node-value ] [ + drop dup inc-count 2dup splay-split rot - >r r> set-splay-tree-r + >r >r swapd r> node construct-boa r> set-tree-root ] if ; : new-root ( value key tree -- ) - [ 1 swap set-splay-tree-count ] keep - >r f f r> set-splay-tree-r ; + [ 1 swap set-tree-count ] keep + >r swap r> set-tree-root ; -: splay-call ( splay-node call -- ) - >r [ splay-node-k ] keep splay-node-v r> call ; inline - -: (splay-tree-traverse) ( splay-node quot -- key value ? ) - { - { [ over not ] [ 2drop f f f ] } - { [ [ - >r splay-node-l r> (splay-tree-traverse) - ] 2keep rot ] - [ 2drop t ] } - { [ >r 2nip r> [ splay-call ] 2keep rot ] - [ drop [ splay-node-k ] keep splay-node-v t ] } - { [ t ] [ >r splay-node-r r> (splay-tree-traverse) ] } - } cond ; inline +M: splay set-at ( value key tree -- ) + dup tree-root [ set-splay ] [ new-root ] if ; -PRIVATE> - -M: splay-tree assoc-find ( splay-tree quot -- key value ? ) - #! quot: ( k v -- ? ) - #! Not tail recursive so will fail on large splay trees. - >r splay-tree-r r> (splay-tree-traverse) ; - -M: splay-tree set-at ( value key tree -- ) - dup splay-tree-r [ (set-splay) ] [ new-root ] if ; - -M: splay-tree at* ( key tree -- value ? ) - dup splay-tree-r [ - (get-splay) >r dup [ splay-node-v ] when r> +M: splay at* ( key tree -- value ? ) + dup tree-root [ + get-splay >r dup [ node-value ] when r> ] [ 2drop f f ] if ; -M: splay-tree delete-at ( key tree -- ) - dup splay-tree-r [ (remove-splay) ] [ 2drop ] if ; +M: splay delete-at ( key tree -- ) + dup tree-root [ remove-splay ] [ 2drop ] if ; -M: splay-tree new-assoc - 2drop ; +M: splay new-assoc + 2drop ; -: >splay-tree ( assoc -- splay-tree ) - T{ splay-tree f f 0 } assoc-clone-like ; +: >splay ( assoc -- splay-tree ) + T{ splay T{ tree f f 0 } } assoc-clone-like ; -: S{ - \ } [ >splay-tree ] parse-literal ; parsing +: SPLAY{ + \ } [ >splay ] parse-literal ; parsing -M: splay-tree assoc-like - drop dup splay-tree? [ >splay-tree ] unless ; +M: splay assoc-like + drop dup splay? [ + dup tree? [ tuck set-delegate ] [ >splay ] if + ] unless ; -M: splay-tree clear-assoc - 0 over set-splay-tree-count - f swap set-splay-tree-r ; +M: splay pprint-delims drop \ SPLAY{ \ } ; -M: splay-tree assoc-size - splay-tree-count ; - -USE: prettyprint.backend -M: splay-tree pprint-delims drop \ S{ \ } ; -M: splay-tree >pprint-sequence >alist ; -M: splay-tree pprint-narrow? drop t ; +! When tuple inheritance is used, the following lines won't be necessary +M: splay assoc-size tree-count ; +M: splay clear-assoc delegate clear-assoc ; +M: splay assoc-find >r tree-root r> find-node ; +M: splay clone dup assoc-clone-like ; +M: splay >pprint-sequence >alist ; +M: splay pprint-narrow? drop t ; diff --git a/extra/trees/summary.txt b/extra/trees/summary.txt index cf7b64c8a1..18ad35db8f 100644 --- a/extra/trees/summary.txt +++ b/extra/trees/summary.txt @@ -1 +1 @@ -Binary search and avl (balanced) trees +Binary search trees diff --git a/extra/trees/todo.txt b/extra/trees/todo.txt deleted file mode 100644 index 7eb295302a..0000000000 --- a/extra/trees/todo.txt +++ /dev/null @@ -1,2 +0,0 @@ -- Make trees.splay use the same tree protocol as trees.binary and trees.avl -- Make all trees follow the assoc protocol diff --git a/extra/trees/trees-docs.factor b/extra/trees/trees-docs.factor new file mode 100644 index 0000000000..12bae4bac5 --- /dev/null +++ b/extra/trees/trees-docs.factor @@ -0,0 +1,27 @@ +USING: help.syntax help.markup trees assocs ; + +HELP: TREE{ +{ $syntax "TREE{ { key value }... }" } +{ $values { "key" "a key" } { "value" "a value" } } +{ $description "Literal syntax for an unbalanced tree." } ; + +HELP: +{ $values { "tree" tree } } +{ $description "Creates an empty unbalanced binary tree" } ; + +HELP: >tree +{ $values { "assoc" assoc } { "tree" tree } } +{ $description "Converts any " { $link assoc } " into an unbalanced binary tree." } ; + +HELP: tree +{ $class-description "This is the class for unbalanced binary search trees. It is not usually intended to be used directly but rather as a basis for other trees." } ; + +ARTICLE: { "trees" "intro" } "Binary search trees" +"This is a library for unbalanced binary search trees. It is not intended to be used directly in most situations but rather as a base class for new trees, because performance can degrade to linear time storage/retrieval by the number of keys. These binary search trees conform to the assoc protocol." +{ $subsection tree } +{ $subsection } +{ $subsection >tree } +{ $subsection POSTPONE: TREE{ } ; + +IN: trees +ABOUT: { "trees" "intro" } diff --git a/extra/trees/trees-tests.factor b/extra/trees/trees-tests.factor new file mode 100644 index 0000000000..2795b0d5da --- /dev/null +++ b/extra/trees/trees-tests.factor @@ -0,0 +1,28 @@ +USING: trees assocs tools.test kernel sequences ; +IN: temporary + +: test-tree ( -- tree ) + TREE{ + { 7 "seven" } + { 9 "nine" } + { 4 "four" } + { 4 "replaced four" } + { 7 "replaced seven" } + } clone ; + +! test set-at, at, at* +[ "seven" ] [ "seven" 7 pick set-at 7 swap at ] unit-test +[ "seven" t ] [ "seven" 7 pick set-at 7 swap at* ] unit-test +[ f f ] [ "seven" 7 pick set-at 8 swap at* ] unit-test +[ "seven" ] [ "seven" 7 pick set-at 7 swap at ] unit-test +[ "replacement" ] [ "seven" 7 pick set-at "replacement" 7 pick set-at 7 swap at ] unit-test +[ "replaced four" ] [ test-tree 4 swap at ] unit-test +[ "nine" ] [ test-tree 9 swap at ] unit-test + +! test delete-at +[ f ] [ test-tree 9 over delete-at 9 swap at ] unit-test +[ "replaced seven" ] [ test-tree 9 over delete-at 7 swap at ] unit-test +[ "replaced four" ] [ test-tree 9 over delete-at 4 swap at ] unit-test +[ "nine" "replaced four" ] [ test-tree 7 over delete-at 9 over at 4 rot at ] unit-test +[ "nine" ] [ test-tree 7 over delete-at 4 over delete-at 9 swap at ] unit-test + diff --git a/extra/trees/trees.factor b/extra/trees/trees.factor index 0d49cb54d1..971c961cbc 100644 --- a/extra/trees/trees.factor +++ b/extra/trees/trees.factor @@ -1,17 +1,19 @@ ! Copyright (C) 2007 Alex Chapman ! See http://factorcode.org/license.txt for BSD license. -USING: kernel generic math math.parser sequences arrays io namespaces -namespaces.private random layouts ; +USING: kernel generic math sequences arrays io namespaces +prettyprint.private kernel.private assocs random combinators +parser prettyprint.backend ; IN: trees -TUPLE: tree root ; +TUPLE: tree root count ; +: ( -- tree ) + f 0 tree construct-boa ; -: ( -- tree ) tree construct-empty ; +INSTANCE: tree assoc TUPLE: node key value left right ; - -: ( value key -- node ) - swap f f node construct-boa ; +: ( key value -- node ) + f f node construct-boa ; SYMBOL: current-side @@ -20,28 +22,32 @@ SYMBOL: current-side : go-left? ( -- ? ) current-side get left = ; -: node-link@ ( -- ? quot quot ) go-left? [ node-left ] [ node-right ] ; inline -: set-node-link@ ( -- ? quot quot ) go-left? [ set-node-left ] [ set-node-right ] ; inline +: inc-count ( tree -- ) + dup tree-count 1+ swap set-tree-count ; -: node-link ( node -- child ) node-link@ if ; -: set-node-link ( child node -- ) set-node-link@ if ; -: node+link ( node -- child ) node-link@ swap if ; -: set-node+link ( child node -- ) set-node-link@ swap if ; +: dec-count ( tree -- ) + dup tree-count 1- swap set-tree-count ; -: with-side ( side quot -- ) H{ } clone >n swap current-side set call ndrop ; inline +: node-link@ ( node ? -- node ) + go-left? xor [ node-left ] [ node-right ] if ; +: set-node-link@ ( left parent ? -- ) + go-left? xor [ set-node-left ] [ set-node-right ] if ; + +: node-link ( node -- child ) f node-link@ ; +: set-node-link ( child node -- ) f set-node-link@ ; +: node+link ( node -- child ) t node-link@ ; +: set-node+link ( child node -- ) t set-node-link@ ; + +: with-side ( side quot -- ) [ swap current-side set call ] with-scope ; inline : with-other-side ( quot -- ) current-side get neg swap with-side ; inline : go-left ( quot -- ) left swap with-side ; inline : go-right ( quot -- ) right swap with-side ; inline -GENERIC: create-node ( value key tree -- node ) +: change-root ( tree quot -- ) + swap [ tree-root swap call ] keep set-tree-root ; inline -GENERIC: copy-node-contents ( new old -- ) - -M: node copy-node-contents ( new old -- ) - #! copy old's key and value into new (keeping children and parent) - dup node-key pick set-node-key node-value swap set-node-value ; - -M: tree create-node ( value key tree -- node ) drop ; +: leaf? ( node -- ? ) + dup node-left swap node-right or not ; : key-side ( k1 k2 -- side ) #! side is -1 if k1 < k2, 0 if they are equal, or 1 if k1 > k2 @@ -56,137 +62,143 @@ M: tree create-node ( value key tree -- node ) drop ; : choose-branch ( key node -- key node-left/right ) 2dup node-key key-side [ node-link ] with-side ; -GENERIC: node-get ( key node -- value ) +: node-at* ( key node -- value ? ) + [ + 2dup node-key key= [ + nip node-value t + ] [ + choose-branch node-at* + ] if + ] [ drop f f ] if* ; -: tree-get ( key tree -- value ) tree-root node-get ; +M: tree at* ( key tree -- value ? ) + tree-root node-at* ; -M: node node-get ( key node -- value ) - 2dup node-key key= [ - nip node-value +: node-set ( value key node -- node ) + 2dup node-key key-side dup zero? [ + drop nip [ set-node-value ] keep ] [ - choose-branch node-get + [ + [ node-link [ node-set ] [ swap ] if* ] keep + [ set-node-link ] keep + ] with-side ] if ; -M: f node-get ( key f -- f ) nip ; +M: tree set-at ( value key tree -- ) + [ [ node-set ] [ swap ] if* ] change-root ; -GENERIC: node-get* ( key node -- value ? ) - -: tree-get* ( key tree -- value ? ) tree-root node-get* ; - -M: node node-get* ( key node -- value ? ) - 2dup node-key key= [ - nip node-value t - ] [ - choose-branch node-get* - ] if ; - -M: f node-get* ( key f -- f f ) nip f ; - -GENERIC: node-get-all ( key node -- seq ) - -: tree-get-all ( key tree -- seq ) tree-root node-get-all ; - -M: f node-get-all ( key f -- V{} ) 2drop V{ } clone ; - -M: node node-get-all ( key node -- seq ) - 2dup node-key key= [ - ! duplicate keys are stored to the right because of choose-branch - 2dup node-right node-get-all >r nip node-value r> tuck push - ] [ - choose-branch node-get-all - ] if ; - -GENERIC: node-insert ( value key node -- node ) ! can add duplicates - -: tree-insert ( value key tree -- ) - [ dup tree-root [ nip node-insert ] [ create-node ] if* ] keep set-tree-root ; - -GENERIC: node-set ( value key node -- node ) - #! note that this only sets the first node with this key. if more than one - #! has been inserted then the others won't be modified. (should they be deleted?) - -: tree-set ( value key tree -- ) - [ dup tree-root [ nip node-set ] [ create-node ] if* ] keep set-tree-root ; - -GENERIC: node-delete ( key node -- node ) - -: tree-delete ( key tree -- ) - [ tree-root node-delete ] keep set-tree-root ; - -GENERIC: node-delete-all ( key node -- node ) - -M: f node-delete-all ( key f -- f ) nip ; - -: tree-delete-all ( key tree -- ) - [ tree-root node-delete-all ] keep set-tree-root ; - -: node-map-link ( node quot -- node ) - over node-link swap call over set-node-link ; - -: node-map ( node quot -- node ) - over [ - tuck [ node-map-link ] go-left over call swap [ node-map-link ] go-right - ] [ - drop - ] if ; - -: tree-map ( tree quot -- ) - #! apply quot to each element of the tree, in order - over tree-root swap node-map swap set-tree-root ; - -: node>node-seq ( node -- seq ) - dup [ - dup node-left node>node-seq over 1array rot node-right node>node-seq 3append - ] when ; - -: tree>node-seq ( tree -- seq ) - tree-root node>node-seq ; - -: tree-keys ( tree -- keys ) - tree>node-seq [ node-key ] map ; - -: tree-values ( tree -- values ) - tree>node-seq [ node-value ] map ; - -: leaf? ( node -- ? ) - dup node-left swap node-right or not ; - -GENERIC: valid-node? ( node -- ? ) - -M: f valid-node? ( f -- t ) not ; - -M: node valid-node? ( node -- ? ) - dup dup node-left [ node-key swap node-key key< ] when* >r - dup dup node-right [ node-key swap node-key key> ] when* r> and swap - dup node-left valid-node? swap node-right valid-node? and and ; +: valid-node? ( node -- ? ) + [ + dup dup node-left [ node-key swap node-key key< ] when* >r + dup dup node-right [ node-key swap node-key key> ] when* r> and swap + dup node-left valid-node? swap node-right valid-node? and and + ] [ t ] if* ; : valid-tree? ( tree -- ? ) tree-root valid-node? ; -DEFER: print-tree +: tree-call ( node call -- ) + >r [ node-key ] keep node-value r> call ; inline + +: find-node ( node quot -- key value ? ) + { + { [ over not ] [ 2drop f f f ] } + { [ [ + >r node-left r> find-node + ] 2keep rot ] + [ 2drop t ] } + { [ >r 2nip r> [ tree-call ] 2keep rot ] + [ drop [ node-key ] keep node-value t ] } + { [ t ] [ >r node-right r> find-node ] } + } cond ; inline -: random-tree ( tree size -- tree ) - [ most-positive-fixnum random pick tree-set ] each ; +M: tree assoc-find ( tree quot -- key value ? ) + >r tree-root r> find-node ; -: increasing-tree ( tree size -- tree ) - [ dup pick tree-set ] each ; +M: tree clear-assoc + 0 over set-tree-count + f swap set-tree-root ; -: decreasing-tree ( tree size -- tree ) - reverse increasing-tree ; +M: tree assoc-size + tree-count ; -GENERIC: print-node ( depth node -- ) +: copy-node-contents ( new old -- ) + dup node-key pick set-node-key node-value swap set-node-value ; -M: f print-node ( depth f -- ) 2drop ; +! Deletion +DEFER: delete-node -M: node print-node ( depth node -- ) - ! not pretty, but ok for debugging - over 1+ over node-right print-node - over [ drop " " write ] each dup node-key number>string print - >r 1+ r> node-left print-node ; +: (prune-extremity) ( parent node -- new-extremity ) + dup node-link [ + rot drop (prune-extremity) + ] [ + tuck delete-node swap set-node-link + ] if* ; -: print-tree ( tree -- ) - tree-root 1 swap print-node ; +: prune-extremity ( node -- new-extremity ) + #! remove and return the leftmost or rightmost child of this node. + #! assumes at least one child + dup node-link (prune-extremity) ; -: stump? ( tree -- ? ) - #! is this tree empty? - tree-root not ; +: replace-with-child ( node -- node ) + dup dup node-link copy-node-contents dup node-link delete-node over set-node-link ; +: replace-with-extremity ( node -- node ) + dup node-link dup node+link [ + ! predecessor/successor is not the immediate child + [ prune-extremity ] with-other-side dupd copy-node-contents + ] [ + ! node-link is the predecessor/successor + drop replace-with-child + ] if ; + +: delete-node-with-two-children ( node -- node ) + #! randomised to minimise tree unbalancing + random-side [ replace-with-extremity ] with-side ; + +: delete-node ( node -- node ) + #! delete this node, returning its replacement + dup node-left [ + dup node-right [ + delete-node-with-two-children + ] [ + node-left ! left but no right + ] if + ] [ + dup node-right [ + node-right ! right but not left + ] [ + drop f ! no children + ] if + ] if ; + +: delete-bst-node ( key node -- node ) + 2dup node-key key-side dup zero? [ + drop nip delete-node + ] [ + [ tuck node-link delete-bst-node over set-node-link ] with-side + ] if ; + +M: tree delete-at + [ delete-bst-node ] change-root ; + +M: tree new-assoc + 2drop ; + +M: tree clone dup assoc-clone-like ; + +: >tree ( assoc -- tree ) + T{ tree f f 0 } assoc-clone-like ; + +GENERIC: tree-assoc-like ( assoc -- tree ) +M: tuple tree-assoc-like ! will need changes for tuple inheritance + dup delegate dup tree? [ nip ] [ drop >tree ] if ; +M: tree tree-assoc-like ; +M: assoc tree-assoc-like >tree ; +M: tree assoc-like drop tree-assoc-like ; + +: TREE{ + \ } [ >tree ] parse-literal ; parsing + +M: tree pprint-delims drop \ TREE{ \ } ; +M: tree >pprint-sequence >alist ; +M: tree pprint-narrow? drop t ; diff --git a/extra/tuple-syntax/about.txt b/extra/tuple-syntax/about.txt new file mode 100644 index 0000000000..f243374925 --- /dev/null +++ b/extra/tuple-syntax/about.txt @@ -0,0 +1 @@ +Tuple literals with named slots diff --git a/extra/tuple-syntax/authors.txt b/extra/tuple-syntax/authors.txt new file mode 100644 index 0000000000..f990dd0ed2 --- /dev/null +++ b/extra/tuple-syntax/authors.txt @@ -0,0 +1 @@ +Daniel Ehrenberg diff --git a/extra/tuple-syntax/tags.txt b/extra/tuple-syntax/tags.txt new file mode 100644 index 0000000000..71c0ff7282 --- /dev/null +++ b/extra/tuple-syntax/tags.txt @@ -0,0 +1 @@ +syntax diff --git a/extra/tuple-syntax/tuple-syntax-docs.factor b/extra/tuple-syntax/tuple-syntax-docs.factor new file mode 100644 index 0000000000..7d4c12c0e9 --- /dev/null +++ b/extra/tuple-syntax/tuple-syntax-docs.factor @@ -0,0 +1,10 @@ +USING: help.markup help.syntax tuple-syntax ; + +HELP: TUPLE{ +{ $syntax "TUPLE{ class slot-name: value... }" } +{ $values { "class" "a tuple class word" } { "slot-name" "the name of a slot, without the tuple class name" } { "value" "the value for a slot" } } +{ $description "Marks the beginning of a literal tuple. Literal tuples are terminated by " { $link POSTPONE: } } ". The class word must be specified. Slots which aren't specified are set to f. If slot names are duplicated, the latest one is used." } +{ $see-also POSTPONE: T{ } ; + +IN: tuple-syntax +ABOUT: POSTPONE: TUPLE{ diff --git a/extra/tuple-syntax/tuple-syntax-tests.factor b/extra/tuple-syntax/tuple-syntax-tests.factor new file mode 100644 index 0000000000..b16c5b337d --- /dev/null +++ b/extra/tuple-syntax/tuple-syntax-tests.factor @@ -0,0 +1,7 @@ +USING: tools.test tuple-syntax ; + +TUPLE: foo bar baz ; + +[ T{ foo } ] [ TUPLE{ foo } ] unit-test +[ T{ foo 1 { 2 3 } { 4 { 5 } } } ] +[ TUPLE{ foo bar: { 2 3 } delegate: 1 baz: { 4 { 5 } } } ] unit-test diff --git a/extra/tuple-syntax/tuple-syntax.factor b/extra/tuple-syntax/tuple-syntax.factor new file mode 100644 index 0000000000..ddc90a8961 --- /dev/null +++ b/extra/tuple-syntax/tuple-syntax.factor @@ -0,0 +1,21 @@ +USING: kernel sequences slots parser words classes ; +IN: tuple-syntax + +! TUPLE: foo bar baz ; +! TUPLE{ foo bar: 1 baz: 2 } + +: parse-object ( -- object ) + scan-word dup parsing? [ V{ } clone swap execute first ] when ; + +: parse-slot-writer ( tuple -- slot-setter ) + scan dup "}" = [ 2drop f ] [ + 1 head* swap class "slots" word-prop + [ slot-spec-name = ] curry* find nip slot-spec-writer + ] if ; + +: parse-slots ( accum tuple -- accum tuple ) + dup parse-slot-writer + [ parse-object pick rot execute parse-slots ] when* ; + +: TUPLE{ + scan-word construct-empty parse-slots parsed ; parsing diff --git a/extra/xml/data/data.factor b/extra/xml/data/data.factor index 725d6da3cc..ae54816471 100644 --- a/extra/xml/data/data.factor +++ b/extra/xml/data/data.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2005, 2006 Daniel Ehrenberg ! See http://factorcode.org/license.txt for BSD license. -USING: kernel sequences sequences.private assocs arrays vectors ; +USING: kernel sequences sequences.private assocs arrays delegate vectors ; IN: xml.data TUPLE: name space tag url ; @@ -41,17 +41,13 @@ C: instruction TUPLE: prolog version encoding standalone ; C: prolog -TUPLE: xml prolog before after ; -: ( prolog before main after -- xml ) - { set-xml-prolog set-xml-before set-delegate set-xml-after } - xml construct ; +TUPLE: tag attrs children ; -TUPLE: attrs ; -: ( alist -- attrs ) - attrs construct-delegate ; +TUPLE: attrs alist ; +C: attrs : attr@ ( key alist -- index {key,value} ) - >r assure-name r> + >r assure-name r> attrs-alist [ first names-match? ] curry* find ; M: attrs at* @@ -60,13 +56,13 @@ M: attrs set-at 2dup attr@ nip [ 2nip set-second ] [ - [ >r assure-name swap 2array r> ?push ] keep - set-delegate + >r assure-name swap 2array r> + [ attrs-alist ?push ] keep set-attrs-alist ] if* ; -M: attrs assoc-size length ; +M: attrs assoc-size attrs-alist length ; M: attrs new-assoc drop V{ } new ; -M: attrs >alist delegate >alist ; +M: attrs >alist attrs-alist ; : >attrs ( assoc -- attrs ) dup [ @@ -77,39 +73,67 @@ M: attrs assoc-like drop dup attrs? [ >attrs ] unless ; M: attrs clear-assoc - f swap set-delegate ; + f swap set-attrs-alist ; M: attrs delete-at - tuck attr@ drop [ swap delete-nth ] [ drop ] if* ; + tuck attr@ drop [ swap attrs-alist delete-nth ] [ drop ] if* ; + +M: attrs clone + attrs-alist clone ; INSTANCE: attrs assoc -TUPLE: tag attrs children ; : ( name attrs children -- tag ) >r >r assure-name r> T{ attrs } assoc-like r> { set-delegate set-tag-attrs set-tag-children } tag construct ; ! For convenience, tags follow the assoc protocol too (for attrs) -M: tag at* tag-attrs at* ; -M: tag set-at tag-attrs set-at ; -M: tag new-assoc tag-attrs new-assoc ; -M: tag >alist tag-attrs >alist ; -M: tag delete-at tag-attrs delete-at ; -M: tag clear-assoc tag-attrs clear-assoc ; -M: tag assoc-size tag-attrs assoc-size ; -M: tag assoc-like tag-attrs assoc-like ; - +CONSULT: assoc-protocol tag tag-attrs ; INSTANCE: tag assoc ! They also follow the sequence protocol (for children) -M: tag nth tag-children nth ; -M: tag nth-unsafe tag-children nth-unsafe ; -M: tag set-nth tag-children set-nth ; -M: tag set-nth-unsafe tag-children set-nth-unsafe ; -M: tag length tag-children length ; - +CONSULT: sequence-protocol tag tag-children ; INSTANCE: tag sequence +M: tag like + over tag? [ drop ] [ + [ delegate ] keep tag-attrs + rot dup [ V{ } like ] when + ] if ; + +M: tag clone + [ delegate clone ] keep [ tag-attrs clone ] keep + tag-children clone + { set-delegate set-tag-attrs set-tag-children } tag construct ; + +TUPLE: xml prolog before main after ; +: ( prolog before main after -- xml ) + { set-xml-prolog set-xml-before set-delegate set-xml-after } + xml construct ; + +CONSULT: sequence-protocol xml delegate ; +INSTANCE: xml sequence + +CONSULT: assoc-protocol xml delegate ; +INSTANCE: xml assoc + +xml ( xml tag -- newxml ) + swap [ dup xml-prolog swap xml-before rot ] keep xml-after ; + +: seq>xml ( xml seq -- newxml ) + over delegate like tag>xml ; +PRIVATE> + +M: xml clone + [ xml-prolog clone ] keep [ xml-before clone ] keep + [ delegate clone ] keep xml-after clone ; + +M: xml like + swap dup xml? [ nip ] [ + dup tag? [ tag>xml ] [ seq>xml ] if + ] if ; + ! tag with children=f is contained : ( name attrs -- tag ) f ; diff --git a/extra/xml/generator/generator.factor b/extra/xml/generator/generator.factor index d5eb64388c..44bd1934f8 100644 --- a/extra/xml/generator/generator.factor +++ b/extra/xml/generator/generator.factor @@ -1,4 +1,7 @@ -USING: namespaces kernel xml.data xml.utilities ; +! Copyright (C) 2006, 2007 Daniel Ehrenberg +! See http://factorcode.org/license.txt for BSD license. +USING: namespaces kernel xml.data xml.utilities assocs splitting +sequences parser quotations sequences.lib xml.utilities ; IN: xml.generator : comment, ( string -- ) , ; @@ -21,3 +24,56 @@ IN: xml.generator (tag,) build-xml ; inline : make-xml ( name quot -- xml ) f swap make-xml* ; inline + +! Word-based XML literal syntax +: parsed-name ( accum -- accum ) + scan ":" split1 [ f ] [ ] if* parsed ; + +: run-combinator ( accum quot1 quot2 -- accum ) + >r [ ] like parsed r> [ parsed ] each ; + +: parse-tag-contents ( accum contained? -- accum ) + [ \ contained*, parsed ] [ + scan-word \ [ = + [ POSTPONE: [ \ tag*, parsed ] + [ "Expected [ missing" throw ] if + ] if ; + +DEFER: >> + +: attributes-parsed ( accum quot -- accum ) + dup empty? [ drop f parsed ] [ + >r \ >r parsed r> parsed + [ H{ } make-assoc r> swap ] [ parsed ] each + ] if ; + +: << + parsed-name [ + \ >> parse-until >quotation + attributes-parsed \ contained? get + ] with-scope parse-tag-contents ; parsing + +: == + \ call parsed parsed-name \ set parsed ; parsing + +: // + \ contained? on ; parsing + +: parse-special ( accum end-token word -- accum ) + >r parse-tokens " " join parsed r> parsed ; + +: " \ comment, parse-special ; parsing + +: " \ directive, parse-special ; parsing + +: " \ instruction, parse-special ; parsing + +: >xml-document ( seq -- xml ) + dup first prolog? [ unclip-slice ] [ standard-prolog ] if swap + [ tag? ] split-around ; + +DEFER: XML> + +: [ >quotation ] parse-literal + { } parsed \ make parsed \ >xml-document parsed ; parsing diff --git a/extra/xml/test/soap.factor b/extra/xml/test/soap.factor index ed8bd70efc..f8bd8e1021 100644 --- a/extra/xml/test/soap.factor +++ b/extra/xml/test/soap.factor @@ -5,7 +5,7 @@ USING: sequences xml kernel arrays xml.utilities io.files tools.test ; [ tag-named children>string ] curry* map ; : parse-result ( xml -- seq ) - "resultElements" tag-named* "item" tags-named + "resultElements" deep-tag-named "item" tags-named [ assemble-data ] map ; [ "http://www.foxnews.com/oreilly/" ] [ diff --git a/extra/xml/test/templating.factor b/extra/xml/test/templating.factor index baa0e3bca1..0ee4ae51b0 100644 --- a/extra/xml/test/templating.factor +++ b/extra/xml/test/templating.factor @@ -1,6 +1,6 @@ IN: templating USING: kernel xml sequences assocs tools.test io arrays namespaces - xml.data xml.utilities xml.writer generic ; + xml.data xml.utilities xml.writer generic sequences.deep ; : sub-tag T{ name f f "sub" "http://littledan.onigirihouse.com/namespaces/replace" } ; @@ -16,7 +16,7 @@ M: tag (r-ref) M: object (r-ref) drop ; : template ( xml -- ) - [ (r-ref) ] xml-each ; + [ (r-ref) ] deep-each ; ! Example @@ -40,4 +40,4 @@ M: object (r-ref) drop ; sample-doc string>xml dup template xml>string ] with-scope ; -[ "foo
blah

" ] [ test-refs ] unit-test +[ "\nfoo

" ] [ test-refs ] unit-test diff --git a/extra/xml/test/test.factor b/extra/xml/test/test.factor index a2fd2813ed..80a508787e 100644 --- a/extra/xml/test/test.factor +++ b/extra/xml/test/test.factor @@ -1,45 +1,50 @@ -! Copyright (C) 2005, 2006 Daniel Ehrenberg -! See http://factorcode.org/license.txt for BSD license. -IN: temporary -USING: kernel xml tools.test io namespaces sequences xml.errors xml.entities +! Copyright (C) 2005, 2006 Daniel Ehrenberg +! See http://factorcode.org/license.txt for BSD license. +IN: temporary +USING: kernel xml tools.test io namespaces sequences xml.errors xml.entities parser strings xml.data io.files xml.writer xml.utilities state-parser - continuations assocs ; - -! This is insufficient -SYMBOL: xml-file -[ ] [ "extra/xml/test/test.xml" resource-path - [ file>xml ] with-html-entities xml-file set ] unit-test -[ "1.0" ] [ xml-file get xml-prolog prolog-version ] unit-test -[ f ] [ xml-file get xml-prolog prolog-standalone ] unit-test -[ "a" ] [ xml-file get name-space ] unit-test -[ "http://www.hello.com" ] [ xml-file get name-url ] unit-test -[ "that" ] [ - xml-file get T{ name f "" "this" "http://d.de" } swap at -] unit-test -[ t ] [ xml-file get tag-children second contained-tag? ] unit-test -[ t ] [ [ "" string>xml ] catch xml-parse-error? ] unit-test -[ T{ comment f "This is where the fun begins!" } ] [ - xml-file get xml-before [ comment? ] find nip -] unit-test -[ "xsl stylesheet=\"that-one.xsl\"" ] [ - xml-file get xml-after [ instruction? ] find nip instruction-text -] unit-test -[ V{ "fa&g" } ] [ xml-file get "x" get-id tag-children ] unit-test -[ "that" ] [ xml-file get "this" swap at ] unit-test -[ "" ] - [ "" string>xml xml>string ] unit-test -[ "abcd" ] [ - "

abcd
" string>xml - [ [ dup string? [ % ] [ drop ] if ] xml-each ] "" make -] unit-test -[ "abcd" ] [ - "
abcd
" string>xml - [ string? ] xml-subset concat -] unit-test -[ "foo" ] [ - "foo" string>xml - "c" get-id children>string -] unit-test -[ "foo" ] [ "" string>xml "y" over -at swap "z" >r tuck r> swap set-at T{ name f "blah" "z" f } swap at ] unit-test + continuations assocs sequences.deep ; + +! This is insufficient +SYMBOL: xml-file +[ ] [ "extra/xml/test/test.xml" resource-path + [ file>xml ] with-html-entities xml-file set ] unit-test +[ "1.0" ] [ xml-file get xml-prolog prolog-version ] unit-test +[ f ] [ xml-file get xml-prolog prolog-standalone ] unit-test +[ "a" ] [ xml-file get name-space ] unit-test +[ "http://www.hello.com" ] [ xml-file get name-url ] unit-test +[ "that" ] [ + xml-file get T{ name f "" "this" "http://d.de" } swap at +] unit-test +[ t ] [ xml-file get tag-children second contained-tag? ] unit-test +[ t ] [ [ "" string>xml ] catch xml-parse-error? ] unit-test +[ T{ comment f "This is where the fun begins!" } ] [ + xml-file get xml-before [ comment? ] find nip +] unit-test +[ "xsl stylesheet=\"that-one.xsl\"" ] [ + xml-file get xml-after [ instruction? ] find nip instruction-text +] unit-test +[ V{ "fa&g" } ] [ xml-file get "x" get-id tag-children ] unit-test +[ "that" ] [ xml-file get "this" swap at ] unit-test +[ "\n" ] + [ "" string>xml xml>string ] unit-test +[ "abcd" ] [ + "
abcd
" string>xml + [ [ dup string? [ % ] [ drop ] if ] deep-each ] "" make +] unit-test +[ "abcd" ] [ + "
abcd
" string>xml + [ string? ] deep-subset concat +] unit-test +[ "foo" ] [ + "foo" string>xml + "c" get-id children>string +] unit-test +[ "foo" ] [ "" string>xml "y" over + at swap "z" >r tuck r> swap set-at + T{ name f "blah" "z" f } swap at ] unit-test [ "foo" ] [ "" string>xml children>string ] unit-test +[ "\nbar baz" ] +[ "bar" string>xml [ " baz" append ] map xml>string ] unit-test +[ "\n\n bar\n" ] +[ " bar " string>xml pprint-xml>string ] unit-test diff --git a/extra/xml/tokenize/tokenize.factor b/extra/xml/tokenize/tokenize.factor index 5e3bf1edfa..85a473f503 100644 --- a/extra/xml/tokenize/tokenize.factor +++ b/extra/xml/tokenize/tokenize.factor @@ -124,7 +124,8 @@ SYMBOL: ns-stack [ parse-attr (middle-tag) ] when ; : middle-tag ( -- attrs-alist ) - [ (middle-tag) ] V{ } make pass-blank ; + ! f make will make a vector if it has any elements + [ (middle-tag) ] f make pass-blank ; : end-tag ( name attrs-alist -- tag ) tag-ns pass-blank get-char CHAR: / = diff --git a/extra/xml/utilities/utilities.factor b/extra/xml/utilities/utilities.factor index 798b7f571a..0d910298f0 100755 --- a/extra/xml/utilities/utilities.factor +++ b/extra/xml/utilities/utilities.factor @@ -2,7 +2,7 @@ ! See http://factorcode.org/license.txt for BSD license. USING: kernel namespaces sequences words io assocs quotations strings parser arrays xml.data xml.writer debugger -splitting vectors ; +splitting vectors sequences.deep ; IN: xml.utilities ! * System for words specialized on tag names @@ -59,59 +59,6 @@ M: process-missing error. : first-child-tag ( tag -- tag ) tag-children [ tag? ] find nip ; -! * Utilities for searching through XML documents -! These all work from the outside in, top to bottom. - -: with-delegate ( object quot -- object ) - over clone >r >r delegate r> call r> - [ set-delegate ] keep ; inline - -GENERIC# xml-each 1 ( quot tag -- ) inline -M: tag xml-each - [ call ] 2keep - swap tag-children [ swap xml-each ] curry* each ; -M: object xml-each - call ; -M: xml xml-each - >r delegate r> xml-each ; - -GENERIC# xml-map 1 ( quot tag -- tag ) inline -M: tag xml-map - swap clone over >r swap call r> - swap [ tag-children [ swap xml-map ] curry* map ] keep - [ set-tag-children ] keep ; -M: object xml-map - call ; -M: xml xml-map - swap [ swap xml-map ] with-delegate ; - -: xml-subset ( quot tag -- seq ) ! quot: tag -- ? - V{ } clone rot [ - swap >r [ swap call ] 2keep rot r> - swap [ [ push ] keep ] [ nip ] if - ] xml-each nip ; - -GENERIC# xml-find 1 ( quot tag -- tag ) inline -M: tag xml-find - [ call ] 2keep swap rot [ - f swap - [ nip over >r swap xml-find r> swap dup ] find - 2drop ! leaves result of quot - ] unless nip ; -M: object xml-find - keep f ? ; -M: xml xml-find - >r delegate r> xml-find ; - -GENERIC# xml-inject 1 ( quot tag -- ) inline -M: tag xml-inject - swap [ - swap [ call ] keep - [ xml-inject ] keep - ] change-each ; -M: object xml-inject 2drop ; -M: xml xml-inject >r delegate >r xml-inject ; - ! * Accessing part of an XML document ! for tag- words, a start means that it searches all children ! and no star searches only direct children @@ -119,11 +66,14 @@ M: xml xml-inject >r delegate >r xml-inject ; : tag-named? ( name elem -- ? ) dup tag? [ names-match? ] [ 2drop f ] if ; -: tag-named* ( tag name/string -- matching-tag ) - assure-name swap [ dupd tag-named? ] xml-find nip ; +: tags@ ( tag name -- children name ) + >r { } like r> assure-name ; -: tags-named* ( tag name/string -- tags-seq ) - assure-name swap [ dupd tag-named? ] xml-subset nip ; +: deep-tag-named ( tag name/string -- matching-tag ) + assure-name [ swap tag-named? ] curry deep-find ; + +: deep-tags-named ( tag name/string -- tags-seq ) + tags@ [ swap tag-named? ] curry deep-subset ; : tag-named ( tag name/string -- matching-tag ) ! like get-name-tag but only looks at direct children, @@ -131,7 +81,28 @@ M: xml xml-inject >r delegate >r xml-inject ; assure-name swap [ tag-named? ] curry* find nip ; : tags-named ( tag name/string -- tags-seq ) - assure-name swap [ tag-named? ] curry* subset ; + tags@ swap [ tag-named? ] curry* subset ; + +: tag-with-attr? ( elem attr-value attr-name -- ? ) + rot dup tag? [ at = ] [ 3drop f ] if ; + +: tag-with-attr ( tag attr-value attr-name -- matching-tag ) + assure-name [ tag-with-attr? ] 2curry find nip ; + +: tags-with-attr ( tag attr-value attr-name -- tags-seq ) + tags@ [ tag-with-attr? ] 2curry subset tag-children ; + +: deep-tag-with-attr ( tag attr-value attr-name -- matching-tag ) + assure-name [ tag-with-attr? ] 2curry deep-find ; + +: deep-tags-with-attr ( tag attr-value attr-name -- tags-seq ) + tags@ [ tag-with-attr? ] 2curry deep-subset ; + +: get-id ( tag id -- elem ) ! elem=tag.getElementById(id) + "id" deep-tag-with-attr ; + +: deep-tags-named-with-attr ( tag tag-name attr-value attr-name -- tags ) + >r >r deep-tags-named r> r> tags-with-attr ; : assert-tag ( name name -- ) names-match? [ "Unexpected XML tag found" throw ] unless ; @@ -142,24 +113,3 @@ M: xml xml-inject >r delegate >r xml-inject ; : insert-child ( child tag -- ) >r 1vector r> insert-children ; - -: tag-with-attr? ( elem attr-value attr-name -- ? ) - rot dup tag? [ at = ] [ drop f ] if ; - -: tag-with-attr ( tag attr-value attr-name -- matching-tag ) - assure-name [ tag-with-attr? ] 2curry find nip ; - -: tags-with-attr ( tag attr-value attr-name -- tags-seq ) - assure-name [ tag-with-attr? ] 2curry subset ; - -: tag-with-attr* ( tag attr-value attr-name -- matching-tag ) - assure-name [ tag-with-attr? ] 2curry xml-find nip ; - -: tags-with-attr* ( tag attr-value attr-name -- tags-seq ) - assure-name [ tag-with-attr? ] 2curry xml-subset ; - -: get-id ( tag id -- elem ) ! elem=tag.getElementById(id) - "id" tag-with-attr ; - -: tags-named-with-attr* ( tag tag-name attr-value attr-name -- tags ) - >r >r tags-named* r> r> tags-with-attr ; diff --git a/extra/xml/writer/writer.factor b/extra/xml/writer/writer.factor index 986f1b5a01..7bd1cc3046 100644 --- a/extra/xml/writer/writer.factor +++ b/extra/xml/writer/writer.factor @@ -4,51 +4,100 @@ USING: hashtables kernel math namespaces sequences strings io io.streams.string xml.data assocs ; IN: xml.writer -: write-entities +SYMBOL: xml-pprint? +SYMBOL: sensitive-tags +SYMBOL: indentation +SYMBOL: indenter +" " indenter set-global + +: sensitive? ( tag -- ? ) + sensitive-tags get swap [ names-match? ] curry contains? ; + +: ?indent ( -- ) + xml-pprint? get [ + nl indentation get indenter get [ write ] each + ] when ; + +: indent ( -- ) + xml-pprint? get [ 1 indentation +@ ] when ; + +: unindent ( -- ) + xml-pprint? get [ -1 indentation +@ ] when ; + +: trim-whitespace ( string -- no-whitespace ) + [ [ blank? not ] find drop 0 or ] keep + [ [ blank? not ] find-last drop [ 1+ ] [ 0 ] if* ] keep + subseq ; + +: ?filter-children ( children -- no-whitespace ) + xml-pprint? get [ + [ dup string? [ trim-whitespace ] when ] map + [ dup empty? swap string? and not ] subset + ] when ; + +: entities-out H{ { CHAR: < "<" } { CHAR: > ">" } { CHAR: & "&" } + } ; + +: quoted-entities-out + H{ + { CHAR: & "&" } { CHAR: ' "'" } { CHAR: " """ } } ; -: chars>entities ( str -- str ) +: escape-string-by ( str table -- escaped ) #! Convert <, >, &, ' and " to HTML entities. - [ [ dup write-entities at [ % ] [ , ] ?if ] each ] "" make ; + [ [ dupd at [ % ] [ , ] ?if ] curry each ] "" make ; + +: escape-string ( str -- newstr ) + entities-out escape-string-by ; + +: escape-quoted-string ( str -- newstr ) + quoted-entities-out escape-string-by ; : print-name ( name -- ) dup name-space f like [ write CHAR: : write1 ] when* name-tag write ; -: print-attrs ( hash -- ) +: print-attrs ( assoc -- ) [ - first2 " " write + " " write swap print-name "=\"" write - chars>entities write + escape-quoted-string write "\"" write - ] each ; + ] assoc-each ; GENERIC: write-item ( object -- ) M: string write-item - chars>entities write ; + escape-string write ; + +: write-tag ( tag -- ) + CHAR: < write1 + dup print-name tag-attrs print-attrs ; M: contained-tag write-item - CHAR: < write1 - dup print-name - tag-attrs print-attrs - "/>" write ; + write-tag "/>" write ; + +: write-children ( tag -- ) + indent tag-children ?filter-children + [ ?indent write-item ] each unindent ; + +: write-end-tag ( tag -- ) + ?indent " write1 ; M: open-tag write-item - CHAR: < write1 - dup print-name - dup tag-attrs print-attrs - CHAR: > write1 - dup tag-children [ write-item ] each - " write1 ; + xml-pprint? [ [ + over sensitive? not and xml-pprint? set + dup write-tag CHAR: > write1 + dup write-children write-end-tag + ] keep ] change ; M: comment write-item "" write ; @@ -63,7 +112,7 @@ M: instruction write-item "" write ; + "\"?>\n" write ; : write-chunk ( seq -- ) [ write-item ] each ; @@ -80,3 +129,22 @@ M: instruction write-item : xml>string ( xml -- string ) [ write-xml ] string-out ; +: with-xml-pprint ( sensitive-tags quot -- ) + [ + swap [ assure-name ] map sensitive-tags set + 0 indentation set + xml-pprint? on + call + ] with-scope ; inline + +: pprint-xml-but ( xml sensitive-tags -- ) + [ print-xml ] with-xml-pprint ; + +: pprint-xml ( xml -- ) + f pprint-xml-but ; + +: pprint-xml>string-but ( xml sensitive-tags -- string ) + [ xml>string ] with-xml-pprint ; + +: pprint-xml>string ( xml -- string ) + f pprint-xml>string-but ; diff --git a/extra/xml/xml-docs.factor b/extra/xml/xml-docs.factor index bb833585c0..785538332a 100644 --- a/extra/xml/xml-docs.factor +++ b/extra/xml/xml-docs.factor @@ -7,14 +7,29 @@ strings sequences io ; HELP: string>xml { $values { "string" "a string" } { "xml" "an xml document" } } { $description "converts a string into an " { $link xml } - " datatype for further processing" } -{ $see-also xml>string xml-reprint } ; + " datatype for further processing" } ; + +HELP: read-xml +{ $values { "stream" "a stream that supports readln" } + { "xml" "an XML document" } } +{ $description "exausts the given stream, reading an XML document from it" } ; + +HELP: file>xml +{ $values { "filename" "a string representing a filename" } + { "xml" "an XML document" } } +{ $description "opens the given file, reads it in as XML, closes the file and returns the corresponding XML tree" } ; + +{ string>xml read-xml file>xml } related-words HELP: xml>string { $values { "xml" "an xml document" } { "string" "a string" } } { $description "converts an xml document (" { $link xml } ") into a string" } -{ $notes "does not preserve what type of quotes were used or what data was omitted from version declaration" } -{ $see-also string>xml xml-reprint write-xml } ; +{ $notes "does not preserve what type of quotes were used or what data was omitted from version declaration" } ; + +HELP: pprint-xml>string +{ $values { "xml" "an xml document" } { "string" "a string" } } +{ $description "converts an xml document (" { $link xml } ") into a string in a prettyprinted form." } +{ $notes "does not preserve what type of quotes were used or what data was omitted from version declaration" } ; HELP: xml-parse-error { $class-description "the exception class that all parsing errors in XML documents are in." } ; @@ -22,20 +37,34 @@ HELP: xml-parse-error HELP: xml-reprint { $values { "string" "a string of XML" } } { $description "parses XML and prints it out again, for testing purposes" } -{ $notes "does not preserve what type of quotes were used or what data was omitted from version declaration" } -{ $see-also write-xml xml>string string>xml } ; +{ $notes "does not preserve what type of quotes were used or what data was omitted from version declaration" } ; HELP: write-xml { $values { "xml" "an XML document" } } { $description "prints the contents of an XML document (" { $link xml } ") to stdio" } -{ $notes "does not preserve what type of quotes were used or what data was omitted from version declaration" } -{ $see-also xml>string xml-reprint read-xml } ; +{ $notes "does not preserve what type of quotes were used or what data was omitted from version declaration" } ; -HELP: read-xml -{ $values { "stream" "a stream that supports readln" } - { "xml" "an XML document" } } -{ $description "exausts the given stream, reading an XML document from it" } -{ $see-also write-xml string>xml } ; +HELP: print-xml +{ $values { "xml" "an XML document" } } +{ $description "prints the contents of an XML document (" { $link xml } ") to stdio, followed by a newline" } +{ $notes "does not preserve what type of quotes were used or what data was omitted from version declaration" } ; + +HELP: pprint-xml +{ $values { "xml" "an XML document" } } +{ $description "prints the contents of an XML document (" { $link xml } ") to stdio in a prettyprinted form." } +{ $notes "does not preserve what type of quotes were used or what data was omitted from version declaration" } ; + +HELP: pprint-xml-but +{ $values { "xml" "an XML document" } { "sensitive-tags" "a sequence of names" } } +{ $description "Prettyprints an XML document, leaving the whitespace of the tags with names in sensitive-tags intact." } +{ $notes "does not preserve what type of quotes were used or what data was omitted from version declaration" } ; + +HELP: pprint-xml>string-but +{ $values { "xml" "an XML document" } { "sensitive-tags" "a sequence of names" } { "string" string } } +{ $description "Prettyprints an XML document, returning the result as a string and leaving the whitespace of the tags with names in sensitive-tags intact." } +{ $notes "does not preserve what type of quotes were used or what data was omitted from version declaration" } ; + +{ xml>string print-xml write-xml pprint-xml xml-reprint pprint-xml>string pprint-xml>string-but pprint-xml-but } related-words HELP: PROCESS: { $syntax "PROCESS: word" } @@ -49,24 +78,6 @@ HELP: TAG: { $description "defines what a process should do when it encounters a specific tag" } { $examples { $code "PROCESS: x ( tag -- )\nTAG: a x drop \"hi\" write ;" } } { $see-also POSTPONE: PROCESS: } ; - -HELP: xml-each -{ $values { "tag" tag } { "quot" "a quotation ( element -- )" } } -{ $description "applies the quotation to each element (tags, strings, etc) in the tag, moving top-down" } -{ $see-also xml-map xml-subset } ; - -HELP: xml-map -{ $values { "tag" tag } { "quot" "a quotation ( element -- element )" } - { "tag" "an XML tag with the quotation applied to each element" } } -{ $description "applies the quotation to each element (tags, strings, etc) in the tag, moving top-down, and produces a new tag" } -{ $see-also xml-each xml-subset } ; - -HELP: xml-subset -{ $values { "tag" tag } { "quot" "a quotation ( tag -- ? )" } - { "seq" "sequence of elements" } } -{ $description "applies the quotation to each element (tags, strings, etc) in the tag, moving top-down, producing a sequence of elements which do not return false for the sequence" } -{ $see-also xml-map xml-each } ; - HELP: build-tag* { $values { "items" "sequence of elements" } { "name" "string" } { "tag" tag } } @@ -166,15 +177,10 @@ HELP: xml-chunk { $description "rather than parse a document, as " { $link read-xml } " does, this word parses and returns a sequence of XML elements (tags, strings, etc), ie a document fragment. This is useful for pieces of XML which may have more than one main tag." } { $see-also write-chunk read-xml } ; -HELP: xml-find -{ $values { "tag" "an XML element or document" } { "quot" "a quotation ( elem -- ? )" } { "tag" "an XML element which satisfies the predicate" } } -{ $description "finds the first element in the XML document which satisfies the predicate, moving from the outermost element to the innermost, top-down" } -{ $see-also xml-each xml-map get-id } ; - HELP: get-id { $values { "tag" "an XML tag or document" } { "id" "a string" } { "elem" "an XML element or f" } } { $description "finds the XML tag with the specified id, ignoring the namespace" } -{ $see-also xml-find } ; +{ $see-also } ; HELP: process { $values { "object" "an opener, closer, contained or text element" } } @@ -242,15 +248,15 @@ HELP: write-chunk { $description "writes an XML document fragment, ie a sequence of XML elements, to the " { $link stdio } " stream." } { $see-also write-item write-xml } ; -HELP: tag-named* +HELP: deep-tag-named { $values { "tag" "an XML tag or document" } { "name/string" "an XML name or string representing a name" } { "matching-tag" tag } } { $description "finds an XML tag with a matching name, recursively searching children and children of children" } -{ $see-also tags-named tag-named tags-named* } ; +{ $see-also tags-named tag-named deep-tags-named } ; -HELP: tags-named* +HELP: deep-tags-named { $values { "tag" "an XML tag or document" } { "name/string" "an XML name or string representing a name" } { "tags-seq" "a sequence of tags" } } { $description "returns a sequence of all tags of a matching name, recursively searching children and children of children" } -{ $see-also tag-named tag-named* tags-named } ; +{ $see-also tag-named deep-tag-named tags-named } ; HELP: children>string { $values { "tag" "an XML tag or document" } { "string" "a string" } } @@ -306,14 +312,14 @@ HELP: tag-named { "name/string" "an XML name or string representing the name" } { "matching-tag" tag } } { $description "finds the first tag with matching name which is the direct child of the given tag" } -{ $see-also tags-named* tag-named* tags-named } ; +{ $see-also deep-tags-named deep-tag-named tags-named } ; HELP: tags-named { $values { "tag" "an XML tag or document" } { "name/string" "an XML name or string representing the name" } { "tags-seq" "a sequence of tags" } } { $description "finds all tags with matching name that are the direct children of the given tag" } -{ $see-also tag-named* tags-named* tag-named } ; +{ $see-also deep-tag-named deep-tags-named tag-named } ; HELP: state-parse { $values { "stream" "an input stream" } { "quot" "a quotation ( -- )" } } @@ -341,26 +347,27 @@ HELP: with-html-entities { $description "calls the given quotation using HTML entity values" } { $see-also html-entities with-entities } ; -HELP: file>xml -{ $values { "filename" "a string representing a filename" } - { "xml" "an XML document" } } -{ $description "opens the given file, reads it in as XML, closes the file and returns the corresponding XML tree" } -{ $see-also string>xml read-xml } ; - -ARTICLE: { "xml" "basic" } "Basic words for XML processing" - "These are the most basic words needed for processing an XML document" - $nl - "Parsing XML:" +ARTICLE: { "xml" "reading" } "Reading XML" + "The following words are used to read something into an XML document" { $subsection string>xml } { $subsection read-xml } { $subsection xml-chunk } - { $subsection file>xml } - "Printing XML" - { $subsection xml>string } - { $subsection write-xml } + { $subsection file>xml } ; + +ARTICLE: { "xml" "writing" } "Writing XML" + "These words are used in implementing prettyprint" { $subsection write-item } { $subsection write-chunk } - "Other" + "These words are used to print XML normally" + { $subsection xml>string } + { $subsection write-xml } + { $subsection print-xml } + "These words are used to prettyprint XML" + { $subsection pprint-xml>string } + { $subsection pprint-xml>string-but } + { $subsection pprint-xml } + { $subsection pprint-xml-but } + "This word reads and writes XML" { $subsection xml-reprint } ; ARTICLE: { "xml" "classes" } "XML data classes" @@ -390,18 +397,13 @@ ARTICLE: { "xml" "utils" } "XML processing utilities" "System sfor creating words which dispatch on XML tags:" { $subsection POSTPONE: PROCESS: } { $subsection POSTPONE: TAG: } - "Combinators for traversing XML trees:" - { $subsection xml-each } - { $subsection xml-map } - { $subsection xml-subset } - { $subsection xml-find } "Getting parts of an XML document or tag:" $nl - "Note: the difference between tag-named* and tag-named is that the former searches recursively among all children and children of children of the tag, while the latter only looks at the direct children, and is therefore more efficient." + "Note: the difference between deep-tag-named and tag-named is that the former searches recursively among all children and children of children of the tag, while the latter only looks at the direct children, and is therefore more efficient." { $subsection tag-named } { $subsection tags-named } - { $subsection tag-named* } - { $subsection tags-named* } + { $subsection deep-tag-named } + { $subsection deep-tags-named } { $subsection get-id } "Words for simplified generation of XML:" { $subsection build-tag* } @@ -461,7 +463,8 @@ ARTICLE: { "xml" "intro" } "XML" "The XML module attempts to implement the XML 1.1 standard, converting strings of text into XML and vice versa. It currently is a work in progress." $nl "The XML module was implemented by Daniel Ehrenberg, with contributions from the Factor community" - { $subsection { "xml" "basic" } } + { $subsection { "xml" "reading" } } + { $subsection { "xml" "writing" } } { $subsection { "xml" "classes" } } { $subsection { "xml" "construct" } } { $subsection { "xml" "utils" } } diff --git a/extra/xmode/code2html/code2html.factor b/extra/xmode/code2html/code2html.factor index dfc50988a3..3db70cf2e9 100755 --- a/extra/xmode/code2html/code2html.factor +++ b/extra/xmode/code2html/code2html.factor @@ -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 ( -- ) ; : htmlize-stream ( path stream -- ) diff --git a/extra/yahoo/yahoo.factor b/extra/yahoo/yahoo.factor index 8bcb9139a7..371560367f 100644 --- a/extra/yahoo/yahoo.factor +++ b/extra/yahoo/yahoo.factor @@ -9,7 +9,7 @@ TUPLE: result title url summary ; C: result : parse-yahoo ( xml -- seq ) - "Result" tags-named* [ + "Result" deep-tags-named [ { "Title" "Url" "Summary" } [ tag-named children>string ] curry* map first3