スポンサーサイト

上記の広告は1ヶ月以上更新のないブログに表示されています。
新しい記事を書く事で広告が消せます。

どう書く?org F# いちばん長いしりとり

どう書く?org F# いちばん長いしりとりhttp://ja.doukaku.org/277/
 
「どう書く?org」http://ja.doukaku.org/に挑戦2問目です。 
前回「どう書く?org」でF#が見当たらない、と書きましたが、F#で書いた人はOcamlの方へ投稿していたようです。
さて今回の問題は次のような内容。 
 
(問題) 
単語のリストを読み込んで、そのリストにある単語で「しりとり」をします。 
一番長くしりとりを続けるためのプログラムを書いてください。 
また、単語数に対して、計算量がどのように増えていくかも考えて下さい。 
 
なお、単語リストの一例として 
http://www.ais.riec.tohoku.ac.jp/lab/wordlist/index-j.htmlで公開されている 
http://www.ais.riec.tohoku.ac.jp/lab/wordlist/fam55_40.txtがあります。 
 
ただし、 
・一度使った単語は使わないこと(リストに重複がある可能性は考えなくてよい) 
・「ん」で終わる単語を使用するか、リスト内にしりとりを続けられる単語がなくなったときに、しりとりは終了する 
・一番最初は、好きな単語から初めてもよい 
・「一番長くしりとりを続ける」とは、しりとりが終了するまでに使用する単語数が最大になるよう、しりとりの単語を選ぶことをいう 
 
それで、実際のテキストファイルは冒頭が次のようなもので、全部カタカナでタブで区切られています。
アイアイ イチブン ウラガネ オハグロ ガイユウ
カザアナ キャクアシ ギャクサン キュウガク キワマリ
ギンマク クタビレ グンダン コツゼン ザイバツ
サンバシ ジカバキ シタヅミ シャクナゲ ショウワル
スナヤマ ソクハツ タンパツ ダンマリ チマミレ
以下続く
 
 
とりあえず書いてみたコードは次のようになります。
 
open System.IO
 
//小文字を大文字に変換
let ConvH (str:string) =
    str.Replace("ァ","ア").Replace("ィ","イ").Replace("ゥ","ウ").Replace("ェ","エ").Replace("ォ","オ")
        .Replace("ヵ","カ").Replace("ヶ","ケ").Replace("ッ","ツ").Replace("ャ","ヤ").Replace("ュ","ユ")
        .Replace("ョ","ヨ").Replace("ヮ","ワ")
             
//ファイルの文字列を大文字化してリストに収める
let wordList = [
                                             //ここのファイル名を変える
                    use fileReader = new StreamReader("s:\word2.text") 
                    while not fileReader.EndOfStream do
                        let line = fileReader.ReadLine()
                        let strs = line.Split( [| '\t' |])
                        for st in strs do
                            if st <> "" then
                                yield ConvH (st)
                 ]
 
let IcharSet = List.fold (fun (chset:char Set) (str:string) -> Set.add str.[0] chset) (Set.Empty)  wordList    
let ITcharSet = List.fold (fun (chset:char Set) (str:string) -> Set.add (str.[str.Length - 1]) chset) IcharSet  wordList    
let UsedCharList = Set.to_list ITcharSet //先頭か末尾で使われている文字のリスト
 
let KanaLen = List.length  UsedCharList
 
//カナのindexを返す
let posOfKana (ch : char) =
    List.findIndex (fun x -> x = ch) UsedCharList
   
//対応表用の配列 サイズ KanaLen * KanaLen
let respT = [| for i in 0 .. (KanaLen - 1) do
                    yield (Array.create KanaLen 0) |]
 
for s in wordList do
    let topStr = s.[0]
    let endStr = s.[s.Length - 1]
    let topStrIndex = posOfKana topStr
    let endStrIndex = posOfKana endStr
    respT.[topStrIndex].[endStrIndex] <- respT.[topStrIndex].[endStrIndex] + 1  
 
let tempWordIndexArr = Array.create wordList.Length 0
let deepestWordIndexArr = Array.create wordList.Length 0                
 
// topIndex..何で始まるのから調べるか 
let rec search depth deepest topIndex  (arr :int [] []) (indexArr :int []) =
    for i in  0 ..(KanaLen - 1) do
        if arr.[topIndex].[i] > 0 then
            
            indexArr.[depth] <- topIndex
            indexArr.[depth+1] <- i
            arr.[topIndex].[i] <- arr.[topIndex].[i] - 1
            
            if depth + 1 > !deepest then
               deepest := depth + 1
               for i in 0 .. !deepest do
                    deepestWordIndexArr.[i] <- indexArr.[i]
          
            search (depth + 1) deepest i arr indexArr
            
            arr.[topIndex].[i] <- arr.[topIndex].[i] + 1
 
let maxDepth = ref 0
 
for i in 0 .. (KanaLen - 1) do
    if Array.sum respT.[i] > 0 then
        search 0 maxDepth i respT tempWordIndexArr
 
printfn "最大連結個数: %A" !maxDepth   
 
//結果表示用の補助関数
//index iで始まりjで終わる単語をリストから抜き出して、その単語とその単語を除いたリストを返す
let findAndPop (i,j) lst =
    let rec sub (passedLst : string list)  (yetLst : string list) =
       match yetLst with
       | [] -> failwith "dont find"
       | h :: tl when posOfKana h.[0] = i && posOfKana h.[h.Length - 1] = j 
                -> (h,passedLst @ tl)
       | h :: tl -> sub (passedLst @ [h]) tl
    sub [] lst            
 
//結果表示用
let rec dispResult lst i =
    if i = !maxDepth then
        ()
    else 
        let (word,remLst) = findAndPop ( deepestWordIndexArr.[i],deepestWordIndexArr.[i+1]) lst
        printf "-> %s" word
        dispResult remLst (i + 1)
 
dispResult wordList 0
 
単語の最初と最後の文字だけをインデックスにして、int [] [] 型の配列が、対応表になるようにして、それをもとに全探索をかけています。
例えばアがindex0,エがindex8ならarray.[0].[8]にはアで始まり、エで終わる単語の個数が記録されているという仕組みです。
 
例えば、上で紹介したURLから先頭100個の単語のリストをテキストファイルで保存しておいて、そのファイル名をプログラム内で指定してから実行すると
 
最大連結個数: 22
-> カザアナ-> ナニゴト-> トリモノ-> ノリニゲ-> ゲレツサ-> サンバシ-> シールド-> ドウナガ-> ガイユウ-> ウラガネ-> ネンブツ-> ツジツマ-> マヤカシ-> シタヅミ-> ミズヒキ-> キヤクアシ-> シヨウワル-> ルイベツ-> ツユザム-> ムスビメ-> メイフク-> クタビレ
という結果になります。
 
100語程度ならすぐ結果がでるのですが、130語になると約1分かかります。(このあたりが限界です。)
スポンサーサイト

テーマ : プログラミング
ジャンル : コンピュータ

コメントの投稿

非公開コメント

プロフィール

T GYOUTEN

Author:T GYOUTEN
F#と英単語とフリーソフトと読書に興味があります。
ホームページでフリーソフトも公開しています。どぞ御贔屓に。

最新記事
最新コメント
最新トラックバック
月別アーカイブ
カテゴリ
フリーエリア
フリーエリア
blogram投票ボタン
検索フォーム
RSSリンクの表示
リンク
ブロとも申請フォーム

この人とブロともになる

QRコード
QRコード
上記広告は1ヶ月以上更新のないブログに表示されています。新しい記事を書くことで広告を消せます。