読者です 読者をやめる 読者になる 読者になる

Get a Rectangular Field

common lisp algorithm

本業の方が忙しくて、なかなかまとまったことをする時間がないので、軽いものを一つ。

「Get a Rectangular Field」というパズルのような問題を解いてみる。
問題の説明等はここを参照。


途中経過とかは全て飛ばして、とりあえず最初に思いついた解答(を若干整理したもの)

;; 5x5のマップを読み込む
(defun read-map (in)
  (loop repeat 5 collect  
    (loop repeat 5 collect
      (= 1 (read in)))))

;; 与えられたrowから、可能な(横軸の)辺のリストを取得する
;; 戻り値の形式は、'((辺の開始位置 辺の終端位置) ...)
;; ex] '(1 1 0 1 1) => '((0 1) (0 2) (1 2) (3 4) (3 5) (4 5))
(defun possible-x-edges (row)
  (loop FOR beg FROM 0 BELOW 5 APPEND
    (loop FOR end FROM beg BELOW 5 
          WHILE    (nth end row)      
          COLLECT `(,beg ,(1+ end)))))

;; 長方形の縦軸の辺の長さを計算する
;; begとendは、横軸の辺の開始位置と終端位置
(defun y-edge-length (below-rows beg end)
  (1+ (or (position-if-not
           (lambda (row) (every #'identity (subseq row beg end)))
           below-rows)
          (length below-rows))))

;; マップ内にある最大の長方形のサイズを求める
(defun largest-rectangle-size (map &aux (size 0))
  (loop FOR (row . below-rows) ON map DO
    (loop FOR (beg end) IN (possible-x-edges row) DO
      (let* ((x-len (- end beg))
             (y-len (y-edge-length below-rows beg end)))
        (setf size (max size (* x-len y-len))))))
  size)

;;;;;;
;;; 例
> (largest-rectangle-size (read-map nil))
;; 入力
1 1 0 1 0
0 1 1 1 1
1 0 1 0 1
0 1 1 1 0
0 1 1 0 0

;; 結果
--> 4

;;;;;;
;;; 上のサイトにある入力データを扱う場合
(with-open-file (in "input.txt")  ; 入力データは"input.txt"として保存しておく 
  (dotimes (i (read in))
    (print (largest-rectangle-size (read-map in)))))

総当たりテストを行うだけの単純な解法。
性能は著しく悪い*1はずなので、もっと良い方法を思いついたら追記で付け足していく予定。

追記1(2009/12/03)

次に考えた解答。
それぞれのマスの左右に隣接する1の数をあらかじめ計算しておくことで、O(N)ステップ*2で解を求められる。※ Nはマップのサイズ(マス目の数)

;;;;;;;;;;;;;;;;;
;;;; 定数と構造体
;; ハードコーディングはやめて定数で定義しておく
(defconstant SQUARE-SIDE-LENGTH 5)
(defconstant SQUARE-SIZE `(,SQUARE-SIZE-LENGTH ,SQUARE-SIZE-LENGTH))

;; 土地(それぞれのマス目)用の構造体
(defstruct (field (:conc-name ""))
  (fertile? nil :type boolean)  ; 肥沃な土地かどうか   ※ マスの値が1なら肥沃
  (lft-len  0   :type fixnum)   ; 左に連接する肥沃な土地(field)の数
  (rgt-len  0   :type fixnum))  ; 右に連接する肥沃な土地(field)の数

(defmethod print-object ((obj field) stream)
  (with-slots (fertile? lft-len rgt-len) obj
    (format stream "[~d~~~:[_~;#~]~~~d]" lft-len fertile? rgt-len)))

;;;;;;;;
;;;; 関数定義
;; マップ読込み  ※ 今回はリストではなく配列(二次元配列)を使う
(defun read-map (&optional in)
  (let ((map (make-array SQUARE-SIZE)))
    (dotimes (y SQUARE-SIDE-LENGTH)
      (dotimes (x SQUARE-SIDE-LENGTH)
        (setf (aref map y x) (= 1 (read in))))) ; '1'なら肥沃
    map))

;; 以下の三つの関数で、read-mapで読み込んだbool配列を、field配列に変換する
(defun conv-to-field-map (row-map)
  (let ((map (make-array SQUARE-SIZE :initial-element nil)))
    (dotimes (y SQUARE-SIDE-LENGTH)
      (dotimes (x SQUARE-SIDE-LENGTH)
        (set-field map row-map y x)))
    map))

(defun set-field (map row-map y x)
  (unless (aref map y x)  ; まだ初期化されていない場合は、field計算/セットする
    (let ((end (first-sandy-position row-map y x)))
      (if (= x end)
          (setf (aref map y x) (make-field)) ; (y x) is sandy field
        (loop FOR cur FROM x BELOW end DO
          (setf (aref map y cur)
                (make-field :fertile? t
                            :lft-len  (- cur x)
                            :rgt-len  (- end cur 1))))))))

(defun first-sandy-position (map y start-x &aux (pos start-x))
  (loop FOR x FROM start-x BELOW SQUARE-SIZE-LENGTH
        WHILE (aref map y x)  ; Is (y x) fertile?
        DO    (incf pos))
  pos)

;; 例
> (read-map)
;; ↓ 入力データ
1 1 0 1 0
0 1 1 1 1
1 0 1 0 1
0 1 1 1 0
0 1 1 0 0
--> #2A((T T NIL T NIL)
        (NIL T T T T)
        (T NIL T NIL T)
        (NIL T T T NIL)
        (NIL T T NIL NIL))

> (conv-to-field-map *)
--> #2A(([0~#~1] [1~#~0] [0~_~0] [0~#~0] [0~_~0]) ; fieldの出力フォーマットは上のprint-objectを参照
        ([0~_~0] [0~#~3] [1~#~2] [2~#~1] [3~#~0])
        ([0~#~0] [0~_~0] [0~#~0] [0~_~0] [0~#~0])
        ([0~_~0] [0~#~2] [1~#~1] [2~#~0] [0~_~0])
        ([0~_~0] [0~#~1] [1~#~0] [0~_~0] [0~_~0]))


;; ユーティリティマクロ
(defmacro minf (x &rest xs) `(setf ,x (min ,x ,@xs)))
(defmacro maxf (x &rest xs) `(setf ,x (max ,x ,@xs)))

;; マップ内にある最大の長方形のサイズを求める
(defun largest-rectangle-size (map &aux (largest-size 0))
  (let ((map (conv-to-field-map map)))
    (dotimes (x SQUARE-SIZE-LENGTH)
      (let ((height 0)
            (min-lft-width SQUARE-SIZE-LENGTH)
            (min-rgt-width SQUARE-SIZE-LENGTH))
        (dotimes (y SQUARE-SIZE-LENGTH)
          (if (fertile? #1=(aref map y x))
              ;; 肥沃な土地の場合は、その時点での最大の長方形のサイズを計算する
              ;; 長方形の上端は、(同じx軸で)連接する一番上の土地(y)に固定
              (progn (incf height)
                     (minf min-lft-width (lft-len #1#)) ;; 幅は狭くなることはあっても広くなることはない
                     (minf min-rgt-width (rgt-len #1#))
                     ;; 必要なら最大値を更新
                     (maxf largest-size (* height (+ min-lft-width 1 min-rgt-width))))
            ;; sandyな土地に出くわした場合は、全ての値を初期化する
            (setf height 0
                  min-lft-width SQUARE-SIZE-LENGTH
                  min-rgt-width SQUARE-SIZE-LENGTH))))))
  largest-size)

;;;;;;
;;; 例
> (largest-rectangle-size (read-map))
;; 入力
1 1 0 1 0
0 1 1 1 1
1 0 1 0 1
0 1 1 1 0
0 1 1 0 0

;; 結果
--> 4

追記2(2009/12/04)

「Program Promenade 最大長方形の面積」というPDFを発見*3
この問題に対する四種類の解法が解説されていて*4、結構面白い。
とくに三番目の「ナノピコ教室流」(?)は、この記事の筆者も「これは実によくできたプログラムである」と書いているが、その通りだと思う。

追記3(2009/12/05)

既に書いたように上のPDFの三番目の解法は、確かに面白いと思うのだが、そのCプログラムは僕には正直分かりにくい。
今は分かった気になっているが、しばらくしたら忘れて、また読解に苦労しそうなので、理解を深める意味も兼ねて、lispコードに翻訳して残しておくことにした。

下のコードとPDFの解説文を参照すれば、もし忘れたとしてけっこうすぐに思い出せる(はず)

;;;; 'http://www.ipsj.or.jp/07editj/promenade/4304.pdf'内の三番目の解法のcommon lispへの翻訳
;;;; この方法は基本的には、
;;;;  1] 上の行から順番にマップを走査して、
;;;;  2] 現在走査している行の、各x位置での長方形の上端/左端を記憶しておき、
;;;;  3] xが長方形の右端に達したら、
;;;;  4] 2で保持しておいた情報と照合して、長方形のサイズを計算する  ※ 長方形の下端は、現在走査しているマップのy(縦の)位置
;;;;    というような処理を行っている

(defun read-map (&optional in)
  (let ((map (make-array '(7 7) :initial-element nil)))
    (loop FOR y FROM 1 TO 5 DO
      (loop FOR x FROM 1 TO 5 DO
        (setf (aref map y x) (= 1 (read in)))))
    map))

;; マップの要素(y x)が、長方形の要素になり得るかどうかを判定するための述語関数
;; 用語は'http://www.acm-japan.org/past-icpc/domestic2001/A.htm'の問題文に由来
(defun fertile? (map y x) (aref map y x))
(defun sandy?   (map y x) (not (fertile? map y x)))
  
(defmacro maxf (x &rest xs) `(setf ,x (max ,x ,@xs)))

;; 長方形の上端/左端の位置を保持するための構造体
(defstruct corner (top  0) (left 0))
  
(defun make-array2 (size generator)
  (coerce (loop REPEAT size COLLECT (funcall generator)) 'vector))

;; 各x位置での長方形の角(上端と左端)の位置を保持する配列の初期化と、
;; その配列へのアクセサ定義を行うマクロ
(defmacro with-corner-array ((map-size) &body body)
  (let ((ary (gensym)))
    `(let ((,ary (make-array2 (+ ,map-size 2) #'make-corner)))
       (macrolet ((top-side-of  (x) `(corner-top  (aref ,',ary ,x)))
                  (left-side-of (x) `(corner-left (aref ,',ary ,x))))
         ,@body))))

(defun largest-rectangle-size (map &aux (largest-size 0))
  (with-corner-array (5)
    (setf (top-side-of 0) 6) ; mark==0 の時にループを止めるための番兵
    
    (loop FOR y FROM 1 TO 5 
          FOR nearest-sandy-pos = 0 
          FOR mark              = 0 DO
      (loop FOR x FROM 0 TO 5 DO
        (if (sandy? map y (1+ x))
            ;; 長方形の上端/左端を設定  +  一番近いsandyなマスの位置も設定
            (setf (top-side-of  (1+ x)) y
                  (left-side-of (1+ x)) 0        ; 左端はこの時点では無効な値(or ループを止める番兵値)に初期化しておく
                  nearest-sandy-pos     (1+ x))
          ;; 必要なら左端の位置を更新
          (maxf (left-side-of (1+ x)) nearest-sandy-pos))
        
        ;; 一つ下のマスがsandyなら、ここは確実に長方形の下端
        ;;   - 多分これは最適化(枝切り)用のコードで、常に(setf mark x)とかしてても結果は変わらないはず
        ;;   - このチェックがあると、高さが一つ増える以外は同じ長方形のための計算を、何度も行わなくて良くなる
        ;;     (ex. 全ての要素が'1'のマップ)
        ;;   - プログラム的に云えば、下のwhenチェックで無駄にtrueになる回数を減らすことが出来る
        (when (sandy? map (1+ y) x)
          (setf mark x))
        
        ;; 長方形の右端※1を検出したので、サイズ計算を行う (右端はx)
        ;; ※1 左側(mark)の位置の上端よりも、右側(x+1)の位置の上端の方が低い場合
        ;;     同時に「x位置の上端よりも、x+1位置の上端の方が低い場合」でもある
        ;;       ==> 条件: (>= (top-side-of mark) (top-side-of x))※2が常に満たされるので
        ;; ※2 yの値は、位置が高いほど小さくなるので、<関数や>=関数での比較は紛らわしい 
        (when #1=(< (top-side-of mark) (top-side-of (1+ x)))
          (loop WHILE #1# DO
            (let ((top  (top-side-of  mark))
                  (left (left-side-of mark)))
              (maxf largest-size (* (- y top)#|height|#  (- x left)#|width|#))
              (setf mark left)))
          (setf mark (1+ x))))))
  largest-size)

*1:ただし、追記1での方法より、入力が最善の場合(マップの要素の値が全部'0')の性能は良いはず。最悪の場合(マップの要素の値が全部'1')の性能は確かに悪いが、今にして思えば'著しく'は大げさだったかもしれない[2009/12/03]

*2:マップ読込み[read-map]にN、「左右に隣接する云々」の計算[conv-to-field-map]に3N、最大の長方形のサイズを求める[largest-rectangle-size]のにN、の計5Nステップ必要(多分)

*3:和田英一, 情報処理 43(4), pp.435-443, 20020415

*4:その内一番目のものは、僕の最初の方法とたぶん本質的には同様