diff --git a/core/sequences/sequences-docs.factor b/core/sequences/sequences-docs.factor index 1bcd01d9b9..6c917f133b 100755 --- a/core/sequences/sequences-docs.factor +++ b/core/sequences/sequences-docs.factor @@ -178,6 +178,16 @@ ARTICLE: "sequences-search" "Searching sequences" { $subsection find-last } { $subsection find-last-from } ; +ARTICLE: "sequences-trimming" "Trimming sequences" +"Trimming words:" +{ $subsection trim } +{ $subsection trim-left } +{ $subsection trim-right } +"Potentially more efficient trim:" +{ $subsection trim-slice } +{ $subsection trim-left-slice } +{ $subsection trim-right-slice } ; + ARTICLE: "sequences-destructive" "Destructive operations" "These words modify their input, instead of creating a new sequence." $nl @@ -245,6 +255,7 @@ $nl { $subsection "sequences-sorting" } { $subsection "binary-search" } { $subsection "sets" } +{ $subsection "sequences-trimming" } "For inner loops:" { $subsection "sequences-unsafe" } ; @@ -722,7 +733,7 @@ HELP: reverse-here HELP: padding { $values { "seq" sequence } { "n" "a non-negative integer" } { "elt" object } { "quot" "a quotation with stack effect " { $snippet "( seq1 seq2 -- newseq )" } } { "newseq" "a new sequence" } } -{ $description "Outputs a new string sequence of " { $snippet "elt" } " repeated, that when appended to " { $snippet "seq" } ", yields a sequence of length " { $snippet "n" } ". If the length of { " { $snippet "seq" } " is greater than " { $snippet "n" } ", this word outputs an empty sequence." } ; +{ $description "Outputs a new string sequence of " { $snippet "elt" } " repeated, that when appended to " { $snippet "seq" } ", yields a sequence of length " { $snippet "n" } ". If the length of " { $snippet "seq" } " is greater than " { $snippet "n" } ", this word outputs an empty sequence." } ; HELP: pad-left { $values { "seq" sequence } { "n" "a non-negative integer" } { "elt" object } { "padded" "a new sequence" } } @@ -995,3 +1006,45 @@ HELP: count "50" } ; +HELP: pusher +{ $values + { "quot" "a predicate quotation" } + { "quot" quotation } { "accum" vector } } +{ $description "Creates a new vector to accumulate the values which return true for a predicate. Returns a new quotation which accepts an object to be tested and stored in the accumulator if the test yields true. The accumulator is left on the stack for convenience." } +{ $example "! Find all the even numbers:" "USING: prettyprint sequences math kernel ;" + "10 [ even? ] pusher [ each ] dip ." + "V{ 0 2 4 6 8 }" +} +{ $notes "Used to implement the " { $link filter } " word." } ; + +HELP: trim-left +{ $values + { "seq" sequence } { "quot" quotation } + { "newseq" sequence } } +{ $description "Removes elements starting from the left side of a sequence if they match a predicate. Once an element does not match, the test stops and the rest of the sequence is left on the stack as a new sequence." } +{ $example "" "USING: prettyprint math sequences ;" + "{ 0 0 1 2 3 0 0 } [ zero? ] trim-left ." + "{ 1 2 3 0 0 }" +} ; + +HELP: trim-right +{ $values + { "seq" sequence } { "quot" quotation } + { "newseq" sequence } } +{ $description "Removes elements starting from the right side of a sequence if they match a predicate. Once an element does not match, the test stops and the rest of the sequence is left on the stack as a new sequence." } +{ $example "" "USING: prettyprint math sequences ;" + "{ 0 0 1 2 3 0 0 } [ zero? ] trim-right ." + "{ 0 0 1 2 3 }" +} ; + +HELP: trim +{ $values + { "seq" sequence } { "quot" quotation } + { "newseq" sequence } } +{ $description "Removes elements starting from the left and right sides of a sequence if they match a predicate. Once an element does not match, the test stops and the rest of the sequence is left on the stack as a new sequence." } +{ $example "" "USING: prettyprint math sequences ;" + "{ 0 0 1 2 3 0 0 } [ zero? ] trim ." + "{ 1 2 3 }" +} ; + +{ trim-left trim-right trim } related-words diff --git a/core/sequences/sequences-tests.factor b/core/sequences/sequences-tests.factor index 4b7b8a3151..acfaa87e7d 100755 --- a/core/sequences/sequences-tests.factor +++ b/core/sequences/sequences-tests.factor @@ -234,13 +234,13 @@ unit-test [ -1./0. 0 delete-nth ] must-fail [ "" ] [ "" [ CHAR: \s = ] trim ] unit-test -[ "" ] [ "" [ CHAR: \s = ] left-trim ] unit-test -[ "" ] [ "" [ CHAR: \s = ] right-trim ] unit-test -[ "" ] [ " " [ CHAR: \s = ] left-trim ] unit-test -[ "" ] [ " " [ CHAR: \s = ] right-trim ] unit-test +[ "" ] [ "" [ CHAR: \s = ] trim-left ] unit-test +[ "" ] [ "" [ CHAR: \s = ] trim-right ] unit-test +[ "" ] [ " " [ CHAR: \s = ] trim-left ] unit-test +[ "" ] [ " " [ CHAR: \s = ] trim-right ] 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 +[ "asdf " ] [ " asdf " [ CHAR: \s = ] trim-left ] unit-test +[ " asdf" ] [ " asdf " [ CHAR: \s = ] trim-right ] unit-test [ 328350 ] [ 100 [ sq ] sigma ] unit-test diff --git a/core/sequences/sequences.factor b/core/sequences/sequences.factor index 73c9289415..5ab3e59284 100755 --- a/core/sequences/sequences.factor +++ b/core/sequences/sequences.factor @@ -725,16 +725,25 @@ PRIVATE> dup slice? [ { } like ] when 0 over length rot ; inline -: left-trim ( seq quot -- newseq ) +: trim-left-slice ( seq quot -- slice ) over >r [ not ] compose find drop r> swap - [ tail ] [ dup length tail ] if* ; inline + [ tail-slice ] [ dup length tail-slice ] if* ; inline + +: trim-left ( seq quot -- newseq ) + over [ trim-left-slice ] dip like ; inline -: right-trim ( seq quot -- newseq ) +: trim-right-slice ( seq quot -- slice ) over >r [ not ] compose find-last drop r> swap - [ 1+ head ] [ 0 head ] if* ; inline + [ 1+ head-slice ] [ 0 head-slice ] if* ; inline + +: trim-right ( seq quot -- newseq ) + over [ trim-right-slice ] dip like ; inline + +: trim-slice ( seq quot -- slice ) + [ trim-left-slice ] [ trim-right-slice ] bi ; : trim ( seq quot -- newseq ) - [ left-trim ] [ right-trim ] bi ; inline + over [ trim-slice ] dip like ; inline : sum ( seq -- n ) 0 [ + ] binary-reduce ;