project-euler.{073,085}: speed up and reduce memory consumption

db4
Slava Pestov 2009-09-12 01:30:46 -05:00
parent b61ff44b66
commit 29a73c901d
2 changed files with 24 additions and 20 deletions

View File

@ -1,6 +1,6 @@
! 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 locals make math project-euler.common sequences ; USING: kernel locals math project-euler.common sequences ;
IN: project-euler.073 IN: project-euler.073
! http://projecteuler.net/index.php?section=problems&id=73 ! http://projecteuler.net/index.php?section=problems&id=73
@ -32,19 +32,19 @@ IN: project-euler.073
<PRIVATE <PRIVATE
:: (euler073) ( limit lo hi -- ) :: (euler073) ( counter limit lo hi -- counter' )
[let | m [ lo hi mediant ] | [let | m [ lo hi mediant ] |
m denominator limit <= [ m denominator limit <= [
m , counter 1 +
limit lo m (euler073) limit lo m (euler073)
limit m hi (euler073) limit m hi (euler073)
] when ] [ counter ] if
] ; ] ;
PRIVATE> PRIVATE>
: euler073 ( -- answer ) : euler073 ( -- answer )
[ 10000 1/3 1/2 (euler073) ] { } make length ; 0 10000 1/3 1/2 (euler073) ;
! [ euler073 ] 10 ave-time ! [ euler073 ] 10 ave-time
! 20506 ms ave run time - 937.07 SD (10 trials) ! 20506 ms ave run time - 937.07 SD (10 trials)

View File

@ -1,6 +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: arrays kernel math math.ranges project-euler.common sequences ; USING: accessors kernel math math.ranges project-euler.common
sequences locals ;
IN: project-euler.085 IN: project-euler.085
! http://projecteuler.net/index.php?section=problems&id=85 ! http://projecteuler.net/index.php?section=problems&id=85
@ -23,28 +24,31 @@ IN: project-euler.085
<PRIVATE <PRIVATE
: distance ( m -- n ) : distance ( m -- n )
2000000 - abs ; 2000000 - abs ; inline
: rectangles-count ( a b -- n ) : rectangles-count ( a b -- n )
2dup [ 1 + ] bi@ * * * 4 / ; 2dup [ 1 + ] bi@ * * * 4 /i ; inline
: unique-products ( a b -- seq ) :: each-unique-product ( a b quot: ( i j -- ) -- )
tuck [a,b] [ a b [a,b] [| i |
over dupd [a,b] [ 2array ] with map i b [a,b] [| j |
] map concat nip ; i j quot call
] each
] each ; inline
: max-by-last ( seq seq -- seq ) TUPLE: result { area read-only } { distance read-only } ;
[ [ last ] bi@ < ] most ;
: array2 ( seq -- a b ) C: <result> result
[ first ] [ last ] bi ;
: convert ( seq -- seq ) : min-by-distance ( seq seq -- seq )
array2 [ * ] [ rectangles-count distance ] 2bi 2array ; [ [ distance>> ] bi@ < ] most ; inline
: compute-result ( i j -- pair )
[ * ] [ rectangles-count distance ] 2bi <result> ; inline
: area-of-nearest ( -- n ) : area-of-nearest ( -- n )
1 2000 unique-products T{ result f 0 2000000 } 1 2000
[ convert ] [ max-by-last ] map-reduce first ; [ compute-result min-by-distance ] each-unique-product area>> ;
PRIVATE> PRIVATE>