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

Use clump instead of collect-consecutive in PE

db4
Aaron Schaefer 2008-10-30 23:34:32 -04:00
parent bc9bf6839b
commit 3127cfdddc
3 changed files with 11 additions and 24 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
extra/project-euler/008/008.factor
View File

@ -1,6 +1,6 @@
! Copyright (c) 2007 Aaron Schaefer.
! Copyright (c) 2007, 2008 Aaron Schaefer.
! See http://factorcode.org/license.txt for BSD license.
USING: math.parser project-euler.common sequences ;
USING: grouping math.parser sequences ;
IN: project-euler.008
! http://projecteuler.net/index.php?section=problems&id=8
@ -64,9 +64,9 @@ IN: project-euler.008
PRIVATE>
: euler008 ( -- answer )
source-008 5 collect-consecutive [ string>digits product ] map supremum ;
source-008 5 clump [ string>digits product ] map supremum ;
! [ euler008 ] 100 ave-time
! 11 ms run / 0 ms GC ave time - 100 trials
! 2 ms ave run time - 0.79 SD (100 trials)
MAIN: euler008

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

@ -1,7 +1,6 @@
! Copyright (c) 2007 Aaron Schaefer.
! Copyright (c) 2007, 2008 Aaron Schaefer.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel namespaces make project-euler.common sequences
splitting grouping ;
USING: grouping kernel make sequences ;
IN: project-euler.011
! http://projecteuler.net/index.php?section=problems&id=11
@ -88,7 +87,7 @@ IN: project-euler.011
horizontal pad-front pad-back flip ;
: max-product ( matrix width -- n )
[ collect-consecutive ] curry map concat
[ clump ] curry map concat
[ product ] map supremum ; inline
PRIVATE>
@ -100,6 +99,6 @@ PRIVATE>
] { } make supremum ;
! [ euler011 ] 100 ave-time
! 4 ms run / 0 ms GC ave time - 100 trials
! 3 ms ave run time - 0.77 SD (100 trials)
MAIN: euler011

18
extra/project-euler/common/common.factor
View File

@ -1,8 +1,8 @@
! Copyright (c) 2007-2008 Aaron Schaefer.
! See http://factorcode.org/license.txt for BSD license.
USING: arrays kernel math math.functions math.miller-rabin math.matrices
math.order math.parser math.primes.factors math.ranges make namespaces
sequences sequences.lib sorting unicode.case ;
USING: arrays kernel make math math.functions math.matrices math.miller-rabin
math.order math.parser math.primes.factors math.ranges sequences
sequences.lib sorting unicode.case ;
IN: project-euler.common
! A collection of words used by more than one Project Euler solution
@ -12,7 +12,6 @@ IN: project-euler.common
! -------------------------------
! alpha-value - #22, #42
! cartesian-product - #4, #27, #29, #32, #33, #43, #44, #56
! collect-consecutive - #8, #11
! log10 - #25, #134
! max-path - #18, #67
! nth-triangle - #12, #42
@ -34,9 +33,6 @@ IN: project-euler.common
<PRIVATE
: count-shifts ( seq width -- n )
[ length 1+ ] dip - ;
: max-children ( seq -- seq )
[ dup length 1- [ over nth-pair max , ] each ] { } make nip ;
@ -44,9 +40,6 @@ IN: project-euler.common
: propagate ( bottom top -- newtop )
[ over rest rot first2 max rot + ] map nip ;
: shift-3rd ( seq obj obj -- seq obj obj )
rot rest -rot ;
: (sum-divisors) ( n -- sum )
dup sqrt >fixnum [1,b] [
[ 2dup mod zero? [ 2dup / + , ] [ drop ] if ] each
@ -64,11 +57,6 @@ PRIVATE>
: cartesian-product ( seq1 seq2 -- seq1xseq2 )
swap [ swap [ 2array ] map-with ] map-with concat ;
: collect-consecutive ( seq width -- seq )
[
2dup count-shifts [ 2dup head shift-3rd , ] times
] { } make 2nip ;
: log10 ( m -- n )
log 10 log / ;