Add project-euler.061

diff --git a/extra/project-euler/061/061-tests.factor b/extra/project-euler/061/061-tests.factor
new file mode 100644 (file)
index 0000000..dda3ca1
--- /dev/null
+++ b/extra/project-euler/061/061-tests.factor
@@ -0,0 +1,5 @@
+USING: project-euler.061 tools.test ;
+
+IN: project-euler.061
+
+{ 28684 } [ euler061 ] unit-test

diff --git a/extra/project-euler/061/061.factor b/extra/project-euler/061/061.factor
new file mode 100644 (file)
index 0000000..7be02b6
--- /dev/null
+++ b/extra/project-euler/061/061.factor
@@ -0,0 +1,84 @@
+! Copyright (C) 2023 Giftpflanze
+! See https://factorcode.org/license.txt for BSD license
+
+USING: arrays assocs assocs.extras grouping kernel math
+project-euler.common ranges sequences sequences.extras ;
+
+IN: project-euler.061
+
+! https://projecteuler.net/problem=61
+
+! DESCRIPTION
+! -----------
+
+! Triangle, square, pentagonal, hexagonal, heptagonal, and
+! octagonal numbers are all figurate (polygonal) numbers and are
+! generated by the following formulae:
+
+! Triangle   P(3,n) = n(n+1)/2  1, 3, 6, 10, 15, ...
+! Square     P(4,n) = n²        1, 4, 9, 16, 25, ...
+! Pentagonal P(5,n) = n(3n-1)/2 1, 5, 12, 22, 35, ...
+! Hexagonal  P(6,n) = n(2n-1)   1, 6, 15, 28, 45, ...
+! Heptagonal P(7,n) = n(5n-3)/2 1, 7, 18, 34, 55, ...
+! Octagonal  P(8,n) = n(3n-2)   1, 8, 21, 40, 65, ...
+
+! The ordered set of three 4-digit numbers: 8128, 2882, 8281,
+! has three interesting properties.
+
+! 1. The set is cyclic, in that the last two digits of each
+! number is the first two digits of the next number (including
+! the last number with the first).
+
+! 2. Each polygonal type: triangle (P(3,127) = 8128), square
+! (P(4,91) = 8281), and pentagonal (P(5,44) = 2882), is
+! represented by a different number in the set.
+
+! 3. This is the only set of 4-digit numbers with this property.
+!
+! Find the sum of the only ordered set of six cyclic 4-digit
+! numbers for which each polygonal type: triangle, square,
+! pentagonal, hexagonal, heptagonal, and octagonal, is
+! represented by a different number in the set.
+
+
+! SOLUTION
+! --------
+
+! https://en.wikipedia.org/wiki/Polygonal_number#Formula
+! nth s-gonal number P(s,n) = [(s-2)n²-(s-4)n]/2
+: nth-polygon ( n s -- p )
+    [ [ sq ] dip 2 - * ] [ 4 - * ] 2bi - 2 / ;
+
+: (4-digit-polygons) ( s -- seq )
+    [ V{ } clone 1 ] dip
+    [ 2dup nth-polygon dup 9999 > ] [
+        dup 1000 >= [ dupd 2array reach push ] [ drop ] if
+        [ 1 + ] dip
+    ] until 3drop ;
+
+: 4-digit-polygons ( -- seq )
+    3 8 [a..b] [ (4-digit-polygons) ] map-concat ;
+
+: cycle? ( chain -- ? )
+    2 circular-clump [
+        values first2 [ 100 mod ] [ 100 /i ] bi* =
+    ] all? ;
+
+: links ( polygons chain -- chains )
+    [ keys '[ _ member? ] reject-keys ] keep
+    tuck values last 100 mod '[ 100 /i _ = ] filter-values
+    [ suffix ] with map ;
+
+: find-cycle ( polygons chain length -- chain )
+    2dup [ length ] dip = [
+        drop nip [ cycle? ] keep and
+    ] [
+        [ dupd links ] dip '[ _ find-cycle ] with map-find drop
+    ] if ;
+
+: euler061 ( -- n )
+    4-digit-polygons dup [ 8 = ] filter-keys [
+        1array 6 find-cycle
+    ] with map-find drop values sum ;
+
+SOLUTION: euler061