source: genesis/nodes/channelga.ml@ 1990

(**
  Experimental channel assigning program using an evolutionary algorithm.

  The scoring function is simple:
    - the score of a combination of two interfaces is 1 if there's two or more
      channels between them, -1 if there's 1 channel between them, -5 if
      there's no channels between them (they're on adjacent channels) and -10
      if they're on the same channel
    - the score for a node is the sum of the scores of all the combinations of
      interfaces for that node, minus any node-specific penalties (eg.
      channels 7, 8 and 9 are unusable and score -1000 on node x), scaled by
      the number of interfaces to give more weight to larger nodes (the
      assumption being that larger nodes are more important nodes)
    - the total score of the network is the sum of the score of the nodes,
      minus any network-wide penalties (eg. the omni's for node x and node y
      can see eachother, so they should be apart)

 - install an O'Caml compiler. /usr/ports/lang/ocaml/ in FreeBSD, ocaml in
   Debian.

 - compile with
  
    $ ocamlopt -o foo str.cmxa channelga.ml

 - run with

   $ ./foo f

 where f is the result of running prepconf.py on a file with a list of 
 paths to the wleiden.conf's to consider.
*)

(* a few constants suitable for twiddling *)
(** How large a population should the system maintain? *)
let population_size = 100
(** How long should the system iterate after an improvement? *)
and max_stagnant_iterations = 10000
(** What is the chance for an ESSID to channel assignment to mutate to a 
    random channel? *)
and mutation_rate = 0.1;;

(* the type definitions. note that Caml has trouble with mutually recursive
   data structures. you can define them, you just can't ever instantiate them.
   this is why the fields in wi are all loose references by way of strings *)
type wi = {
        wi_name: string;
        wi_nodename: string;
        wi_essid: string;
};;
type group = {
        group_essid: string;
        mutable group_wis: wi list;
};;
type node = {
        node_name: string;
        node_wis: wi list;
};;
(** A configuration is an assignment of groups, identified by essid, to a
    channel, plus a score. The code should be careful not to use the score
    between mutating an re-evaluating. *)
type configuration = {
        mutable score: int;
        conf: (string, int) Hashtbl.t;
};;
type 'a maybe = Nothing | Just of 'a;;

(** The global nodes hash, mapping from node name to node struct. *)
let nodes = Hashtbl.create 4
(** The global groups hash, mapping from essid to group struct. *)
let groups = Hashtbl.create 4

(* some convenience functions *)

(** Function composition. *)
let compose f g = fun x -> f(g(x))
let ($) = compose
(** Turn two individual values into a tuple *)
let maketuple a b = (a, b)
(** Shorthand for List.hd *)
let head = List.hd
(** Shorthand for List.tail *)
let tail = List.tl
let just x = match x with
               Nothing -> assert false
             | Just s -> s
(** Given a hashtable, return all the keys as a list *)
let keys t = Hashtbl.fold (fun k d a -> k::a) t []
(** Given a hashtable, return all the values as a list *)
let values t = Hashtbl.fold (fun k d a -> d::a) t []
(** Copy one array into the other *)
let copyarray src dest = Array.blit src 0 dest 0 (Array.length src)

(** Given a list, return a list of pairs with all possible combinations of 
   items from the given list *)
let rec combinations l =
        match l with
          []    -> []
        | x::xs -> (List.map (maketuple x) xs)@(combinations xs)

(** Given a configuration and two wi's, return the score *)
let wi_score c wi1 wi2 =
        let scoretable = [ ((<=) 2,  1);
                           ((==) 2, -1);
                           ((==) 1, -5);
                           ((==) 0, -10) ] in
        let channel1 = c wi1.wi_essid in
        let channel2 = c wi2.wi_essid in
        let diff = abs (channel1 - channel2) in
        let rec runtable t = match t with
                                []              -> assert false
                             | (cond, s)::xs    -> if (cond diff) then s
                                                   else runtable xs in
        runtable scoretable;;

(** Given a configuration and a node, return the score. this is simply the sum of
   the scores of all the combinations of interfaces, written down as a fold for
   efficiency *)
let node_score c n =
        let foldfunc acc (wi1, wi2) = acc + (wi_score c wi1 wi2) in
        let base_score = List.fold_left foldfunc 0 (combinations n.node_wis) in
        base_score * (List.length n.node_wis)

(** Given a list of nodes and a configuration, return the score for the whole
    configuration. This is the sum of the scores for all nodes. *)
let score_configuration ns c =
        let foldfunc acc n = acc + (node_score (Hashtbl.find c) n) in
        let nodescores = List.fold_left foldfunc 0 ns in
        nodescores

(** Given a filename, return a list of all the lines in the file with the given
   filename *)
let snarf_lines fname =
        let infile = open_in fname in
        let result = ref [] in
        try
                while true do
                        result := (input_line infile)::!result
                done;
                !result (* never gets here *)
        with End_of_file -> !result

(** Given the name of the node currently being parsed, parse the given tuple
    that consists of a wi name and an essid. *)
let parse_pair nodename (wname, essid) = 
        let new_wi = { wi_name = wname; wi_nodename = nodename; wi_essid = essid} in
        let foo = try
                        let group = Hashtbl.find groups essid in
                        group.group_wis <- new_wi::group.group_wis;
                  with Not_found ->
                        let group = { group_essid = essid; group_wis = [ new_wi ] } in
                        Hashtbl.add groups essid group in
        new_wi

let parse_fields fields = 
        let nodename = head fields in
        let rec makepairs l = match l with
                                []              -> []
                              | x::[]           -> assert false
                              | a::b::xs        -> (a, b)::(makepairs xs) in
        let wis = List.map (parse_pair nodename) (makepairs (tail fields)) in
        let sorted_wis = List.sort compare wis in
        let node = { node_name = nodename; node_wis = sorted_wis } in
        Hashtbl.add nodes nodename node

let parse_file fname =
        let spacere = Str.regexp " " in
        List.iter (parse_fields $ (Str.split spacere)) (snarf_lines fname)
        ;;

(** Return a random configuration. For some reason, if this function accesses
  the global 'groups' hash instead of getting it passed in from above, that
  hash is empty. *)
let random_configuration groups evaluate =
        let h = Hashtbl.create 30 in
        Hashtbl.iter (fun k _ -> Hashtbl.add h k (1 + (Random.int 12))) groups;
        { score = (evaluate h); conf = h }

let print_conf conf = 
        let print_wi wi = wi.wi_name ^ ": " ^ (string_of_int (Hashtbl.find conf wi.wi_essid)) in
        let wis node = List.fold_left (fun acc wi -> acc ^ " " ^ (print_wi wi)) "" node.node_wis in
        let sorted_nodes = List.sort (fun a b -> compare (a.node_name) (b.node_name)) (values nodes) in
        List.iter (fun n -> print_string (n.node_name ^ ":" ^ (wis n) ^ "\n")) sorted_nodes

let parse_nodeclusters fname = 
        let spacere = Str.regexp " " in
        (* handle a row of fields. the first field is the supernode name, the
           rest are the subnode names. create a new node for the supernode,
           stuff all the wi's of the subnodes under it, names prefixed with
           their original node's names for clarity, and remove the subnodes
           from the nodes hashtable *)
        let do_fields f = let nodename = head f in
                          let subnodenames = tail f in
                          let subnodes = List.map (Hashtbl.find nodes) subnodenames in
                          List.iter (Hashtbl.remove nodes) subnodenames;
                          let prefixed_wis n = List.map (fun w -> { w with wi_name = n.node_name ^ "." ^ w.wi_name}) n.node_wis in
                          let wis = List.fold_left (fun a s -> a@(prefixed_wis s)) [] subnodes in
                          let node = { node_name = nodename; node_wis = wis } in
                          Hashtbl.add nodes nodename node in
        List.iter (do_fields $ (Str.split spacere)) (snarf_lines fname);;

(** Generalized evolutionary algorithm driver. 
      initialize: () -> configuration array
      recombine:
      mutate: configuration array -> configuration array
      evaluate: configuration array -> configuration array
      select: configuration array -> configuration array
      
    and the result is the best configuration *)
let evolutionary_algorithm initialize recombine mutate evaluate select = 
        let population = (evaluate $ initialize) () in
        let last_high_score = ref population.(0).score in
        let iterations_since_new_high_score = ref 0 in
        let generation = ref 0 in
        let all_nodes = values nodes in
        let _ = while !iterations_since_new_high_score < max_stagnant_iterations do
                let newpop = (recombine $ mutate $ evaluate $ select) population in
                Array.sort (fun a b -> compare b.score a.score) newpop;
                copyarray newpop population;
                let high_score = population.(0).score in
                if high_score > !last_high_score then begin
                        last_high_score := high_score;
                        iterations_since_new_high_score := 0
                end;
                assert (!last_high_score >= high_score);
                if (!generation mod 10) == 0 then begin
                        print_int !generation;
                        print_string ": ";
                        print_int !last_high_score;
                        print_newline();
                end;
                incr iterations_since_new_high_score;
                incr generation
        done in
        population.(0);;

let main = 
        parse_file Sys.argv.(1);
        parse_nodeclusters "coupled.conf";
        Random.self_init();
        let all_nodes = values nodes in
        let evaluate_hash = score_configuration all_nodes in
        let initialize () = Array.init population_size (fun _ -> random_configuration groups evaluate_hash) in
        let recombine x = x in
        let mutate_conf conf =
                Hashtbl.iter (fun essid _ -> let f = Random.float 1.0 in
                                             let group = Hashtbl.find groups essid in
                                             let maxchannel = if (List.length group.group_wis) == 1 then 11
                                                              else 13 in
                                             if (f < mutation_rate) then
                                                     Hashtbl.replace conf essid (1 + (Random.int maxchannel))) conf in
        let mutate population = let mutants = Array.map (fun c -> let hash = Hashtbl.copy c.conf in
                                                                  mutate_conf hash;
                                                                  { score = evaluate_hash hash;
                                                                    conf = hash}) population in
                                Array.append population mutants in
        let evaluate population = Array.iter (fun c -> c.score <- evaluate_hash c.conf) population;
                                  population in
        let select p = Array.sub p 0 ((Array.length p) / 2) in
        let best = evolutionary_algorithm initialize recombine mutate evaluate select in
        print_conf best.conf;;

main