steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

sequences, tetris, rosetta-code: Simplify some code.

db4
Doug Coleman 2013-03-11 18:57:54 -07:00
parent 247f57b828
commit 15d720458a
3 changed files with 3 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
extra/rosetta-code/ordered-words/ordered-words.factor
View File

@ -26,12 +26,8 @@ MEMO: word-list ( -- seq )
: ordered-word? ( word -- ? ) : ordered-word? ( word -- ? )
>lower 2 <clumps> [ first2 <= ] all? ; >lower 2 <clumps> [ first2 <= ] all? ;
: filter-longest-words ( seq -- seq' )
dup [ length ] [ max ] map-reduce
'[ length _ = ] filter ;
: ordered-words-main ( -- ) : ordered-words-main ( -- )
word-list [ ordered-word? ] filter word-list [ ordered-word? ] filter
filter-longest-words [ print ] each ; all-longest [ print ] each ;
MAIN: ordered-words-main MAIN: ordered-words-main

2
extra/sequences/modified/modified.factor
View File

@ -51,7 +51,7 @@ M:: offset modified-set-nth ( elt n seq -- )
TUPLE: summed < modified seqs ; TUPLE: summed < modified seqs ;
C: <summed> summed C: <summed> summed
M: summed length seqs>> [ length ] [ max ] map-reduce ; M: summed length seqs>> longest length ;
<PRIVATE <PRIVATE
: ?+ ( x/f y/f -- sum ) : ?+ ( x/f y/f -- sum )

2
extra/tetris/tetromino/tetromino.factor
View File

@ -104,7 +104,7 @@ SYMBOL: tetrominoes
tetrominoes get random ; tetrominoes get random ;
: blocks-max ( blocks quot -- max ) : blocks-max ( blocks quot -- max )
map [ 1 + ] [ max ] map-reduce ; inline map supremum 1 + ; inline
: blocks-width ( blocks -- width ) : blocks-width ( blocks -- width )
[ first ] blocks-max ; [ first ] blocks-max ;