2020/08/24

OCamlのL99-80を考えてみる

解答がないので自分で書いてみた

L99-80からはグラフ理論についての問題になっています。当然ながら私はグラフ理論なんてものは人生初の勉強なので、まずは数学の方の勉強から入っています。勉強していると、意外と身近なもので面白いです。例えば一筆書き、路線図、などでもグラフ理論が使えるようです。

OCamlのL99問題のページでは、このあたりからほぼ解答がなくなってしまっていて、本当に自分の書いたコードが正しいのかどうかが分からないので、ここのところ続けていたOCamlのL99問題をCommon Lispで書いてみるという勉強も滞ってしまってます。なので、現在HaskellのH99を参考に、OCamlのコードやCommon Lispのコードを考えるという状況です。つまり今度はHaskellの知識が必要となってきて、数学と3つの言語を同時に勉強するという、えげつない状況になりました。天井がなく無限に拡がっていると捉えるか、底が知れず、どんどん泥沼にハマっていると捉えるか……

グラフと隣接リストの相互変換

まずはグラフ(graph_term)から隣接リスト(adjacency_list)へ、そしてその逆、の変換を行うコードを書いてみようと思います。


type 'a graph_term = { nodes: 'a list; edges: ('a * 'a) list }
type 'a adjacency_list = Adj of ('a * 'a list) list;;

let example_graph =
  {nodes = ['b';'c';'d';'f';'g';'h';'k'];
   edges = [('b', 'c');('b', 'f');('c', 'f');('f', 'k');('g', 'h')]}

graph_termは頂点・節点の集合(nodes)と辺の集合(edges)で構成され、adjacency_listは各頂点・節点とそれに関わる頂点・節点のリストのペアのリストで構成されます。例えば上記のexample_graphをadjacency_listにすると、


[('b', ['c'; 'f']); ('c', ['b'; 'f']); ('d', []); ('f', ['b'; 'c'; 'k']);
 ('g', ['h']); ('h', ['g']); ('k', ['f'])]

というものになるようにしたい。そいてこのadjacency_listをグラフにすると、example_graphと同じになるようにしたい。

結果、以下のようなコードになりました。


type 'a graph_term = { nodes: 'a list; edges: ('a * 'a) list };;
type 'a adjacency_list = Adj of ('a * 'a list) list;;

let example_graph =
  {nodes = ['b';'c';'d';'f';'g';'h';'k'];
   edges = [('b', 'c');('b', 'f');('c', 'f');('f', 'k');('g', 'h')]}

let rec graph_of_adj g =
  match g.nodes, g.edges with
  | [], _ -> Adj []
  | x::xs, ys ->
      let f (a, b) = if a = x then [b]
                  else if b = x then [a]
                  else []
      in
      let Adj zs = graph_of_adj {nodes=xs; edges=ys} in
      Adj ((x, List.flatten (List.map f ys)) :: zs)
;;

let rec adj_of_graph = function
  | Adj [] -> { nodes = []; edges = [] }
  | Adj l ->
      match l with
      | (v, a) :: vs ->
          let { nodes = xs; edges = ys} = adj_of_graph (Adj vs) in
          let f x =
            if List.mem (v, x) ys || List.mem (x, v) ys then []
            else [(x, v)]
          in
          { nodes = v :: xs;
            edges = List.append (List.flatten (List.map f a)) ys }
      | _ -> failwith "adj_of_graph"
;;

adj_of_graphの方は、パターンマッチのところがまだ勉強不足で、微妙な感じではありますが、試したところ期待した結果を得ることが出来ているので、とりあえずうまくいっているようです。

次なるhuman_friendlyとやらが、個人的には今の状態で結構human_friendlyな気がするのでどうなのかな?と思っているのですが、いろいろ試行錯誤しながらやってみようと思います。

ご指摘・アドバイス等ございましたら、お気軽にお声掛けください。

追記(2020/08/25)

とりあえずhuman_friendlyとやらを作ってみました。


type 'a graph_term = { nodes: 'a list; edges: ('a * 'a) list };;
type 'a adjacency_list = Adj of ('a * 'a list) list;;
type 'a human_friendly = Fri of string list;;

let example_graph =
  {nodes = ['b';'c';'d';'f';'g';'h';'k'];
   edges = [('b', 'c');('b', 'f');('c', 'f');('f', 'k');('g', 'h')]}

let rec graph_of_adj g =
  match g.nodes, g.edges with
  | [], _ -> Adj []
  | x::xs, ys ->
      let f (a, b) = if a = x then [b]
                  else if b = x then [a]
                  else []
      in
      let Adj zs = graph_of_adj {nodes=xs; edges=ys} in
      Adj ((x, List.flatten (List.map f ys)) :: zs)
;;

let rec adj_of_graph = function
  | Adj [] -> { nodes = []; edges = [] }
  | Adj l ->
      match l with
      | (v, a) :: vs ->
          let { nodes = xs; edges = ys} = adj_of_graph (Adj vs) in
          let f x =
            if List.mem (v, x) ys || List.mem (x, v) ys then []
            else [(x, v)]
          in
          { nodes = v :: xs;
            edges = List.append (List.flatten (List.map f a)) ys }
      | _ -> failwith "adj_of_graph"
;;

let pair_of_fri (a, b) =
  if a = b then String.make 1 a else Printf.sprintf "%c-%c" a b
;;

let rec fri_of_string = function
  | Fri [] -> ""
  | Fri s -> String.trim ((List.hd s) ^ " " ^ fri_of_string (Fri (List.tl s)))
;;

let graph_of_fri = function
  | { nodes = []; edges = _ } -> Fri []
  | { nodes = xs; edges = ys } ->
      let g = List.filter (fun x ->
        List.for_all (fun (a,b) -> x <> a && x <> b) ys) xs
      in
      let tmp = ys @ (List.combine g g)
      in
      Fri (List.map pair_of_fri tmp)
;;

一応、human_firendlyは文字列のリストとしました。そのためオリジナルで、fri_of_stringという関数を作成し、文字列にできるようにしました。結果は以下のようになります。


# graph_of_fri example_graph;;
- : 'a human_friendly = Fri ["b-c"; "b-f"; "c-f"; "f-k"; "g-h"; "d"]
# fri_of_string (graph_of_fri example_graph);;
- : string = "b-c b-f c-f f-k g-h d"