From f2cf2bc158d89d6b4077e66ad574cd1b55591458 Mon Sep 17 00:00:00 2001 From: Aaron Schaefer Date: Tue, 25 Dec 2007 00:13:01 -0500 Subject: [PATCH] Solution to Project Euler problem 21 --- extra/project-euler/016/016.factor | 4 +-- extra/project-euler/020/020.factor | 4 +-- extra/project-euler/021/021.factor | 46 ++++++++++++++++++++++++ extra/project-euler/common/common.factor | 17 ++++----- extra/project-euler/project-euler.factor | 6 ++-- 5 files changed, 62 insertions(+), 15 deletions(-) create mode 100644 extra/project-euler/021/021.factor diff --git a/extra/project-euler/016/016.factor b/extra/project-euler/016/016.factor index f3f414808d..866b0ed522 100644 --- a/extra/project-euler/016/016.factor +++ b/extra/project-euler/016/016.factor @@ -1,6 +1,6 @@ ! Copyright (c) 2007 Aaron Schaefer. ! See http://factorcode.org/license.txt for BSD license. -USING: kernel math.functions math.parser sequences ; +USING: kernel math.functions math.parser project-euler.common sequences ; IN: project-euler.016 ! http://projecteuler.net/index.php?section=problems&id=16 @@ -17,7 +17,7 @@ IN: project-euler.016 ! -------- : euler016 ( -- answer ) - 2 1000 ^ number>string string>digits sum ; + 2 1000 ^ number>digits sum ; ! [ euler016 ] 100 ave-time ! 0 ms run / 0 ms GC ave time - 100 trials diff --git a/extra/project-euler/020/020.factor b/extra/project-euler/020/020.factor index de40586165..498aad16ad 100644 --- a/extra/project-euler/020/020.factor +++ b/extra/project-euler/020/020.factor @@ -1,6 +1,6 @@ ! Copyright (c) 2007 Aaron Schaefer. ! See http://factorcode.org/license.txt for BSD license. -USING: kernel math.combinatorics math.parser sequences ; +USING: kernel math.combinatorics math.parser project-euler.common sequences ; IN: project-euler.020 ! http://projecteuler.net/index.php?section=problems&id=20 @@ -17,7 +17,7 @@ IN: project-euler.020 ! -------- : euler020 ( -- answer ) - 100 factorial number>string string>digits sum ; + 100 factorial number>digits sum ; ! [ euler020 ] 100 ave-time ! 0 ms run / 0 ms GC ave time - 100 trials diff --git a/extra/project-euler/021/021.factor b/extra/project-euler/021/021.factor new file mode 100644 index 0000000000..eb8cc02511 --- /dev/null +++ b/extra/project-euler/021/021.factor @@ -0,0 +1,46 @@ +! Copyright (c) 2007 Aaron Schaefer. +! See http://factorcode.org/license.txt for BSD license. +USING: combinators.lib kernel math math.functions math.ranges namespaces + project-euler.common sequences ; +IN: project-euler.021 + +! http://projecteuler.net/index.php?section=problems&id=21 + +! DESCRIPTION +! ----------- + +! Let d(n) be defined as the sum of proper divisors of n (numbers less than n +! which divide evenly into n). + +! If d(a) = b and d(b) = a, where a != b, then a and b are an amicable pair and +! each of a and b are called amicable numbers. + +! For example, the proper divisors of 220 are 1, 2, 4, 5, 10, 11, 20, 22, 44, +! 55 and 110; therefore d(220) = 284. The proper divisors of 284 are 1, 2, 4, +! 71 and 142; so d(284) = 220. + +! Evaluate the sum of all the amicable numbers under 10000. + + +! SOLUTION +! -------- + +fixnum 2 swap [a,b] [ + [ 2dup divisor? [ 2dup / + , ] [ drop ] if ] each drop + ] { } make sum 1+ ; + +: amicable-pair? ( n m -- ? ) + { [ 2dup = not ] [ 2dup d = ] } && 2nip ; + +PRIVATE> + +: euler021 ( -- answer ) + 10000 [1,b] [ dup dup d amicable-pair? [ drop 0 ] unless ] sigma ; + +! [ euler021 ] 100 ave-time +! 328 ms run / 10 ms GC ave time - 100 trials + +MAIN: euler021 diff --git a/extra/project-euler/common/common.factor b/extra/project-euler/common/common.factor index 9c27093913..0a31df82b7 100644 --- a/extra/project-euler/common/common.factor +++ b/extra/project-euler/common/common.factor @@ -15,6 +15,9 @@ IN: project-euler.common : shift-3rd ( seq obj obj -- seq obj obj ) rot 1 tail -rot ; +: max-children ( seq -- seq ) + [ dup length 1- [ over nth-pair max , ] each ] { } make nip ; + : >multiplicity ( seq -- seq ) dup prune [ [ 2dup [ = ] curry count 2array , ] each @@ -23,12 +26,6 @@ IN: project-euler.common : reduce-2s ( n -- r s ) dup even? [ factor-2s >r 1+ r> ] [ 1 swap ] if ; -: tau-limit ( n -- n ) - sqrt floor >fixnum ; - -: max-children ( seq -- seq ) - [ dup length 1- [ over nth-pair max , ] each ] { } make nip ; - PRIVATE> : collect-consecutive ( seq width -- seq ) @@ -46,8 +43,11 @@ PRIVATE> first first ] if ; +: number>digits ( n -- seq ) + number>string string>digits ; + : perfect-square? ( n -- ? ) - dup sqrt mod zero? ; + dup sqrt divisor? ; : prime-factorization ( n -- seq ) [ @@ -68,6 +68,7 @@ PRIVATE> ! Optimized brute-force, is often faster than prime factorization : tau* ( n -- n ) - reduce-2s [ perfect-square? -1 0 ? ] keep dup tau-limit [1,b] [ + reduce-2s [ perfect-square? -1 0 ? ] keep + dup sqrt >fixnum [1,b] [ dupd divisor? [ >r 2 + r> ] when ] each drop * ; diff --git a/extra/project-euler/project-euler.factor b/extra/project-euler/project-euler.factor index 48c1d272f0..bf913f60da 100644 --- a/extra/project-euler/project-euler.factor +++ b/extra/project-euler/project-euler.factor @@ -1,13 +1,13 @@ ! Copyright (c) 2007 Aaron Schaefer. ! See http://factorcode.org/license.txt for BSD license. USING: io io.files kernel math.parser namespaces sequences strings - vocabs vocabs.loader system project-euler.ave-time + vocabs vocabs.loader system project-euler.ave-time project-euler.common project-euler.001 project-euler.002 project-euler.003 project-euler.004 project-euler.005 project-euler.006 project-euler.007 project-euler.008 project-euler.009 project-euler.010 project-euler.011 project-euler.012 project-euler.013 project-euler.014 project-euler.015 project-euler.016 project-euler.017 project-euler.018 project-euler.019 project-euler.020 - project-euler.067 ; + project-euler.021 project-euler.067 ; IN: project-euler number ; : number>euler ( n -- str ) - number>string string>digits 3 0 pad-left [ number>string ] map concat ; + number>digits 3 0 pad-left [ number>string ] map concat ; : solution-path ( n -- str ) number>euler dup [