回文の発掘(2013.10.14の過去問)

1日1個 @nabetani さんの作った問題を解く、どう書くAdventCalendarの8日目です。

今日の問題は http://nabetani.sakura.ne.jp/hena/ord15subpalin/ にあります。

module Doukaku.Anagram (solve) where

solve :: String -> String
solve = show . maximum . map anagramLen' . allTails
  where
    anagramLen' ([], _) = 0
    anagramLen' (y:ys, xs) = max (anagramLen (y:ys) xs) (anagramLen ys xs + 1)

anagramLen :: String -> String -> Int
anagramLen [] _ = 0
anagramLen (x:xs) ys = max result (anagramLen xs ys)
  where
    (_, ys2') = break (== x) ys
    result = if null ys2' then 0 else 2 + anagramLen xs (tail ys2')

allTails :: String -> [(String, String)]
allTails = allTails' []
  where
    allTails' ys [] = (ys, []):[]
    allTails' ys (x:xs) = (ys, x:xs) : allTails' (x:ys) xs

「何文字か撤去すると」を読み逃して見当違いな答えを書いてましたが、幸いうまく軌道修正できました。文字列を2つに分けて双方向リストとして扱うアプローチを取っています。回分の長さが奇数と偶数の場合があるので、そこは2通り別々に判定してmaxをとります。回分に次の文字を使う場合と、飛ばして以降の文字を使う場合の2通りを再帰的に求めて、こちらもmaxをとって最大長を求めています。

http://qiita.com/Nabetani/items/0b56395d4c9e7c64b230 に他の方の回答もありますので、見ると参考になるでしょう。