Project Euler

Project Euler Problem 61

steloflute 2012. 10. 4. 23:02
http://projecteuler.net/problem=61

Problem 61

16 January 2004

Triangle, square, pentagonal, hexagonal, heptagonal, and octagonal numbers are all figurate (polygonal) numbers and are generated by the following formulae:

Triangle   P3,n=n(n+1)/2   1, 3, 6, 10, 15, ...
Square   P4,n=n2   1, 4, 9, 16, 25, ...
Pentagonal   P5,n=n(3n−1)/2   1, 5, 12, 22, 35, ...
Hexagonal   P6,n=n(2n−1)   1, 6, 15, 28, 45, ...
Heptagonal   P7,n=n(5n−3)/2   1, 7, 18, 34, 55, ...
Octagonal   P8,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 (P3,127=8128), square (P4,91=8281), and pentagonal (P5,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.


Answer:
28684



* Racket


#lang racket
(define-syntax-rule (++ x)
  (set! x (add1 x)))

(define (triangle n) (/ (* n (+ n 1)) 2))
(define (square n) (sqr n))
(define (pentagonal n) (/ (* n (- (* 3 n) 1)) 2))
(define (hexagonal n) (* n (- (* 2 n) 1)))
(define (heptagonal n) (/ (* n (- (* 5 n) 3)) 2))
(define (octagonal n) (* n (- (* 3 n) 2)))

(define (filter-4digit proc)
  (define n 1)
  (define r '()) 
  (let loop ()
    (define v (proc n))
    (when (<= v 9999)
      (when (>= v 1000) (set! r (cons v r)))
      (++ n)
      (loop)))
  r)

(define sided3 (filter-4digit triangle))
(define sided4 (filter-4digit square))
(define sided5 (filter-4digit pentagonal))
(define sided6 (filter-4digit hexagonal))
(define sided7 (filter-4digit heptagonal))
(define sided8 (filter-4digit octagonal))

(define (low n) (modulo n 100))
(define (hi n) (quotient n 100))

(define sided (list sided3 sided4 sided5 sided6 sided7 sided8))

; Las Vegas algorithm
(let/ec break
  (let loop ()
    (set! sided (shuffle sided))
    (for ([x3 (first sided)])
      (for ([x4 (second sided)])
        (when (= (low x3) (hi x4))
          (for ([x5 (third sided)])
            (when (= (low x4) (hi x5))
              (for ([x6 (fourth sided)])
                (when (= (low x5) (hi x6))
                  (for ([x7 (fifth sided)])
                    (when (= (low x6) (hi x7))
                      (for ([x8 (sixth sided)])
                        (when (and (= (low x7) (hi x8))
                                   (= (low x8) (hi x3)))
                          (displayln
                           (list (list x3 x4 x5 x6 x7 x8) (+ x3 x4 x5 x6 x7 x8)))
                          (break))))))))))))
    (loop)))


((2512 1281 8128 2882 8256 5625) 28684)






'Project Euler' 카테고리의 다른 글

Project Euler Problem 63  (0) 2012.10.05
Project Euler Problem 62  (0) 2012.10.05
(Haskell) Project Euler Solutions  (0) 2012.06.12
Project Euler Problem 54  (0) 2012.06.09
Project Euler Problem 52  (0) 2012.06.09