解答がないので自分で書いてみた
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"