いちばん長いしりとり
Posted feedbacks - Haskell
ひたすら全部求めて、デカいのを選ぶと云う愚直な実装です。130文字くらいで爆発します。 オーダーはどのくらいなんだろう。見積り方があやふやな上に遅延評価が絡んでくるとわけがわからないですね。 たぶんO(n!)くらいかなぁ……
あと、題意には関係ないですが、リストモナド以外のモナドでも動く様にしてみました。
要・UTF8-String
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 | module Main where
import System.Environment (getArgs)
import Prelude hiding (putStrLn, putStr, print, readFile)
import System.IO.UTF8 (putStrLn, putStr, print, readFile)
import Codec.Binary.UTF8.String (encodeString)
import Data.List (delete, find, maximumBy)
import Control.Monad (msum, MonadPlus(..), filterM)
dic :: IO [String]
dic = do src <- readFile "words.dat"
return $ words src
f # g = \a b -> g (f a) (f b)
main = do wds <- dic
args <- getArgs
let mb = "-a" `elem` args
sh :: (Functor m, MonadPlus m, Eq (m [String])) => m [String]
sh = shiritori (head wds) wds
if mb
then pr sh
else printStrList $ maximumBy (length#compare) sh
pr :: Maybe [String] -> IO ()
pr = maybe (return ()) printStrList
showStrList xs = "[" ++ concatMap (++",") xs ++ "]"
printStrList = putStrLn . showStrList
shiritori :: (Functor m, MonadPlus m, Eq (m [String])) => String -> [String] -> m [String]
shiritori w ws = (do let wd' = w `delete` ws
ns <- nextWords w wd'
shiritori ns wd') `hoge` w
a `hoge` t = if a == mzero then return [t] else fmap (t:) a
nextWords :: (MonadPlus m) => String -> [String] -> m String
nextWords wd list = do
xs <- filterM (\a -> return (last wd == head a)) list
msum $ map return xs
|
Lost_dogです。初投稿です。よろしくです。
お題の単語ファイルをUTF8で保存して実行します。結果をプロンプトに吐くと文字化けするので、ファイルに出力してます。
実装は愚直に全部数えてるだけです。130単語くらいの入力が限界でした。もっと長いしりとりは、また今度挑戦してみます。
つーか関係ないけど、コードの配色がカラフルだな…
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 | module Main where
import Prelude hiding (putStrLn, readFile, writeFile)
import System.IO.UTF8
import Data.List
import Data.Tree
import Data.Maybe
import Data.Function
main = readFile "words.txt" >>= writeFile "out.txt".unlines.longest.makeTree.words
makeTree = unfoldTree f where
f (w:ws) = let c = map (\x -> x:(ws\\[x])) $ filter (((last w)==).head) ws
in (w, c)
longest (Node w []) = [w]
longest (Node w ws) = let xs = maximumBy (compare`on`length) $ map longest ws
in w : xs
|
greentea #9391() Rating5/7=0.71
一番長くしりとりを続けるためのプログラムを書いてください。
また、単語数に対して、計算量がどのように増えていくかも考えて下さい。
なお、単語リストの一例として
http://www.ais.riec.tohoku.ac.jp/lab/wordlist/index-j.htmlで公開されている
http://www.ais.riec.tohoku.ac.jp/lab/wordlist/fam55_40.txtがあります。
ただし、
・一度使った単語は使わないこと(リストに重複がある可能性は考えなくてよい)
・「ん」で終わる単語を使用するか、リスト内にしりとりを続けられる単語がなくなったときに、しりとりは終了する
・一番最初は、好きな単語から初めてもよい
・「一番長くしりとりを続ける」とは、しりとりが終了するまでに使用する単語数が最大になるよう、しりとりの単語を選ぶことをいう
see: 難聴者のための単語了解度試験用単語リスト
[ reply ]