! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays generic hashtables kernel kernel.private
math namespaces parser sequences strings words libc fry
-alien.c-types alien.structs.fields cpu.architecture ;
+alien.c-types alien.structs.fields cpu.architecture math.order ;
IN: alien.structs
TUPLE: struct-type size align fields ;
[ first2 <field-spec> ] with with map ;
: compute-struct-align ( types -- n )
- [ c-type-align ] map supremum ;
+ [ c-type-align ] [ max ] map-reduce ;
: define-struct ( name vocab fields -- )
[
: define-union ( name members -- )
[ expand-constants ] map
- [ [ heap-size ] map supremum ] keep
+ [ [ heap-size ] [ max ] map-reduce ] keep
compute-struct-align f (define-struct) ;
ARTICLE: "biassocs" "Bidirectional assocs"
"A " { $emphasis "bidirectional assoc" } " combines a pair of assocs to form a data structure where both normal assoc opeartions (eg, " { $link at } "), as well as " { $link "assocs-values" } " (eg, " { $link value-at } ") run in sub-linear time."
$nl
-"Bidirectional assocs implement the entire " { $link "assoc-protocol" } " with the exception of " { $link delete-at } ". Duplicate values are allowed, however value lookups with " { $link value-at } " only return the first key that a given value was stored with."
+"Bidirectional assocs implement the entire " { $link "assocs-protocol" } " with the exception of " { $link delete-at } ". Duplicate values are allowed, however value lookups with " { $link value-at } " only return the first key that a given value was stored with."
$nl
"The class of biassocs:"
{ $subsection biassoc }
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: namespaces sequences accessors math kernel
-compiler.tree ;
+compiler.tree math.order ;
IN: compiler.tree.normalization.introductions
SYMBOL: introductions
M: #branch count-introductions*
children>>
- [ count-introductions ] map supremum
+ [ count-introductions ] [ max ] map-reduce
introductions+ ;
M: #recursive count-introductions*
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: fry namespaces sequences math accessors kernel arrays
+USING: fry namespaces sequences math math.order accessors kernel arrays
combinators compiler.utilities assocs
stack-checker.backend
stack-checker.branches
] map unzip swap
] change-children swap
[ remaining-introductions set ]
- [ [ length ] map infimum introduction-stack [ swap head ] change ]
+ [ [ length ] [ min ] map-reduce introduction-stack [ swap head ] change ]
bi ;
: eliminate-phi-introductions ( introductions seq terminated -- seq' )
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: fry vectors sequences assocs math accessors kernel
+USING: fry vectors sequences assocs math math.order accessors kernel
combinators quotations namespaces grouping stack-checker.state
stack-checker.backend stack-checker.errors stack-checker.visitor
stack-checker.values stack-checker.recursive-state ;
: pad-with-bottom ( seq -- newseq )
dup empty? [
- dup [ length ] map supremum
+ dup [ length ] [ max ] map-reduce
'[ _ +bottom+ pad-head ] map
] unless ;
! See http://factorcode.org/license.txt for BSD license.
USING: tools.disassembler namespaces combinators
alien alien.syntax alien.c-types lexer parser kernel
-sequences layouts math math.parser system make fry arrays ;
+sequences layouts math math.order
+math.parser system make fry arrays ;
IN: tools.disassembler.udis
<<
: buf/len ( from to -- buf len ) [ drop <alien> ] [ swap - ] 2bi ;
: format-disassembly ( lines -- lines' )
- dup [ second length ] map supremum
+ dup [ second length ] [ max ] map-reduce
'[
[
[ first >hex cell 2 * CHAR: 0 pad-head % ": " % ]
--- /dev/null
+IN: wrap.tests
+USING: tools.test wrap multiline sequences ;
+
+[
+ {
+ {
+ T{ word f 1 10 f }
+ T{ word f 2 10 f }
+ T{ word f 3 2 t }
+ }
+ {
+ T{ word f 4 10 f }
+ T{ word f 5 10 f }
+ }
+ }
+] [
+ {
+ T{ word f 1 10 f }
+ T{ word f 2 10 f }
+ T{ word f 3 2 t }
+ T{ word f 4 10 f }
+ T{ word f 5 10 f }
+ } 35 wrap [ { } like ] map
+] unit-test
+
+[
+ <" This is a
+long piece
+of text
+that we
+wish to
+word wrap.">
+] [
+ <" This is a long piece of text that we wish to word wrap."> 10
+ wrap-string
+] unit-test
+
+[
+ <" This is a
+ long piece
+ of text
+ that we
+ wish to
+ word wrap.">
+] [
+ <" This is a long piece of text that we wish to word wrap."> 12
+ " " wrap-indented-string
+] unit-test
\ No newline at end of file
-USING: sequences kernel namespaces make splitting math math.order ;
+USING: sequences kernel namespaces make splitting
+math math.order fry assocs accessors ;
IN: wrap
-! Very stupid word wrapping/line breaking
-! This will be replaced by a Unicode-aware method,
-! which works with variable-width fonts
+! Word wrapping/line breaking -- not Unicode-aware
+
+TUPLE: word key width break? ;
+
+C: <word> word
+
+<PRIVATE
SYMBOL: width
-: line-chunks ( string -- words-lines )
- "\n" split [ " \t" split harvest ] map ;
+: break-here? ( column word -- ? )
+ break?>> not [ width get > ] [ drop f ] if ;
+
+: find-optimal-break ( words -- n )
+ [ 0 ] dip [ [ width>> + dup ] keep break-here? ] find drop nip ;
-: (split-chunk) ( words -- )
- -1 over [ length + 1+ dup width get > ] find drop nip
- [ 1 max cut-slice swap , (split-chunk) ] [ , ] if* ;
+: (wrap) ( words -- )
+ dup find-optimal-break
+ [ 1 max cut-slice [ , ] [ (wrap) ] bi* ] [ , ] if* ;
-: split-chunk ( words -- lines )
- [ (split-chunk) ] { } make ;
+: intersperse ( seq elt -- seq' )
+ [ '[ _ , ] [ , ] interleave ] { } make ;
-: join-spaces ( words-seqs -- lines )
- [ [ " " join ] map ] map concat ;
+: split-lines ( string -- words-lines )
+ string-lines [
+ " \t" split harvest
+ [ dup length f <word> ] map
+ " " 1 t <word> intersperse
+ ] map ;
-: broken-lines ( string width -- lines )
+: join-words ( wrapped-lines -- lines )
+ [
+ [ break?>> ]
+ [ trim-head-slice ]
+ [ trim-tail-slice ] bi
+ [ key>> ] map concat
+ ] map ;
+
+: join-lines ( strings -- string )
+ "\n" join ;
+
+PRIVATE>
+
+: wrap ( words width -- lines )
width [
- line-chunks [ split-chunk ] map join-spaces
+ [ (wrap) ] { } make
] with-variable ;
-: line-break ( string width -- newstring )
- broken-lines "\n" join ;
+: wrap-lines ( lines width -- newlines )
+ [ split-lines ] dip '[ _ wrap join-words ] map concat ;
+
+: wrap-string ( string width -- newstring )
+ wrap-lines join-lines ;
-: indented-break ( string width indent -- newstring )
- [ length - broken-lines ] keep [ prepend ] curry map "\n" join ;
+: wrap-indented-string ( string width indent -- newstring )
+ [ length - wrap-lines ] keep '[ _ prepend ] map join-lines ;
escape-string xml-pprint? get [\r
dup [ blank? ] all?\r
[ drop "" ]\r
- [ nl 80 indent-string indented-break ] if\r
+ [ nl 80 indent-string wrap-indented-string ] if\r
] when write ;\r
\r
: write-tag ( tag -- )\r
! Copyright (c) 2007, 2008 Aaron Schaefer.
! See http://factorcode.org/license.txt for BSD license.
-USING: grouping math.parser sequences ;
+USING: grouping math.order math.parser sequences ;
IN: project-euler.008
! http://projecteuler.net/index.php?section=problems&id=8
PRIVATE>
: euler008 ( -- answer )
- source-008 5 clump [ string>digits product ] map supremum ;
+ source-008 5 clump [ string>digits product ] [ max ] map-reduce ;
! [ euler008 ] 100 ave-time
! 2 ms ave run time - 0.79 SD (100 trials)
! Copyright (c) 2007, 2008 Aaron Schaefer.
! See http://factorcode.org/license.txt for BSD license.
-USING: grouping kernel make sequences ;
+USING: grouping kernel make math.order sequences ;
IN: project-euler.011
! http://projecteuler.net/index.php?section=problems&id=11
: max-product ( matrix width -- n )
[ clump ] curry map concat
- [ product ] map supremum ; inline
+ [ product ] [ max ] map-reduce ; inline
PRIVATE>
! Copyright (c) 2008 Aaron Schaefer.
! See http://factorcode.org/license.txt for BSD license.
-USING: kernel math math.functions math.ranges project-euler.common sequences ;
+USING: kernel math math.functions math.ranges math.order
+project-euler.common sequences ;
IN: project-euler.044
! http://projecteuler.net/index.php?section=problems&id=44
: euler044 ( -- answer )
2500 [1,b] [ nth-pentagonal ] map dup cartesian-product
- [ first2 sum-and-diff? ] filter [ first2 - abs ] map infimum ;
+ [ first2 sum-and-diff? ] filter [ first2 - abs ] [ min ] map-reduce ;
! [ euler044 ] 10 ave-time
! 4996 ms ave run time - 87.46 SD (10 trials)
: euler056 ( -- answer )
90 100 [a,b) dup cartesian-product
- [ first2 ^ number>digits sum ] map supremum ;
+ [ first2 ^ number>digits sum ] [ max ] map-reduce ;
! [ euler056 ] 100 ave-time
! 22 ms ave run time - 2.13 SD (100 trials)
! Copyright (C) 2008 Alex Chapman
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays kernel math sequences sequences.private shuffle ;
+USING: accessors arrays kernel math math.order
+sequences sequences.private shuffle ;
IN: sequences.modified
TUPLE: modified ;
TUPLE: summed < modified seqs ;
C: <summed> summed
-M: summed length seqs>> [ length ] map supremum ;
+M: summed length seqs>> [ length ] [ max ] map-reduce ;
<PRIVATE
: ?+ ( x/f y/f -- sum )
! Copyright (C) 2006, 2007, 2008 Alex Chapman
! See http://factorcode.org/license.txt for BSD license.
-USING: kernel arrays namespaces sequences math math.vectors
-colors random ;
+USING: kernel arrays namespaces sequences math math.order
+math.vectors colors random ;
IN: tetris.tetromino
TUPLE: tetromino states colour ;
tetrominoes get random ;
: blocks-max ( blocks quot -- max )
- map [ 1+ ] map supremum ; inline
+ map [ 1+ ] [ max ] map-reduce ; inline
: blocks-width ( blocks -- width )
[ first ] blocks-max ;
projects / factor.git / commitdiff