ホーム - Project Euler

Problem 49¶

Prime Permutations¶

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?

素数数列¶

項差3330の等差数列$1487, 4817, 8147$は次の2つの変わった性質を持つ.

1. 3つの項はそれぞれ素数である.
2. 各項は他の項の置換で表される.

1, 2, 3桁の素数にはこのような性質を持った数列は存在しないが, 4桁の増加列にはもう1つ存在する.

それではこの数列の3つの項を連結した12桁の数を求めよ.

(import (scheme base)
        (gauche base)
        (scheme sort))

(define (prime? num)
  (assume (exact-integer? num))
  (assume (positive? num))
  (cond
    [(= num 1) #f]
    [(= num 2) #t]
    [(even? num) #f]
    [(= num 3) #t]
    [(zero? (mod num 3)) #f]
    [else
      (let loop ([n6-1 5])
        (let ([n6+1 (+ n6-1 2)])
          (cond
            [(< num
                (* n6-1 n6-1))
             #t]
            [(zero? (mod num n6-1))
             #f]
            [(< num
                (* n6+1 n6+1))
             #t]
            [(zero? (mod num n6+1))
             #f]
            [else
              (loop (+ n6+1 4))])))]))

(define (integer->list num)
  (assume (exact-integer? num))
  (assume (<= 0 num))
  (if (zero? num)
    '(0)
    (let loop ([rest num] [lis '()])
      (if (zero? rest)
        lis
        (loop (div rest 10)
              (cons (mod rest 10)
                    lis))))))

(define (first-delete n lis)
  (let loop ([rest lis] [deleted #f] [result '()])
    (cond
      [(null? rest) (reverse result)]
      [(boolean deleted)
       (loop (cdr rest) deleted (cons (car rest)
                                      result))]
      [(= n (car rest))
       (loop (cdr rest) #t result)]
      [else
        (loop (cdr rest) deleted (cons (car rest)
                                       result))])))

(define (permutation-4digits num)
  (assume (exact-integer? num))
  (assume (<= 1000 num 9999))
  (list-sort
    <
    (delete-duplicates
      (let loop ([index 1]
                 [rest (integer->list num)]
                 [current 0]
                 [lis '()])
        (let ([next-loop (^[rest-lis]
                           (fold-right (^[n lis]
                                         (loop (+ index 1)
                                               (first-delete n rest)
                                               (+ (* current 10)
                                                  n)
                                               lis))
                                       lis
                                       rest-lis))])
          (cond
            [(null? rest) (cons current lis)]
            [(= index 1)
             (next-loop (filter (complement zero?) rest))]
            [else (next-loop rest)]))))))

(define prime-4digits
  (filter prime? (iota 9000 1000)))

(define perm-4digits
  (delete-duplicates
    (map permutation-4digits prime-4digits)))

(define prime-perm-4digits
  (map (cut filter prime? <>)
       perm-4digits))

(define more3kind-prime-perm-4digits
  (filter (^[lis] (<= 3 (length lis)))
          prime-perm-4digits))

(define valid-sequence-list
  (fold (^[lis result]
          (let ([count (length lis)])
            (let loop1 ([i 0] [result result])
              (if (<= count (+ i 1))
                result
                (let loop2 ([j (+ i 1)] [result result])
                  (if (<= count j)
                    (loop1 (+ i 1) result)
                    (let* ([value-i (list-ref lis i)]
                           [value-j (list-ref lis j)]
                           [value-k (+ value-j
                                       (- value-j
                                          value-i))])
                      (if (find (cut = value-k <>) lis)
                        (loop2 (+ j 1)
                               (cons (cons* value-i value-j value-k)
                                     result))
                        (loop2 (+ j 1) result)))))))))
        '()
        more3kind-prime-perm-4digits))

(define answer-49
  (let ([result (car (filter (^[lis] (not (= (car lis) 1487)))
                             valid-sequence-list))])
    (+ (* (car result)
          1_0000_0000)
       (* (cadr result)
          1_0000)
       (cddr result))))

(format #t "49: ~d~%" answer-49)