! Copyright (C) 2007 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
-USING: arrays kernel math math.functions namespaces sequences
-strings system vocabs.loader threads accessors combinators
-locals classes.tuple math.order summary combinators.short-circuit ;
+USING: accessors arrays classes.tuple combinators combinators.short-circuit
+ kernel locals math math.functions math.order namespaces sequences strings
+ summary system threads vocabs.loader ;
IN: calendar
HOOK: gmt-offset os ( -- hours minutes seconds )
GENERIC: leap-year? ( obj -- ? )
M: integer leap-year? ( year -- ? )
- dup 100 mod zero? 400 4 ? mod zero? ;
+ dup 100 divisor? 400 4 ? divisor? ;
M: timestamp leap-year? ( timestamp -- ? )
year>> leap-year? ;
#! good for any date since October 15, 1582
[
dup 2 <= [ [ 1- ] [ 12 + ] bi* ] when
- [ dup [ 4 /i + ] keep [ 100 /i - ] keep 400 /i + ] dip
+ [ dup [ 4 /i + ] [ 100 /i - ] [ 400 /i + ] tri ] dip
[ 1+ 3 * 5 /i + ] keep 2 * +
] dip 1+ + 7 mod ;
: help>html ( topic -- xml )
[ article-title ]
[ drop help-stylesheet ]
- [ [ help ] with-html-writer ]
+ [ [ print-topic ] with-html-writer ]
tri simple-page ;
: generate-help-file ( topic -- )
"Tests:"
{ $subsection power-of-2? }
{ $subsection even? }
-{ $subsection odd? } ;
+{ $subsection odd? }
+{ $subsection divisor? } ;
ARTICLE: "arithmetic-functions" "Arithmetic functions"
"Computing additive and multiplicative inverses:"
{ $description "Computes the positive greatest common divisor " { $snippet "d" } " of " { $snippet "x" } " and " { $snippet "y" } ", and another value " { $snippet "a" } " satisfying:" { $code "a*y = d mod x" } }
{ $notes "If " { $snippet "d" } " is 1, then " { $snippet "a" } " is the inverse of " { $snippet "y" } " modulo " { $snippet "x" } "." } ;
+HELP: divisor?
+{ $values { "m" integer } { "n" integer } { "?" "a boolean" } }
+{ $description "Tests if " { $snippet "n" } " is a divisor of " { $snippet "m" } ". This is the same thing as asking if " { $snippet "m" } " is divisible by " { $snippet "n" } "." }
+{ $notes "Returns t for both negative and positive divisors, as well as for trivial and non-trivial divisors." } ;
+
HELP: mod-inv
{ $values { "x" integer } { "n" integer } { "y" integer } }
{ $description "Outputs an integer " { $snippet "y" } " such that " { $snippet "xy = 1 (mod n)" } "." }
[ 1.0 ] [ 0 cosh ] unit-test
[ 0.0 ] [ 1 acosh ] unit-test
-
+
[ 1.0 ] [ 0 cos ] unit-test
[ 0.0 ] [ 1 acos ] unit-test
-
+
[ 0.0 ] [ 0 sinh ] unit-test
[ 0.0 ] [ 0 asinh ] unit-test
-
+
[ 0.0 ] [ 0 sin ] unit-test
[ 0.0 ] [ 0 asin ] unit-test
: verify-gcd ( a b -- ? )
2dup gcd
- [ rot * swap rem ] dip = ;
+ [ rot * swap rem ] dip = ;
[ t ] [ 123 124 verify-gcd ] unit-test
[ t ] [ 50 120 verify-gcd ] unit-test
+[ t ] [ 0 42 divisor? ] unit-test
+[ t ] [ 42 7 divisor? ] unit-test
+[ t ] [ 42 -7 divisor? ] unit-test
+[ t ] [ 42 42 divisor? ] unit-test
+[ f ] [ 42 16 divisor? ] unit-test
+
[ 3 ] [ 5 7 mod-inv ] unit-test
[ 78572682077 ] [ 234829342 342389423843 mod-inv ] unit-test
1067811677921310779
2135623355842621559
[ >bignum ] tri@ ^mod
-] unit-test
\ No newline at end of file
+] unit-test
: lcm ( a b -- c )
[ * ] 2keep gcd nip /i ; foldable
+: divisor? ( m n -- ? )
+ mod 0 = ;
+
: mod-inv ( x n -- y )
[ nip ] [ gcd 1 = ] 2bi
[ dup 0 < [ + ] [ nip ] if ]
GENERIC: sinh ( x -- y ) foldable
-M: complex sinh
+M: complex sinh
>float-rect
[ [ fsinh ] [ fcos ] bi* * ]
[ [ fcosh ] [ fsin ] bi* * ] 2bi rect> ;
! Copyright (C) 2007-2009 Samuel Tardieu.
! See http://factorcode.org/license.txt for BSD license.
-USING: arrays combinators kernel make math math.primes sequences ;
+USING: arrays combinators kernel make math math.functions math.primes sequences ;
IN: math.primes.factors
<PRIVATE
swap ;
: write-factor ( n d -- n' d' )
- 2dup mod zero? [
+ 2dup divisor? [
[ [ count-factor ] keep swap 2array , ] keep
! If the remainder is a prime number, increase d so that
! the caller stops looking for factors.
[ 233168 ] [ euler001 ] unit-test
[ 233168 ] [ euler001a ] unit-test
[ 233168 ] [ euler001b ] unit-test
+[ 233168 ] [ euler001c ] unit-test
-! Copyright (c) 2007 Aaron Schaefer.
+! Copyright (c) 2007, 2008 Aaron Schaefer, Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: kernel math math.ranges sequences project-euler.common ;
+USING: kernel math math.functions math.ranges sequences project-euler.common ;
IN: project-euler.001
! http://projecteuler.net/index.php?section=problems&id=1
! [ euler001b ] 100 ave-time
! 0 ms run / 0 ms GC ave time - 100 trials
+
+: euler001c ( -- answer )
+ 1000 [ { 3 5 } [ divisor? ] with any? ] filter sum ;
+
+! [ euler001c ] 100 ave-time
+! 0 ms ave run time - 0.06 SD (100 trials)
+
SOLUTION: euler001
! Copyright (c) 2007 Aaron Schaefer, Daniel Ehrenberg.
! See http://factorcode.org/license.txt for BSD license.
-USING: hashtables kernel math math.ranges project-euler.common sequences
- sorting sets ;
+USING: hashtables kernel math math.functions math.ranges project-euler.common
+ sequences sorting sets ;
IN: project-euler.004
! http://projecteuler.net/index.php?section=problems&id=4
<PRIVATE
: source-004 ( -- seq )
- 100 999 [a,b] [ 10 mod 0 = not ] filter ;
+ 100 999 [a,b] [ 10 divisor? not ] filter ;
: max-palindrome ( seq -- palindrome )
natural-sort [ palindrome? ] find-last nip ;
! Copyright (c) 2007 Aaron Schaefer.
! See http://factorcode.org/license.txt for BSD license.
-USING: combinators.short-circuit kernel make math math.ranges
-sequences project-euler.common ;
+USING: combinators.short-circuit kernel make math math.functions math.ranges
+ sequences project-euler.common ;
IN: project-euler.014
! http://projecteuler.net/index.php?section=problems&id=14
<PRIVATE
: worth-calculating? ( n -- ? )
- 1- 3 { [ mod 0 = ] [ / even? ] } 2&& ;
+ 1- 3 { [ divisor? ] [ / even? ] } 2&& ;
PRIVATE>
10 99 [a,b] dup cartesian-product [ first2 < ] filter ;
: safe? ( ax xb -- ? )
- [ 10 /mod ] bi@ -roll = rot zero? not and nip ;
+ [ 10 /mod ] bi@ [ = ] dip zero? not and nip ;
: ax/xb ( ax xb -- z/f )
2dup safe? [ [ 10 /mod ] bi@ 2nip / ] [ 2drop f ] if ;
! Copyright (c) 2008 Aaron Schaefer.
! See http://factorcode.org/license.txt for BSD license.
-USING: combinators.short-circuit kernel math math.combinatorics math.parser
- math.ranges project-euler.common sequences sets sorting ;
+USING: combinators.short-circuit kernel math math.functions math.combinatorics
+ math.parser math.ranges project-euler.common sequences sets sorting ;
IN: project-euler.043
! http://projecteuler.net/index.php?section=problems&id=43
<PRIVATE
: subseq-divisible? ( n index seq -- ? )
- [ 1- dup 3 + ] dip subseq 10 digits>integer swap mod zero? ;
+ [ 1- dup 3 + ] dip subseq 10 digits>integer swap divisor? ;
: interesting? ( seq -- ? )
{
--- /dev/null
+USING: project-euler.049 tools.test ;
+IN: project-euler.049.tests
+
+[ 296962999629 ] [ euler049 ] unit-test
--- /dev/null
+! Copyright (c) 2009 Aaron Schaefer.
+! See http://factorcode.org/license.txt for BSD license.
+USING: arrays byte-arrays fry hints kernel math math.combinatorics
+ math.functions math.parser math.primes project-euler.common sequences sets ;
+IN: project-euler.049
+
+! http://projecteuler.net/index.php?section=problems&id=49
+
+! DESCRIPTION
+! -----------
+
+! The arithmetic sequence, 1487, 4817, 8147, in which each of the terms
+! increases by 3330, is unusual in two ways: (i) each of the three terms are
+! prime, and, (ii) each of the 4-digit numbers are permutations of one another.
+
+! There are no arithmetic sequences made up of three 1-, 2-, or 3-digit primes,
+! exhibiting this property, but there is one other 4-digit increasing sequence.
+
+! What 12-digit number do you form by concatenating the three terms in this
+! sequence?
+
+
+! SOLUTION
+! --------
+
+<PRIVATE
+
+: count-digits ( n -- byte-array )
+ 10 <byte-array> [
+ '[ 10 /mod _ [ 1+ ] change-nth dup 0 > ] loop drop
+ ] keep ;
+
+HINTS: count-digits fixnum ;
+
+: permutations? ( n m -- ? )
+ [ count-digits ] bi@ = ;
+
+: collect-permutations ( seq -- seq )
+ [ V{ } clone ] [ dup ] bi* [
+ dupd '[ _ permutations? ] filter
+ [ diff ] keep pick push
+ ] each drop ;
+
+: potential-sequences ( -- seq )
+ 1000 9999 primes-between
+ collect-permutations [ length 3 >= ] filter ;
+
+: arithmetic-terms ( m n -- seq )
+ 2dup [ swap - ] keep + 3array ;
+
+: (find-unusual-terms) ( n seq -- seq/f )
+ [ [ arithmetic-terms ] with map ] keep
+ '[ _ [ peek ] dip member? ] find nip ;
+
+: find-unusual-terms ( seq -- seq/? )
+ unclip-slice over (find-unusual-terms) [
+ nip
+ ] [
+ dup length 3 >= [ find-unusual-terms ] [ drop f ] if
+ ] if* ;
+
+: 4digit-concat ( seq -- str )
+ 0 [ [ 10000 * ] dip + ] reduce ;
+
+PRIVATE>
+
+: euler049 ( -- answer )
+ potential-sequences [ find-unusual-terms ] map sift
+ [ { 1487 4817 8147 } = not ] find nip 4digit-concat ;
+
+! [ euler049 ] 100 ave-time
+! 206 ms ave run time - 10.25 SD (100 trials)
+
+SOLUTION: euler049
! Copyright (c) 2008 Aaron Schaefer.
! See http://factorcode.org/license.txt for BSD license.
-USING: combinators.short-circuit kernel math
- project-euler.common sequences sorting
- grouping ;
+USING: combinators.short-circuit kernel math math.functions
+ project-euler.common sequences sorting grouping ;
IN: project-euler.052
! http://projecteuler.net/index.php?section=problems&id=52
[ number>digits natural-sort ] map all-equal? ;
: candidate? ( n -- ? )
- { [ odd? ] [ 3 mod 0 = ] } 1&& ;
+ { [ odd? ] [ 3 divisor? ] } 1&& ;
: next-all-same ( x n -- n )
dup candidate? [
: (sum-divisors) ( n -- sum )
dup sqrt >integer [1,b] [
- [ 2dup mod 0 = [ 2dup / + , ] [ drop ] if ] each
+ [ 2dup divisor? [ 2dup / + , ] [ drop ] if ] each
dup perfect-square? [ sqrt >fixnum neg , ] [ drop ] if
] { } make sum ;
>lower [ CHAR: a - 1+ ] sigma ;
: cartesian-product ( seq1 seq2 -- seq1xseq2 )
- swap [ swap [ 2array ] with map ] with map concat ;
+ [ [ 2array ] with map ] curry map concat ;
: log10 ( m -- n )
log 10 log / ;
: number>digits ( n -- seq )
[ dup 0 = not ] [ 10 /mod ] produce reverse nip ;
+: number-length ( n -- m )
+ log10 floor 1+ >integer ;
+
: nth-triangle ( n -- n )
dup 1+ * 2 / ;
factor-2s dup [ 1+ ]
[ perfect-square? -1 0 ? ]
[ dup sqrt >fixnum [1,b] ] tri* [
- dupd mod 0 = [ [ 2 + ] dip ] when
+ dupd divisor? [ [ 2 + ] dip ] when
] each drop * ;
! These transforms are for generating primitive Pythagorean triples
[ drop in get vocab (>>main) ]
[ [ . ] swap prefix (( -- )) define-declared ]
2bi ;
-
project-euler.037 project-euler.038 project-euler.039 project-euler.040
project-euler.041 project-euler.042 project-euler.043 project-euler.044
project-euler.045 project-euler.046 project-euler.047 project-euler.048
- project-euler.052 project-euler.053 project-euler.055 project-euler.056
- project-euler.057 project-euler.059 project-euler.067 project-euler.071
- project-euler.073 project-euler.075 project-euler.076 project-euler.079
- project-euler.092 project-euler.097 project-euler.099 project-euler.100
- project-euler.116 project-euler.117 project-euler.134 project-euler.148
- project-euler.150 project-euler.151 project-euler.164 project-euler.169
- project-euler.173 project-euler.175 project-euler.186 project-euler.190
- project-euler.203 project-euler.215 ;
+ project-euler.049 project-euler.052 project-euler.053 project-euler.055
+ project-euler.056 project-euler.057 project-euler.059 project-euler.067
+ project-euler.071 project-euler.073 project-euler.075 project-euler.076
+ project-euler.079 project-euler.092 project-euler.097 project-euler.099
+ project-euler.100 project-euler.116 project-euler.117 project-euler.134
+ project-euler.148 project-euler.150 project-euler.151 project-euler.164
+ project-euler.169 project-euler.173 project-euler.175 project-euler.186
+ project-euler.190 project-euler.203 project-euler.215 ;
IN: project-euler
<PRIVATE
projects / factor.git / commitdiff