プログラミングの基礎　16.4 最初の完動プログラム

プログラミングの基礎で作ったメトロネットワーク最短路問題の解答．
ダイクストラ法を使い求める．
ここまでのメトロネットワーク最短路問題に関係する問題の解答すべてここに書いてある．

(* サポートページからダウンロードしたglobal_ekimei_listとglobal_ekikan_list *)
#use "metro.ml"

(* 目的：ekimei_t型のデータを受け取り，「路線名，駅名（かな）」を返す *)
(* hyoji : ekimei_t -> string *)
let hyoji ekimei = match ekimei with
    {kanji = kanji;
     kana = kana;
     romaji = romaji;
     shozoku = shozoku;}
    -> shozoku ^ "，" ^ kanji ^ "（" ^ kana ^ "）";;



(* hyoji test *)
print_string "hyouji test"
let test1 = hyoji {kanji = "茗荷谷"; kana = "みょうがだに";
                   romaji = "myogadani"; shozoku = "丸ノ内線"}
  = "丸ノ内線，茗荷谷（みょうがだに）"


(* 目的：ローマ字の駅名（文字列）と駅名リスト(ekimei_t list 型)を受け取り
   園駅の漢字表記を返す *)
(* romaji_to_kanji -> string -> ekimei_t list -> string *)
let rec romaji_to_kanji name lst = match lst with
    [] -> ""
  | {kanji = kanji; kana = kana; romaji = romaji; shozoku = shozoku} :: rest ->
     if name = romaji
     then kanji
     else romaji_to_kanji name rest

(* romaji_to_kanji test *)
let test1 = romaji_to_kanji "" [] = ""
let test2 = romaji_to_kanji "" global_ekimei_list = ""
let test3 = romaji_to_kanji "myogadani" [] = ""
let test4 = romaji_to_kanji "myogadani" global_ekimei_list = "茗荷谷"
let test5 = romaji_to_kanji "aoyamaicchome" global_ekimei_list = "青山一丁目"
let test6 = romaji_to_kanji "heiwadai" global_ekimei_list = "平和台"


(* 目的：漢字の駅名を２つと駅間リストを受け取ったら，駅間リストの中からその２駅間の距離を返す *)
(* get_ekikan_kyori : string -> string -> ekikan_t list -> float *)
let rec get_ekikan_kyori eki1 eki2 lst = match lst with
    [] -> infinity
  | {kiten = kiten; shuten = shuten; keiyu = keiyu; kyori = kyori; jikan = jikan} :: rest ->
     if eki1 = kiten && eki2 = shuten
     then kyori
     else if eki2 = kiten && eki1 = shuten
     then kyori
     else get_ekikan_kyori eki1 eki2 rest



(* get_ekikan_kyori test *)
let test1 = get_ekikan_kyori "錦糸町" "住吉" [] = infinity
let test2 = get_ekikan_kyori "錦糸町" "" global_ekikan_list = infinity
let test3 = get_ekikan_kyori "" "錦糸町" global_ekikan_list = infinity
let test4 = get_ekikan_kyori "横浜駅" "錦糸町" global_ekikan_list = infinity
let test5 = get_ekikan_kyori "大手町" "三越前" global_ekikan_list = 0.7
let test6 = get_ekikan_kyori "三越前" "大手町" global_ekikan_list = 0.7
let test7 = get_ekikan_kyori "霞ヶ関" "日比谷" global_ekikan_list = 1.2


(* 目的：ローマ字の駅名を２つ受け取り，その間の距離を調べ，つながっている場合は
   「A駅からB駅までのはｘｋｍです」と返し，繋がっていない場合は
   「A駅からB駅はつながっていません」と返す*)
let kyori_wo_hyoji r1 r2 =
  let k1 = romaji_to_kanji r1 global_ekimei_list in
  let k2 = romaji_to_kanji r2 global_ekimei_list in
  let not_exist = "という駅は存在しません" in
  if k1 = ""
  then r1 ^ not_exist
  else if k2 = ""
  then r2 ^ not_exist
  else let kyori = get_ekikan_kyori k1 k2 global_ekikan_list in
       if kyori = infinity
       then k1 ^ "駅と" ^ k2 ^ "駅はつながっていません"
       else k1 ^ "駅から" ^ k2 ^ "駅までは" ^ string_of_float kyori ^ "kmです"

(* kyori_wo_hyoji test *)
let test1 = kyori_wo_hyoji "otemachi" "hibiya" = "大手町駅と日比谷駅はつながっていません"
let test2 = kyori_wo_hyoji "" "kinsityo"  = "という駅は存在しません"
let test3 = kyori_wo_hyoji "yokohama" "kinsityo" = "yokohamaという駅は存在しません"
let test4 = kyori_wo_hyoji "otemachi" "mitsukoshimae" = "大手町駅から三越前駅までは0.7kmです"
let test5 = kyori_wo_hyoji "mitsukoshimae" "otemachi" = "三越前駅から大手町駅までは0.7kmです"
let test6 = kyori_wo_hyoji "kasumigaseki" "hibiya" = "霞ヶ関駅から日比谷駅までは1.2kmです"

type eki_t = {
  namae : string;               (* 駅名（漢字の文字列） *)
  saitan_kyori : float;         (* 最短距離（実数） *)
  temae_list : string list;     (* 駅名（漢字の文字列）のリスト *)
}

(* 目的：string型の駅名(漢字)とekimei_t list型を受け取り，
   ekimei_t listをeki_t listに変え，その際駅名と一致する駅についてはshokikaする *)
(* make_initial_eki_list : string -> ekimei_t list -> eki_t list *)
let make_initial_eki_list name lst =
  List.map (fun eki -> match eki with
    {kanji = k; kana = a; romaji = r; shozoku = s}
    -> if k = name
      then {namae = k; saitan_kyori = 0.; temae_list = [k]}
      else {namae = k; saitan_kyori = infinity; temae_list = []})
    lst;;

(* make_initial_eki_list test *)
let test1 = make_initial_eki_list "代々木上原" [{kanji="代々木上原"; kana="よよぎうえはら";
                                                 romaji="yoyogiuehara"; shozoku="千代田線"}]
  = [{namae = "代々木上原"; saitan_kyori = 0.; temae_list = ["代々木上原"]}];;
let test2 = make_initial_eki_list "明治神宮前" [{kanji="代々木公園"; kana="よよぎこうえん";
                                                romaji="yoyogikouen"; shozoku="千代田線"};
                                               {kanji="明治神宮前"; kana="めいじじんぐうまえ";
                                                romaji="meijijinguumae"; shozoku="千代田線"}]
  = [{namae = "代々木公園"; saitan_kyori = infinity; temae_list = []};
     {namae = "明治神宮前"; saitan_kyori = 0.; temae_list = ["明治神宮前"]}];;
let test3 = make_initial_eki_list "赤坂" [{kanji="表参道"; kana="おもてさんどう";
                                           romaji="omotesandou"; shozoku="千代田線"};
                                          {kanji="乃木坂"; kana="のぎざか";
                                           romaji="nogizaka"; shozoku="千代田線"};
                                          {kanji="赤坂"; kana="あかさか";
                                           romaji="akasaka"; shozoku="千代田線"}]
  = [{namae = "表参道"; saitan_kyori = infinity; temae_list = []};
     {namae = "乃木坂"; saitan_kyori = infinity; temae_list = []};
     {namae = "赤坂"; saitan_kyori = 0.; temae_list = ["赤坂"]}];;





(* 目的：ekimei_t型のレコードとekimei_t型のリストを受け取ったら，平仮名の昇順となる位置に
   ekimei_t型のレコードを挿入する．同じ駅がリストにあれば挿入しない．
   seiretsuのための補助関数*)
(* ekimei_isnert : -> ekimei_t -> ekimei_t list -> ekimei_t list *)
let rec ekimei_insert eki lst = match lst with
    [] -> [eki]
  | ({kanji = kanji; kana = kana; romaji = romaji; shozoku = shozoku;} as first) :: rest ->
     if kana = eki.kana
     then lst                   (* リストにあったほうが残る *)
     else if eki.kana < kana    (* 駅のkana < first のkana *)
     then eki :: lst
     else first :: ekimei_insert eki rest

(* test data *)
let yoyogiuehara_tiyodasen = {kanji="代々木上原"; kana="よよぎうえはら";
                              romaji="yoyogiuehara"; shozoku="千代田線"}
let otemachi_tiyodasen = {kanji="大手町"; kana="おおてまち";
                         romaji="otemachi"; shozoku="千代田線"}
let otemachi_hanzoumonsen = {kanji="大手町"; kana="おおてまち";
                             romaji="otemachi"; shozoku="半蔵門線"}


(* test *)
let test1 = ekimei_insert otemachi_tiyodasen [] = [otemachi_tiyodasen]
let test2 = ekimei_insert otemachi_tiyodasen [otemachi_hanzoumonsen] = [otemachi_hanzoumonsen]
let test3 = ekimei_insert otemachi_tiyodasen [yoyogiuehara_tiyodasen]
    = [otemachi_tiyodasen; yoyogiuehara_tiyodasen]
let test4 = ekimei_insert yoyogiuehara_tiyodasen [otemachi_tiyodasen]
    = [otemachi_tiyodasen; yoyogiuehara_tiyodasen]


(* 目的：ekimei_t型のリストを受け取ったら，それを平仮名の順に整列し，
   さらに駅の重複を取り除いたekimei_t型のリストを返す *)
(* seiretsu : ekimei_t -> ekimei_t *)
let rec seiretsu lst = match lst with
    [] -> []
  | first :: rest -> ekimei_insert first (seiretsu rest)




let test1 = seiretsu [] = []
let test2 = [yoyogiuehara_tiyodasen]
  = [yoyogiuehara_tiyodasen]
let test3 = seiretsu [otemachi_tiyodasen; otemachi_hanzoumonsen]
  = [otemachi_hanzoumonsen]
let test4 = seiretsu [otemachi_tiyodasen; otemachi_hanzoumonsen; yoyogiuehara_tiyodasen]
  = [otemachi_hanzoumonsen; yoyogiuehara_tiyodasen]




let otemachi = {namae = "大手町"; saitan_kyori = 0.; temae_list = ["大手町"]}
let mitsukoshimae = {namae = "三越前"; saitan_kyori = infinity; temae_list = []}
let shibuya = {namae = "渋谷"; saitan_kyori = infinity; temae_list = []}
let aoyamaichome = {namae = "青山一丁目"; saitan_kyori = infinity; temae_list = []}



(* 目的：直前に確定した駅 p (eki_t型)と味覚手の役のリスト v (eki_t list型)を受け取り
   必要な更新処理を行った後の未確定の駅のリストを返す*)
(* koushin -> eki_t -> eki_t list -> ekikan_t list -> eki_t list *)
let koushin p v ekikan =
  List.map
    (fun q ->
      let kyori = get_ekikan_kyori p.namae q.namae ekikan in
      if kyori = infinity
      then q
      else let p_keiyu_q_kyori = p.saitan_kyori +. kyori in
           if  p_keiyu_q_kyori  < q.saitan_kyori
           then { namae = q.namae; saitan_kyori = p_keiyu_q_kyori;
                  temae_list =(q.namae) :: p.temae_list}
           else q)
    v;;


(* test data *)
let otemachi = {namae = "大手町"; saitan_kyori = 0.; temae_list = ["大手町"]}
let mitsukoshimae = {namae = "三越前"; saitan_kyori = infinity; temae_list = []}
let shibuya = {namae = "渋谷"; saitan_kyori = infinity; temae_list = []}
let aoyamaichome = {namae = "青山一丁目"; saitan_kyori = infinity; temae_list = []}
let nagatacho = {namae = "永田町"; saitan_kyori = infinity; temae_list = []}
let shinochanomizu = {namae = "新御茶ノ水"; saitan_kyori = infinity; temae_list = []}

(* koushin test *)
let koushin_test1 = koushin otemachi
  [mitsukoshimae; shibuya; shinochanomizu; aoyamaichome] global_ekikan_list
  =[{namae = "三越前"; saitan_kyori = 0.7;
     temae_list = ["三越前"; "大手町"]};
    {namae = "渋谷"; saitan_kyori = infinity; temae_list = []};
    {namae = "新御茶ノ水"; saitan_kyori = 1.3;
     temae_list = ["新御茶ノ水"; "大手町"]};
    {namae = "青山一丁目"; saitan_kyori = infinity; temae_list = []}];;



(* 目的：eki_t list型のリストを受け取り，「最短距離最小の駅」と
   「最短距離最小の駅以外からなるリスト」の組を返す *)
(* saitan_wo_bunri : eki_t list -> eki_t * eki_t list *)
let saitan_wo_bunri eki_list =
  List.fold_right
    (fun first rest_saitan ->
      let (minimum, lst) = rest_saitan in
      if minimum.namae = ""
      then (first, lst)
      else if first.saitan_kyori <= minimum.saitan_kyori
      then (first, minimum :: lst)
      else (minimum, first :: lst))
    eki_list
    ({namae = ""; saitan_kyori = infinity; temae_list = []}, [])


let test1 = saitan_wo_bunri [{namae = "三越前"; saitan_kyori = 0.7;
                              temae_list = ["三越前"; "大手町"]};
                             {namae = "渋谷"; saitan_kyori = 0.3; temae_list = ["渋谷"]};
                             {namae = "新御茶ノ水"; saitan_kyori = 1.3;
                              temae_list = ["新御茶ノ水"; "大手町"]};
                             {namae = "青山一丁目"; saitan_kyori = infinity;
                              temae_list = []}]
  =({namae = "渋谷"; saitan_kyori = 0.3; temae_list = ["渋谷"]},
    [{namae = "三越前"; saitan_kyori = 0.7;
     temae_list = ["三越前"; "大手町"]};
     {namae = "新御茶ノ水"; saitan_kyori = 1.3;
      temae_list = ["新御茶ノ水"; "大手町"]};
     {namae = "青山一丁目"; saitan_kyori = infinity; temae_list = []}]);;


(* 目的：eki_t list型の未確定の駅のリストとekikan_t list型の駅間のリストを受け取り
   ダイクストラのアルゴリズムにしたがって各駅について
   最短距離と最短経路が正しく入ったリストを返す *)
(* dijkstra_main : eki_t list -> ekikan_t list -> eki_t list *)
let rec dijkstra_main  eki_list ekikan = match eki_list with
    [] -> []
  | first :: rest -> match (saitan_wo_bunri eki_list) with
    (saitan1, []) -> [saitan1]
    | (saitan2, rest) -> saitan2 :: (dijkstra_main (koushin saitan2 rest ekikan) ekikan) ;;



(* test_data *)
let otemachi = {namae = "大手町"; saitan_kyori = 1.7; temae_list = ["神保町"]};;
let mitsukoshimae = {namae = "三越前"; saitan_kyori = infinity; temae_list = []};;
let suitenguumae = {namae = "水天宮前"; saitan_kyori = infinity; temae_list = []};;
let kiyosumishirakawa = {namae = "清澄白河"; saitan_kyori = infinity; temae_list = []};;
let sumiyoshi = {namae = "住吉"; saitan_kyori = infinity; temae_list = []};;

let dijkstra_test1 = dijkstra_main [otemachi; mitsukoshimae; suitenguumae;
                                    kiyosumishirakawa; sumiyoshi]
  global_ekikan_list
  = [{namae = "大手町"; saitan_kyori = 1.7; temae_list = ["神保町"]};
     {namae = "三越前"; saitan_kyori = 2.4;
      temae_list = ["三越前"; "神保町"]};
     {namae = "水天宮前"; saitan_kyori = 3.7;
      temae_list = ["水天宮前"; "三越前"; "神保町"]};
     {namae = "清澄白河"; saitan_kyori = 5.4;
      temae_list = ["清澄白河"; "水天宮前"; "三越前"; "神保町"]};
     {namae = "住吉"; saitan_kyori = 7.30000000000000071;
      temae_list =
         ["住吉"; "清澄白河"; "水天宮前"; "三越前"; "神保町"]}];;

(* 目的：始点の駅名（ローマ字の文字列）と終点の駅名（ローマ字の文字列）を受け取り
   seiretsuを使ってglobal_ekimei_list の重複を取り除き，
   romaji_to_kanji を使って始点と終点の漢字表記を求め
   make_initial_eki_listを使って駅のリストを作り，
   dijkstra_mainを使って各駅までの最短路を確定し，
   その中空終点の駅のレコード(eki_t型)を返す*)
(* dijkstra : string -> string -> eki_t *)
let dijkstra siten shuten =
  let sorted_ekimei_list = seiretsu global_ekimei_list in
  let siten_kanji = romaji_to_kanji siten sorted_ekimei_list in
  let shuten_kanji = romaji_to_kanji shuten sorted_ekimei_list in
  let initialized_list = make_initial_eki_list siten_kanji sorted_ekimei_list in
  let saitan_list = dijkstra_main initialized_list global_ekikan_list in
  let rec serch item lst = match lst with
      [] -> {namae = ""; saitan_kyori = infinity; temae_list = []}
    | first :: rest ->
       if first.namae = item
       then first
       else serch item rest
  in serch shuten_kanji saitan_list;;

(* test *)
(* サポートページからのコピペ *)
let test1 = dijkstra "shibuya" "gokokuji" =
  {namae = "護国寺"; saitan_kyori = 9.8;
   temae_list =
     ["護国寺"; "江戸川橋"; "飯田橋"; "市ヶ谷"; "麹町"; "永田町";
      "青山一丁目"; "表参道"; "渋谷"]}
let test2 = dijkstra "myogadani" "meguro" =
  {namae = "目黒"; saitan_kyori = 12.7000000000000028;
   temae_list =
     ["目黒"; "白金台"; "白金高輪"; "麻布十番"; "六本木一丁目"; "溜池山王";
      "永田町"; "麹町"; "市ヶ谷"; "飯田橋"; "後楽園"; "茗荷谷"]}