「数学の挑戦！！！」というものに取り組んでみた

雑記


出題者の言う仮説なるものはよくわからないが、解いてみた。

問題と結果表示用の関数

(setf problem '(
                (2 3 4 15 12)
                (3 4 5 28 20)
                (4 5 6 45 30)
                (5 6 7 66 42)
                (6 7 8 ?x 56)
                ))

(defun fn-unless-equal (fn a b)
  (unless (equal a b)
    (funcall fn a b)))

(defun list-unless-equal (a b)
  (fn-unless-equal #'list a b))

(defun cons-unless-equal (a b)
  (fn-unless-equal #'cons a b))

(defun my-set-difference (a b)
  (first (remove-if #'null (mapcar #'list-unless-equal a b))))

(defun get-pair (a b)
  (remove-if #'null (mapcar #'cons-unless-equal a b)))

(defun get-result (fn list)
  (destructuring-bind (a b)
      (my-set-difference list
                         (mapcar fn list))
    (get-pair a b)))

解法1: 1-2行目の値を用いて3-5行目の値を求める

(defun resolver1 (x)
  (destructuring-bind (a b . _)
      x
    (let* (
           (c (+ b (+ (- a) b)))
           (d (* b (+ a b)))
           (e (* b (+ c)))
           )
      (list a b c d e))))

(mapcar #'resolver1 problem)
;; =>
;; '((2 3 4 15 12)
;;   (3 4 5 28 20)
;;   (4 5 6 45 30)
;;   (5 6 7 66 42)
;;   (6 7 8 91 56))

(get-result #'resolver1 problem)
;; =>((?X . 91))

解法2: 1-3列目の値を用いて4-5列目の値を求める

こう解くのは、4列目と5列目の各値の公約数が2列目の値であることに気づいた人だろうか。

(defun resolver2 (x)
  (destructuring-bind (a b c . _)
      x
    (let ((d (* b (+ a b)))
          (e (* b (+ c))))
      (list a b c d e))))

(mapcar #'resolver2 problem)
;; =>
;; '((2 3 4 15 12)
;;   (3 4 5 28 20)
;;   (4 5 6 45 30)
;;   (5 6 7 66 42)
;;   (6 7 8 91 56))

(get-result #'resolver2 problem)
;; =>((?X . 91))

解法3: 1,2,3,5列目の値を用いて4列目の値を求める

上記の解法1,2にたどり着いた人ならばこの解法に気づくだろう。

(defun resolver3 (x)
  (destructuring-bind (a b c _ e)
      x
    (let ((d (* (+ a b) (/ e c))))
      (list a b c d e))))

(mapcar #'resolver3 problem)
;; =>
;; '((2 3 4 15 12)
;;   (3 4 5 28 20)
;;   (4 5 6 45 30)
;;   (5 6 7 66 42)
;;   (6 7 8 91 56))

(get-result #'resolver3 problem)
;; =>((?X . 91))

行数から各列の値を求める

行番号から各列の値を直接求めることもできる。ここでは二次方程式と因数分解を念頭において計算をしてみた。

(defun resolver4 ()
  (loop for x
       from 1 to 5
       collect (let ((a (+ x 1))
                     (b (+ x 2))
                     (c (+ x 3))
                     ;; (d (+ (* 2 x x) (* 7 x) 6))
                     (d (* (+ (* 2 x) 3) (+ x 2)))
                     ;; (e (+ (* x x) (* 5 x) 6))
                     (e (* (+ x 3) (+ x 2)))
                     )
                 (list a b c d e))))

(resolver4)
;; =>
;; '((2 3 4 15 12)
;;   (3 4 5 28 20)
;;   (4 5 6 45 30)
;;   (5 6 7 66 42)
;;   (6 7 8 91 56))

解法5: 4列目の値だけで4列目の値を求める

階差数列に気づいた人はこのように解くと思う。

(defun transpose (m)
  (apply #'mapcar #'list m))

(transpose problem)
;; =>
;; '((2 3 4 5 6)
;;   (3 4 5 6 7)
;;   (4 5 6 7 8)
;;   (15 28 45 66 ?X)
;;   (12 20 30 42 56))


(defun diff-seq (seq)
  "(a2 - a1), (a3 - a2), ..."
  (let ((start (first seq)))
    (loop for x in (rest seq)
       for y = start then z
       for z = x
       collect (if (numberp x) (- x y) '?Y))))

(mapcar #'diff-seq (transpose problem))
;; =>
;; '((1 1 1 1)
;;   (1 1 1 1)
;;   (1 1 1 1)
;;   (13 17 21 ?Y)
;;   (8 10 12 14))          


(defun info-of-arithmetic-progression (seq)
  "(list :start a1 :step d)"
  (destructuring-bind (a1 a2 . _)
      seq
    (list :start a1
          :step (- a2 a1))))


(let ((list (mapcar #'diff-seq (transpose problem))))
  (values
   list
   (mapcar #'info-of-arithmetic-progression
           list)))
;; =>
;; '((1 1 1 1)
;;   (1 1 1 1)
;;   (1 1 1 1)
;;   (13 17 21 ?Y)
;;   (8 10 12 14))
;; '((:START 1 :STEP 0)
;;   (:START 1 :STEP 0)
;;   (:START 1 :STEP 0)
;;   (:START 13 :STEP 4)
;;   (:START 8 :STEP 2))


(defun acc-seq (start step-seq)
  "ex.
(acc-seq 1 '(2 2 2 2)) ; => (1 3 5 7 9)
(acc-seq 1 '(10 100 1000)) ; => (1 11 111 1111)"
  (reverse (maplist #'(lambda (x) (apply #'+ start x))
                    (reverse (cons 0 step-seq)))))


(ql:quickload :alexandria)
;; =>
;; To load "alexandria":
;;   Load 1 ASDF system:
;;     alexandria
; Loading "alexandria"


(let* ((list (loop for a in (transpose problem)
                when (member '?x a)
                return a))
       (start (first list))
       (diff-of-seq (diff-seq list))
       (iota-result (apply #'alexandria:iota 4 (info-of-arithmetic-progression diff-of-seq))))
  (values diff-of-seq
          (info-of-arithmetic-progression diff-of-seq)
          iota-result
          (acc-seq start iota-result)))
;; =>
;; (13 17 21 ??)
;; (:START 13 :STEP 4)
;; (13 17 21 25)
;; (15 28 45 66 91)


(defun resolver5 (list)
  (let* ((start (first list))
         (diff-of-seq (diff-seq list))
         (n (length (rest list)))
         (iota-result (apply #'alexandria:iota n (info-of-arithmetic-progression diff-of-seq)))
         )
    (acc-seq start iota-result)))



(transpose (mapcar #'resolver5 (transpose problem)))
;; =>
;; '((2 3 4 15 12)
;;   (3 4 5 28 20)
;;   (4 5 6 45 30)
;;   (5 6 7 66 42)
;;   (6 7 8 91 56))

(get-result #'resolver5 (transpose problem))
;; =>((?X . 91))