Get a Rectangular Field
本業の方が忙しくて、なかなかまとまったことをする時間がないので、軽いものを一つ。
「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はずなので、もっと良い方法を思いついたら追記で付け足していく予定。
追記１(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
追記２(2009/12/04)
「Program Promenade 最大長方形の面積」というPDFを発見*3。
この問題に対する四種類の解法が解説されていて*4、結構面白い。
とくに三番目の「ナノピコ教室流」(?)は、この記事の筆者も「これは実によくできたプログラムである」と書いているが、その通りだと思う。
追記３(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:ただし、追記１での方法より、入力が最善の場合(マップの要素の値が全部'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:その内一番目のものは、僕の最初の方法とたぶん本質的には同様
