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

remove some uses of conjoin.

char-rename
John Benediktsson 2017-02-07 15:14:20 -08:00
parent 846d2315ff
commit ef3d271fb3
4 changed files with 24 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
extra/project-euler/023/023.factor
View File

@ -1,6 +1,7 @@
! Copyright (c) 2008 Aaron Schaefer. ! Copyright (c) 2008 Aaron Schaefer.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: kernel math math.ranges project-euler.common sequences sets sorting assocs fry ; USING: fry kernel math math.ranges project-euler.common
sequences sets ;
IN: project-euler.023 IN: project-euler.023
! http://projecteuler.net/index.php?section=problems&id=23 ! http://projecteuler.net/index.php?section=problems&id=23
@ -42,9 +43,9 @@ IN: project-euler.023
[1,b] [ abundant? ] filter ; [1,b] [ abundant? ] filter ;
: possible-sums ( seq -- seq ) : possible-sums ( seq -- seq )
H{ } clone HS{ } clone
[ dupd '[ _ [ + _ conjoin ] with each ] each ] [ dupd '[ _ [ + _ adjoin ] with each ] each ]
keep keys ; keep members ;
PRIVATE> PRIVATE>

22
extra/project-euler/051/051.factor
View File

@ -26,16 +26,16 @@
! for each prime number, count the families it belongs to. When one reaches count of 8, stop, and get the smallest number by replacing * with ones. ! for each prime number, count the families it belongs to. When one reaches count of 8, stop, and get the smallest number by replacing * with ones.
USING: assocs kernel math math.combinatorics math.functions USING: assocs fry kernel math math.combinatorics math.functions
math.parser math.primes namespaces project-euler.common math.order math.parser math.primes math.ranges namespaces
sequences sets strings grouping math.ranges arrays fry math.order ; project-euler.common sequences sets ;
IN: project-euler.051 IN: project-euler.051
<PRIVATE <PRIVATE
SYMBOL: family-count SYMBOL: family-count
SYMBOL: large-families SYMBOL: large-families
: reset-globals ( -- ) : reset-globals ( -- )
H{ } clone family-count namespaces:set H{ } clone family-count namespaces:set
H{ } clone large-families namespaces:set ; HS{ } clone large-families namespaces:set ;
: digits-positions ( str -- positions ) : digits-positions ( str -- positions )
H{ } clone [ '[ swap _ push-at ] each-index ] keep ; H{ } clone [ '[ swap _ push-at ] each-index ] keep ;
@ -52,7 +52,7 @@ SYMBOL: large-families
[ all-positions-combinations [ replace-positions-with-* ] with map ] with map concat ; [ all-positions-combinations [ replace-positions-with-* ] with map ] with map concat ;
: save-family ( family -- ) : save-family ( family -- )
dup family-count get at 8 = [ large-families get conjoin ] [ drop ] if ; dup family-count get at 8 = [ large-families get adjoin ] [ drop ] if ;
: increment-family ( family -- ) : increment-family ( family -- )
family-count get inc-at ; family-count get inc-at ;
: handle-family ( family -- ) : handle-family ( family -- )
@ -65,17 +65,19 @@ SYMBOL: large-families
reset-globals reset-globals
n-digits-primes n-digits-primes
[ number>string families [ handle-family ] each ] each [ number>string families [ handle-family ] each ] each
large-families get ; large-families get members ;
: fill-*-with-ones ( str -- str ) : fill-*-with-ones ( str -- str )
[ dup CHAR: * = [ drop CHAR: 1 ] when ] map ; [ dup CHAR: * = [ drop CHAR: 1 ] when ] map ;
! recursively test all primes by length until we find an answer ! recursively test all primes by length until we find an answer
: (euler051) ( i -- answer ) : (euler051) ( i -- answer )
dup test-n-digits-primes dup test-n-digits-primes [
dup assoc-size 0 > 1 + (euler051)
[ nip values [ fill-*-with-ones string>number ] [ min ] map-reduce ] ] [
[ drop 1 + (euler051) ] if ; nip [ fill-*-with-ones string>number ] [ min ] map-reduce
] if-empty ;
PRIVATE> PRIVATE>
: euler051 ( -- answer ) : euler051 ( -- answer )

11
extra/project-euler/074/074.factor
View File

@ -1,7 +1,7 @@
! Copyright (c) 2009 Guillaume Nargeot. ! Copyright (c) 2009 Guillaume Nargeot.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: assocs hashtables kernel math math.ranges USING: hash-sets kernel math.ranges project-euler.common
project-euler.common sequences sets ; sequences sets ;
IN: project-euler.074 IN: project-euler.074
! http://projecteuler.net/index.php?section=problems&id=074 ! http://projecteuler.net/index.php?section=problems&id=074
@ -51,10 +51,9 @@ IN: project-euler.074
number>digits [ digit-factorial ] map-sum ; number>digits [ digit-factorial ] map-sum ;
: chain-length ( n -- n ) : chain-length ( n -- n )
61 <hashtable> 61 <hash-set> [ 2dup ?adjoin ] [
[ 2dup key? not ] [ digits-factorial-sum ] dip
[ [ conjoin ] [ [ digits-factorial-sum ] dip ] 2bi ] ] while nip cardinality ;
while nip assoc-size ;
PRIVATE> PRIVATE>

4
extra/trees/splay/splay-tests.factor
View File

@ -1,6 +1,6 @@
! Copyright (c) 2005 Mackenzie Straight. ! Copyright (c) 2005 Mackenzie Straight.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: assocs grouping kernel math random sequences sets USING: assocs fry grouping kernel math random sequences sets
tools.test trees.splay ; tools.test trees.splay ;
IN: trees.splay.tests IN: trees.splay.tests
@ -8,7 +8,7 @@ IN: trees.splay.tests
100 iota [ drop 100 random of drop ] with each ; 100 iota [ drop 100 random of drop ] with each ;
: make-numeric-splay-tree ( n -- splay-tree ) : make-numeric-splay-tree ( n -- splay-tree )
iota <splay> [ [ conjoin ] curry each ] keep ; iota <splay> [ '[ dup _ set-at ] each ] keep ;
{ t } [ { t } [
100 make-numeric-splay-tree dup randomize-numeric-splay-tree 100 make-numeric-splay-tree dup randomize-numeric-splay-tree