Skip to content

Instantly share code, notes, and snippets.

@tkych

tkych/2013-11-01-palindrome.lisp

Last active December 31, 2015 03:19
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save tkych/7927082 to your computer and use it in GitHub Desktop.
Save tkych/7927082 to your computer and use it in GitHub Desktop.
Download ZIP
Raw
2013-11-01-palindrome.lisp
;;;; Last modified: 2013-12-12 21:08:38 tkych
;; 力任せ, O(2^n), もっと良いやり方があるはず。
;;====================================================================
;; 回文の発掘
;;====================================================================
;; - [回文の発掘 〜 横へな 2013.11.1 参考問題](http://nabetani.sakura.ne.jp/hena/ord15subpalin/)
;; - [第15回オフラインリアルタイムどう書くの参考問題](http://qiita.com/Nabetani/items/0b56395d4c9e7c64b230)
;;--------------------------------------------------------------------
;; Package
;;--------------------------------------------------------------------
(in-package :cl-user)
(defpackage :find-palindrome (:use :cl))
(in-package :find-palindrome)
;;--------------------------------------------------------------------
;; Main
;;--------------------------------------------------------------------
;; brute force
(defun main (input)
(let ((len (length input))
(max-len 1))
(flet ((palindromep (bits)
(loop :for msb-pos := (1- (integer-length bits))
:for lsb-pos := (1- (integer-length (logand bits (- bits))))
:until (= msb-pos lsb-pos)
:always (char= (char input msb-pos)
(char input lsb-pos))
:do (setf (ldb (byte 1 msb-pos) bits) 0
(ldb (byte 1 lsb-pos) bits) 0))))
(loop :for bits :from 1 :to (expt 2 len)
:for sub-len := (logcount bits)
:do (when (and (< max-len sub-len)
(palindromep bits))
(setf max-len sub-len))))
(write-to-string max-len)))
#| 計算量 O(2^n)
入力文字列の長さは高々30。
最悪の場合、`main'は2^30 = 1073741824回、`palindromep'を呼び出し、各`palindromep'は30/2 = 15回、文字比較関数`char='を呼ぶ。
したがって、最悪の場合、16106127360回、文字の比較が実行される。
実際は、`main'は毎ループごとに、`palindromep'を呼び出すわけではないので、文字比較の回数はやや少なくなる。
（なぜなら、1.現在の最大回文の長さ`max-len'以下の長さの部分文字列は無視される。2.`palindromep'はショートカットする。）
例えば、文字比較の回数がわかるように`main'を次のように修正すると：
(defun main (input)
(let ((len (length input))
(max-len 1)
(max-bits 1)
(count-compare-chars 0))
(flet ((palindromep (bits)
(loop :for msb-pos := (1- (integer-length bits))
:for lsb-pos := (1- (integer-length (logand bits (- bits))))
:until (= msb-pos lsb-pos)
:always (progn
(incf count-compare-chars)
(char= (char input msb-pos)
(char input lsb-pos)))
:do (setf (ldb (byte 1 msb-pos) bits) 0
(ldb (byte 1 lsb-pos) bits) 0))))
(loop :for bits :from 1 :to (expt 2 len)
:for sub-len := (logcount bits)
:do (when (and (< max-len sub-len)
(palindromep bits))
(setf max-len sub-len
max-bits bits))))
(values (write-to-string max-len)
(with-output-to-string (s)
(dotimes (i len)
(when (logbitp i max-bits)
(princ (char input i) s))))
count-compare-chars)))
* 入力を長さ30の文字列、"oQQyQQyyQyQQoooyQQyyyQQQyyQQoy"とすると、約14秒かかった。
文字の比較は、2116439回。
(time (main "oQQyQQyyQyQQoooyQQyyyQQQyyQQoy")) => "25", "oQQyQQyyyQQoooQQyyyQQyQQo", 2116439
Evaluation took:
13.944 seconds of real time
13.928870 seconds of total run time (13.928870 user, 0.000000 system)
99.89% CPU
30,606,378,106 processor cycles
131,776 bytes consed
* 入力を長さ30の文字列"CAbYcW5VqHjzFdIkH_61PM0TsyRuie"とすると、約52秒かかった。
文字の比較は、1073738100回。
(time (main "CAbYcW5VqHjzFdIkH_61PM0TsyRuie")) => "3", "HjH", 1073738100
Evaluation took:
51.924 seconds of real time
51.883243 seconds of total run time (51.879243 user, 0.004000 system)
99.92% CPU
113,972,987,016 processor cycles
556,832 bytes consed
埋まっている回文の長さが短いと、`palindromep'の呼び出し回数が多くなり、結果、文字の比較回数も多くなる。
もっと良いアルゴリズムが、きっとあるはず。
|#
;;--------------------------------------------------------------------
;; Tests
;;--------------------------------------------------------------------
(defun =>? (got expected)
(assert (string= got expected)))
;; !!!
;; テストをすべて行うと、約12分かかった。
;; Evaluation took:
;; 708.493 seconds of real time
;; 701.351832 seconds of total run time (701.315830 user, 0.036002 system)
;; 98.99% CPU
;; 3 forms interpreted
;; 38 lambdas converted
;; 1,555,153,163,536 processor cycles
;; 9,972,528 bytes consed
(time
(progn
(=>? (main "I_believe_you_can_solve") "9")
(=>? (main "a") "1")
(=>? (main "aa") "2")
(=>? (main "aaa") "3")
(=>? (main "ab") "1")
(=>? (main "aabb") "2")
(=>? (main "ABBA") "4")
(=>? (main "Abba") "2")
(=>? (main "1234567890") "1")
(=>? (main "1234567890987654321") "19")
(=>? (main "abcdcba") "7")
(=>? (main "0a1b2c3d4c5b6a7") "7")
(=>? (main "abcdcba0123210") "7")
(=>? (main "abcdcba_123210") "7")
(=>? (main "_bcdcba0123210") "7")
(=>? (main "abcddcba0123210") "8")
(=>? (main "abcdcba01233210") "8")
(=>? (main "a0bc1dc2ba3210a") "9")
(=>? (main "a0bc1ddc2ba3210") "8")
(=>? (main "3a0bc1ddc2ba3210") "10")
(=>? (main "11oooo1111o1oo1o111ooooooooooo") "20")
(=>? (main "11o1111o1111oo11ooo11111ooo1oo") "20")
(=>? (main "111111oo11o111ooo1o1ooo11ooo1o") "21")
(=>? (main "11o1o1o11oo11o11oo111o1o1o11oo") "27")
(=>? (main "oo111o1o11o1oo1ooo11o1o11o1o1o") "27")
(=>? (main "1o1oo11111o1o1oo1o1o1111oo1o1o") "28")
(=>? (main "QQooooQooooQQyQoyQQQyyyyQQoyoy") "15")
(=>? (main "oQoooQooooQyoyQoyoyyyQQyQQQQoQ") "16")
(=>? (main "yyyyyooyQyyyoyyQyyooyQoQoQQoQy") "17")
(=>? (main "yyQoyQoyyQyQQoyooooyyQQyQyooQy") "24")
(=>? (main "oQQooQoQyQQoyoQQoQyQyQyQoQoooo") "24")
(=>? (main "oQQyQQyyQyQQoooyQQyyyQQQyyQQoy") "25")
(=>? (main "WAk9iHI4jVDlStyudwTNqE138kwan2") "3")
(=>? (main "c43fIu1Mlz0K9hEVOgGcUdbeB5ksa7") "3")
(=>? (main "CAbYcW5VqHjzFdIkH_61PM0TsyRuie") "3")
(=>? (main "jInQnUvSayrJTsQWujovbbqW0STvoj") "10")
(=>? (main "iZDrvpUKgtj3FrZsZ4CLjrEgUdZzQG") "11")
(=>? (main "ROgYUOu6er_DA7nB6UGquO1GUHC62R") "11")
(=>? (main "Oh_be_a_fine_girl_kiss_me") "9")
(=>? (main "8086_6502_6809_Z80") "11")
(=>? (main "xcode_visualstudio_eclipse") "11")
(=>? (main "word_excel_powerpoint_outlook") "9")
(=>? (main "abcdefghijklmnopqrstuvwxyz0123") "1")
))
;;====================================================================
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment