From 2bdcba57319a12e5f5b2b619338b421420ab7776 Mon Sep 17 00:00:00 2001 From: Eric Mertens Date: Tue, 15 Apr 2008 23:09:23 -0700 Subject: [PATCH 1/4] Add solution for project-euler.117 --- extra/project-euler/117/117.factor | 42 ++++++++++++++++++++++++++++++ 1 file changed, 42 insertions(+) create mode 100644 extra/project-euler/117/117.factor diff --git a/extra/project-euler/117/117.factor b/extra/project-euler/117/117.factor new file mode 100644 index 0000000000..5056560a85 --- /dev/null +++ b/extra/project-euler/117/117.factor @@ -0,0 +1,42 @@ +! Copyright (c) 2008 Eric Mertens +! See http://factorcode.org/license.txt for BSD license. +USING: kernel math splitting sequences ; + +IN: project-euler.117 + +! http://projecteuler.net/index.php?section=problems&id=117 + +! DESCRIPTION +! ----------- + +! Using a combination of black square tiles and oblong tiles chosen +! from: red tiles measuring two units, green tiles measuring three +! units, and blue tiles measuring four units, it is possible to tile a +! row measuring five units in length in exactly fifteen different ways. + +! How many ways can a row measuring fifty units in length be tiled? + +! SOLUTION +! -------- + +! This solution uses a simple dynamic programming approach using the +! following recurence relation + +! ways(i) = 1 | i <= 0 +! ways(i) = ways(i-4) + ways(i-3) + ways(i-2) + ways(i-1) + + + +: (euler117) ( n -- m ) + V{ 1 } clone tuck [ next ] curry times peek ; + +: euler117 ( -- m ) + 50 (euler117) ; From 303f9a34506b1c2a02c43681ce861fe93f2d3c1a Mon Sep 17 00:00:00 2001 From: Eric Mertens Date: Wed, 16 Apr 2008 00:04:05 -0700 Subject: [PATCH 2/4] Add project-euler.116 --- extra/project-euler/116/116.factor | 55 ++++++++++++++++++++++++++++++ 1 file changed, 55 insertions(+) create mode 100644 extra/project-euler/116/116.factor diff --git a/extra/project-euler/116/116.factor b/extra/project-euler/116/116.factor new file mode 100644 index 0000000000..d48cdf175c --- /dev/null +++ b/extra/project-euler/116/116.factor @@ -0,0 +1,55 @@ +! Copyright (c) 2008 Eric Mertens +! See http://factorcode.org/license.txt for BSD license. +USING: kernel math math.ranges sequences sequences.lib ; + +IN: project-euler.116 + +! http://projecteuler.net/index.php?section=problems&id=116 + +! DESCRIPTION +! ----------- + +! A row of five black square tiles is to have a number of its tiles replaced +! with coloured oblong tiles chosen from red (length two), green (length +! three), or blue (length four). + +! If red tiles are chosen there are exactly seven ways this can be done. +! If green tiles are chosen there are three ways. +! And if blue tiles are chosen there are two ways. + +! Assuming that colours cannot be mixed there are 7 + 3 + 2 = 12 ways of +! replacing the black tiles in a row measuring five units in length. + +! How many different ways can the black tiles in a row measuring fifty units in +! length be replaced if colours cannot be mixed and at least one coloured tile +! must be used? + +! SOLUTION +! -------- + +! This solution uses a simple dynamic programming approach using the +! following recurence relation + +! ways(n,_) = 0 | n < 0 +! ways(0,_) = 1 +! ways(n,i) = ways(n-i,i) + ways(n-1,i) +! solution(n) = ways(n,1) - 1 + ways(n,2) - 1 + ways(n,3) - 1 + + + +: (euler116) ( length -- permutations ) + 3 [1,b] [ ways ] with sigma ; + +: euler116 ( -- permutations ) + 50 (euler116) ; From 3483317cfb146f803b99416c28fb7cc45d1b31e1 Mon Sep 17 00:00:00 2001 From: Eric Mertens Date: Wed, 16 Apr 2008 02:25:38 -0700 Subject: [PATCH 3/4] Add project-euler.150 --- extra/project-euler/150/150.factor | 46 ++++++++++++++++++++++++++++++ 1 file changed, 46 insertions(+) create mode 100644 extra/project-euler/150/150.factor diff --git a/extra/project-euler/150/150.factor b/extra/project-euler/150/150.factor new file mode 100644 index 0000000000..3bd145d53c --- /dev/null +++ b/extra/project-euler/150/150.factor @@ -0,0 +1,46 @@ +USING: kernel math math.ranges math.parser sequences io locals namespaces ; + +IN: project-euler.150 + +: next-t ( t -- t' ) + 615949 * 797807 + 1 20 shift rem ; inline + +: next-s ( t -- s ) + 1 19 shift - ; inline + +: generate ( -- seq ) + 0 500500 [ drop next-t dup next-s ] map nip ; + +: start-index ( i -- n ) + dup 1- * 2/ ; inline + +: partial-sums ( seq -- seq ) + 0 [ + ] accumulate swap suffix ; inline + +: as-triangle ( i seq -- slices ) + swap [1,b] [ [ start-index dup ] keep + rot ] with map ; + +: sums-triangle ( -- seqs ) + 1000 generate as-triangle [ partial-sums ] map ; + +SYMBOL: best + +: check-best ( i -- ) + best [ min ] change ; inline + +:: (euler150) ( m -- n ) + [ [let | table [ sums-triangle ] | + 0 best set + m [| x | + x 1+ [| y | + 1000 x - [| z | + x z + table nth + [ y z + 1+ swap nth ] [ y swap nth ] bi - + ] map partial-sums infimum check-best + ] each + ] each + ] + best get ] with-scope ; + +: euler150 ( -- n ) + 1000 (euler150) ; From a25c7e1842161a8ed42407f8d3ef589a35e8546c Mon Sep 17 00:00:00 2001 From: Eric Mertens Date: Wed, 16 Apr 2008 10:30:03 -0700 Subject: [PATCH 4/4] Improve project-euler.150 --- extra/project-euler/150/150.factor | 56 ++++++++++++++---------------- 1 file changed, 27 insertions(+), 29 deletions(-) diff --git a/extra/project-euler/150/150.factor b/extra/project-euler/150/150.factor index 3bd145d53c..5b22a1b9f6 100644 --- a/extra/project-euler/150/150.factor +++ b/extra/project-euler/150/150.factor @@ -1,46 +1,44 @@ -USING: kernel math math.ranges math.parser sequences io locals namespaces ; - +! Copyright (c) 2008 Eric Mertens +! See http://factorcode.org/license.txt for BSD license. +USING: kernel math sequences locals ; IN: project-euler.150 -: next-t ( t -- t' ) - 615949 * 797807 + 1 20 shift rem ; inline + ] with map ; +: generate ( n quot -- seq ) + [ drop ] swap compose map ; inline -: sums-triangle ( -- seqs ) - 1000 generate as-triangle [ partial-sums ] map ; +: map-infimum ( seq quot -- min ) + [ min ] compose 0 swap reduce ; inline -SYMBOL: best -: check-best ( i -- ) - best [ min ] change ; inline +! triangle generator functions + +: next ( t -- new-t s ) + 615949 * 797807 + 1 20 shift mod dup 1 19 shift - ; inline + +: sums-triangle ( -- seq ) + 0 1000 [ 1+ [ next ] generate partial-sums ] map nip ; + +PRIVATE> :: (euler150) ( m -- n ) - [ [let | table [ sums-triangle ] | - 0 best set + [let | table [ sums-triangle ] | m [| x | - x 1+ [| y | - 1000 x - [| z | + x 1+ [| y | + m x - [| z | x z + table nth - [ y z + 1+ swap nth ] [ y swap nth ] bi - - ] map partial-sums infimum check-best - ] each - ] each - ] - best get ] with-scope ; + [ y z + 1+ swap nth ] + [ y swap nth ] bi - + ] map partial-sums infimum + ] map-infimum + ] map-infimum + ] ; : euler150 ( -- n ) 1000 (euler150) ;