A spaghetti code for generating Hasse diagram of the powerset of n element.

draw_setfamily.ml

type index  = int
type height = int
type order  = int


(* ---- basic calc ---- *)
let rec pow2 n =
  if n <= 0 then 1 else 2 * (pow2 (n - 1))

let rec log2 i =
  if i == 1 then 0 else 1 + (log2 (i / 2))

let rec combination n r =
  if r < n - r then combination_sub 1 1 n r else combination_sub 1 1 n (n - r)

and combination_sub numer denom n r =
  if r <= 0 then numer / denom else
    combination_sub (numer * n) (denom * r) (n - 1) (r - 1)

let rec num_to_vec max i =
  num_to_vec_sub [] i (max / 2)

and num_to_vec_sub res i e =
  if e == 1 then
    if i == 1 then (1 :: res) else res
  else
    if i >= e then num_to_vec_sub (e :: res) (i - e) (e / 2) else num_to_vec_sub res i (e / 2)


(* ---- output settings ---- *)
let single_height = ref 1.0

let output_prefix draw_width fout n =
  output_string fout "\\usetikzlibrary{shapes.geometric}\n" ;
  output_string fout "\\begin{tikzpicture}\n" ;
  let frametop    = !single_height *. (float_of_int (n + 1)) in
  let framebottom = -. !single_height in
    output_string fout ("\\draw (0, " ^ (string_of_float frametop) ^ ") |- ("
      ^ (string_of_float draw_width) ^ ", " ^ (string_of_float framebottom) ^ ") |- cycle;\n")

let output_postfix fout =
  output_string fout "\\end{tikzpicture}\n"

let determine_drawn_position draw_width n hgt odr =
  let comb = combination n hgt in
    let single_width = draw_width /. (float_of_int (comb + 1)) in
      let drawx = single_width *. (float_of_int (odr + 1)) in
      let drawy = !single_height *. (float_of_int hgt) in
        (drawx, drawy)


let rec display_element lst =
	match lst with
	| []           -> "$\\varnothing$"
	| head :: []   -> string_of_int ((log2 head) + 1)
	| head :: tail -> (string_of_int ((log2 head) + 1)) ^ (display_element tail)


let rec output_coverrel draw_width fout n infoarr i =
  let (prnthgt, prntodr, children) = infoarr.(i) in
    output_coverrel_sub draw_width fout n prnthgt prntodr infoarr children

and output_coverrel_sub draw_width fout n prnthgt prntodr infoarr children =
  match children with
  | []            -> ()
  | child :: tail ->
      let (childhgt, childodr, _) = infoarr.(child) in
        output_coverrel_main draw_width fout n prnthgt prntodr childhgt childodr ;
        output_coverrel_sub draw_width fout n prnthgt prntodr infoarr tail

and output_coverrel_main draw_width fout n prnthgt prntodr childhgt childodr =
  let (prntdrawx, prntdrawy)   = determine_drawn_position draw_width n prnthgt prntodr in
  let (childdrawx, childdrawy) = determine_drawn_position draw_width n childhgt childodr in
    output_string fout ("\\draw (" ^ (string_of_float prntdrawx) ^ ", " ^ (string_of_float prntdrawy) ^ ") -- ("
      ^ (string_of_float childdrawx) ^ ", " ^ (string_of_float childdrawy) ^ ");\n")


let output_point draw_width fout n infoarr i =
  let (hgt, odr, _) = infoarr.(i) in
  let (drawx, drawy) = determine_drawn_position draw_width n hgt odr in
    output_string fout ("\\draw[densely dotted] (" ^ (string_of_float drawx) ^ "," ^ (string_of_float drawy) ^ ")") ;
    output_string fout (" node[draw, ellipse, fill=white] {\\!" ^ (display_element (num_to_vec (pow2 n) i)) ^ "\\!};\n")


let rec generate_setfamily n filename draw_width single_height_setting =
	single_height := single_height_setting ;
  let max = pow2 n in
  let countarr : order array = Array.make (n + 1) 0 in
  let infoarr  : (height * order * index list) array  = Array.make max (0, 0, []) in
    print_string "generating setfamily...\n" ;
    generate_setfamily_sub countarr infoarr max 0 ;
    print_string "output...\n" ;
    let fout = open_out filename in
      output_prefix draw_width fout n ;
      for i = 0 to (max - 1) do
        output_coverrel draw_width fout n infoarr i
      done ;
      for i = 0 to (max - 1) do
        output_point draw_width fout n infoarr i
      done ;
      output_postfix fout ;
      print_string "end.\n" ;
      close_out fout


and generate_setfamily_sub countarr infoarr max i =
  if i >= max then () else
    let lst = num_to_vec max i in
    let height = List.length lst in
    let children =
      if height == 0 then [] else List.map (fun x -> i - x) lst
    in
      infoarr.(i) <- (height, countarr.(height), children) ;
      countarr.(height) <- countarr.(height) + 1 ;
      generate_setfamily_sub countarr infoarr max (i + 1)

draw_setfamily.ml

概要

冪集合のHasse図をTikZ形式で出力するプログラム．

使い方

$ ocaml

# #use "draw_setfamily.ml";;
# generate_setfamily n filename width interval;;

n：台集合の大きさ
filename：出力ファイル名（既存の場合は上書きされるので注意）
width：図の幅（cm単位）
interval：縦の間隔（cm単位）

出力例

n=5 の場合：