Project Euler

[ホーム](https://redmine.noppi.jp) - [[Wiki|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つの項はそれぞれ素数である.

1. 各項は他の項の置換で表される.

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

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

```scheme

(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)

```