Fix conflict
commit
ef2fddb1ec
|
@ -28,7 +28,7 @@ SYMBOL: bootstrap-time
|
|||
[ "bootstrap." prepend require ] each ;
|
||||
|
||||
: count-words ( pred -- )
|
||||
all-words swap filter length number>string write ;
|
||||
all-words swap count number>string write ;
|
||||
|
||||
: print-report ( time -- )
|
||||
1000 /i
|
||||
|
|
|
@ -107,7 +107,7 @@ ERROR: bad-superclass class ;
|
|||
|
||||
: superclass-size ( class -- n )
|
||||
superclasses but-last-slice
|
||||
[ slot-names length ] map sum ;
|
||||
[ slot-names length ] sigma ;
|
||||
|
||||
: (instance-check-quot) ( class -- quot )
|
||||
[
|
||||
|
|
|
@ -48,7 +48,7 @@ DEFER: (flat-length)
|
|||
{ [ dup word? ] [ word-flat-length ] }
|
||||
[ drop 1 ]
|
||||
} cond
|
||||
] map sum ;
|
||||
] sigma ;
|
||||
|
||||
: flat-length ( word -- n )
|
||||
[ def>> (flat-length) ] with-scope ;
|
||||
|
|
|
@ -1,6 +1,5 @@
|
|||
USING: arrays help.markup help.syntax math
|
||||
sequences.private vectors strings sbufs kernel math.order
|
||||
layouts ;
|
||||
sequences.private vectors strings kernel math.order ;
|
||||
IN: sequences
|
||||
|
||||
ARTICLE: "sequences-unsafe" "Unsafe sequence operations"
|
||||
|
@ -959,3 +958,23 @@ HELP: unfold
|
|||
"The " { $snippet "tail" } " quotation is used when the predicate produces more than one output value. In this case, we have to drop this value even if the predicate fails in order for stack inference to calculate a stack effect for the " { $link unfold } " call:"
|
||||
{ $unchecked-example "USING: kernel prettyprint random sequences ;" "[ 10 random dup 1 > ] [ ] [ drop ] unfold ." "{ 8 2 2 9 }" }
|
||||
} ;
|
||||
|
||||
HELP: sigma
|
||||
{ $values { "seq" sequence } { "quot" quotation } { "n" number } }
|
||||
{ $description "Like map sum, but without creating an intermediate sequence." }
|
||||
{ $example
|
||||
"! Find the sum of the squares [0,99]"
|
||||
"USING: math math.ranges sequences.lib prettyprint ;"
|
||||
"100 [1,b] [ sq ] sigma ."
|
||||
"338350"
|
||||
} ;
|
||||
|
||||
HELP: count
|
||||
{ $values { "seq" sequence } { "quot" quotation } { "n" integer } }
|
||||
{ $description "Efficiently returns the number of elements that the predicate quotation matches." }
|
||||
{ $example
|
||||
"USING: math math.ranges sequences.lib prettyprint ;"
|
||||
"100 [1,b] [ even? ] count ."
|
||||
"50"
|
||||
} ;
|
||||
|
||||
|
|
|
@ -241,3 +241,8 @@ unit-test
|
|||
[ "asdf" ] [ " asdf " [ CHAR: \s = ] trim ] unit-test
|
||||
[ "asdf " ] [ " asdf " [ CHAR: \s = ] left-trim ] unit-test
|
||||
[ " asdf" ] [ " asdf " [ CHAR: \s = ] right-trim ] unit-test
|
||||
|
||||
[ 328350 ] [ 100 [ sq ] sigma ] unit-test
|
||||
|
||||
[ 50 ] [ 100 [ even? ] count ] unit-test
|
||||
[ 50 ] [ 100 [ odd? ] count ] unit-test
|
||||
|
|
|
@ -718,3 +718,8 @@ PRIVATE>
|
|||
dup [ length ] map infimum
|
||||
swap [ [ nth-unsafe ] with { } map-as ] curry { } map-as
|
||||
] unless ;
|
||||
|
||||
: sigma ( seq quot -- n ) [ + ] compose 0 swap reduce ; inline
|
||||
|
||||
: count ( seq quot -- n ) [ 1 0 ? ] compose sigma ; inline
|
||||
|
||||
|
|
|
@ -1,6 +1,6 @@
|
|||
! Copyright (C) 2008 Slava Pestov, Eduardo Cavazos.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: kernel sequences combinators parser splitting
|
||||
USING: kernel sequences combinators parser splitting math
|
||||
quotations arrays namespaces qualified ;
|
||||
QUALIFIED: namespaces
|
||||
IN: fry
|
||||
|
@ -35,29 +35,25 @@ DEFER: shallow-fry
|
|||
|
||||
: shallow-fry ( quot -- quot' ) [ ] swap (shallow-fry) ;
|
||||
|
||||
: deep-fry ( quot -- quot' )
|
||||
{ _ } last-split1 [
|
||||
[
|
||||
shallow-fry %
|
||||
[ >r ] %
|
||||
deep-fry %
|
||||
[ [ dip ] curry r> compose ] %
|
||||
] [ ] make
|
||||
: deep-fry ( quot -- quot )
|
||||
{ _ } last-split1 dup [
|
||||
shallow-fry [ >r ] rot
|
||||
deep-fry [ [ dip ] curry r> compose ] 4array concat
|
||||
] [
|
||||
shallow-fry
|
||||
] if* ;
|
||||
drop shallow-fry
|
||||
] if ;
|
||||
|
||||
: fry-specifier? ( obj -- ? ) { , namespaces:, @ } member? ;
|
||||
|
||||
: count-inputs ( quot -- n )
|
||||
[
|
||||
{
|
||||
{ [ dup callable? ] [ count-inputs ] }
|
||||
{ [ dup fry-specifier? ] [ drop 1 ] }
|
||||
[ drop 0 ]
|
||||
{ [ dup callable? ] [ count-inputs ] }
|
||||
{ [ dup fry-specifier? ] [ drop 1 ] }
|
||||
[ drop 0 ]
|
||||
} cond
|
||||
] map sum ;
|
||||
|
||||
|
||||
: fry ( quot -- quot' )
|
||||
[
|
||||
[
|
||||
|
|
|
@ -159,6 +159,11 @@ METHOD: as-mutate { object object assoc } set-at ;
|
|||
: prefix-on ( elt seq -- seq ) swap prefix ;
|
||||
: suffix-on ( elt seq -- seq ) swap suffix ;
|
||||
|
||||
: suffix! ( seq elt -- seq ) over sequences:push ;
|
||||
: suffix-on! ( elt seq -- seq ) tuck sequences:push ;
|
||||
: suffixed! ( seq elt -- ) swap sequences:push ;
|
||||
: suffixed-on! ( elt seq -- ) sequences:push ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: subseq ( seq from to -- subseq ) rot sequences:subseq ;
|
||||
|
@ -221,4 +226,14 @@ METHOD: as-mutate { object object assoc } set-at ;
|
|||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: invert-index ( seq i -- seq i ) >r dup length 1 - r> - ;
|
||||
: invert-index ( seq i -- seq i ) >r dup length 1 - r> - ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: append! ( a b -- ab ) over sequences:push-all ;
|
||||
: append-to! ( b a -- ab ) swap over sequences:push-all ;
|
||||
: appended! ( a b -- ) swap sequences:push-all ;
|
||||
: appended-to! ( b a -- ) sequences:push-all ;
|
||||
|
||||
: prepend! ( a b -- ba ) over append 0 pick copy ;
|
||||
: prepended! ( a b -- ) over append 0 rot copy ;
|
||||
|
|
|
@ -1,6 +1,6 @@
|
|||
! Copyright (c) 2008 Aaron Schaefer.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: kernel math math.ranges sequences.lib ;
|
||||
USING: kernel math math.ranges sequences ;
|
||||
IN: project-euler.028
|
||||
|
||||
! http://projecteuler.net/index.php?section=problems&id=28
|
||||
|
|
|
@ -1,6 +1,6 @@
|
|||
! Copyright (c) 2008 Aaron Schaefer.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: kernel math math.functions sequences.lib ;
|
||||
USING: kernel math math.functions sequences ;
|
||||
IN: project-euler.048
|
||||
|
||||
! http://projecteuler.net/index.php?section=problems&id=48
|
||||
|
|
|
@ -1,6 +1,6 @@
|
|||
! Copyright (c) 2008 Aaron Schaefer.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: kernel math math.combinatorics math.ranges sequences.lib ;
|
||||
USING: kernel math math.combinatorics math.ranges sequences ;
|
||||
IN: project-euler.053
|
||||
|
||||
! http://projecteuler.net/index.php?section=problems&id=53
|
||||
|
|
|
@ -19,25 +19,6 @@ HELP: each-withn
|
|||
}
|
||||
{ $see-also map-withn } ;
|
||||
|
||||
HELP: sigma
|
||||
{ $values { "seq" sequence } { "quot" quotation } { "n" number } }
|
||||
{ $description "Like map sum, but without creating an intermediate sequence." }
|
||||
{ $example
|
||||
"! Find the sum of the squares [0,99]"
|
||||
"USING: math math.ranges sequences.lib prettyprint ;"
|
||||
"100 [1,b] [ sq ] sigma ."
|
||||
"338350"
|
||||
} ;
|
||||
|
||||
HELP: count
|
||||
{ $values { "seq" sequence } { "quot" quotation } { "n" integer } }
|
||||
{ $description "Efficiently returns the number of elements that the predicate quotation matches." }
|
||||
{ $example
|
||||
"USING: math math.ranges sequences.lib prettyprint ;"
|
||||
"100 [1,b] [ even? ] count ."
|
||||
"50"
|
||||
} ;
|
||||
|
||||
HELP: if-seq
|
||||
{ $values { "seq" sequence } { "quot1" quotation } { "quot2" quotation } }
|
||||
{ $description "Makes an implicit check if the sequence is empty. If the sequence has any elements, " { $snippet "quot1" } " is called on it. Otherwise, the empty sequence is dropped and " { $snippet "quot2" } " is called." }
|
||||
|
|
|
@ -2,10 +2,6 @@ USING: arrays kernel sequences sequences.lib math math.functions math.ranges
|
|||
tools.test strings ;
|
||||
IN: sequences.lib.tests
|
||||
|
||||
[ 50 ] [ 100 [1,b] [ even? ] count ] unit-test
|
||||
[ 50 ] [ 100 [1,b] [ odd? ] count ] unit-test
|
||||
[ 328350 ] [ 100 [ sq ] sigma ] unit-test
|
||||
|
||||
[ 1 2 { 3 4 } [ + + drop ] 2 each-withn ] must-infer
|
||||
{ 13 } [ 1 2 { 3 4 } [ + + ] 2 each-withn + ] unit-test
|
||||
|
||||
|
@ -64,10 +60,6 @@ IN: sequences.lib.tests
|
|||
[ 3 ] [ { 1 2 3 } ?third ] unit-test
|
||||
[ f ] [ { 1 2 3 } ?fourth ] unit-test
|
||||
|
||||
[ 50 ] [ 100 [1,b] [ even? ] count ] unit-test
|
||||
[ 50 ] [ 100 [1,b] [ odd? ] count ] unit-test
|
||||
[ 328350 ] [ 100 [ sq ] sigma ] unit-test
|
||||
|
||||
[ 1 2 { 3 4 } [ + + ] 2 map-withn ] must-infer
|
||||
{ { 6 7 } } [ 1 2 { 3 4 } [ + + ] 2 map-withn ] unit-test
|
||||
{ { 16 17 18 19 20 } } [ 1 2 3 4 { 6 7 8 9 10 } [ + + + + ] 4 map-withn ] unit-test
|
||||
|
|
|
@ -51,14 +51,6 @@ MACRO: firstn ( n -- )
|
|||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: sigma ( seq quot -- n )
|
||||
[ + ] compose 0 swap reduce ; inline
|
||||
|
||||
: count ( seq quot -- n )
|
||||
[ 1 0 ? ] compose sigma ; inline
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: map-reduce ( seq map-quot reduce-quot -- result )
|
||||
>r [ unclip ] dip [ call ] keep r> compose reduce ; inline
|
||||
|
||||
|
|
Loading…
Reference in New Issue