Index: nodes/channelga.ml
===================================================================
--- nodes/channelga.ml	(revision 1974)
+++ nodes/channelga.ml	(revision 1979)
@@ -1,2 +1,26 @@
+(**
+  experiment met evolutionary programming voor de kanalenplanning
+  het genetische zit er nu nauwelijks in, en wat er in zit is ongetwijfeld
+  fout. wat er wel goed in zit is het parseren van de bestaande situatie en
+  het scoren van (nu random) configuraties.
+
+  de score functie is nu redelijk simplistisch:
+    - de score van een combinatie van twee interfaces op een node is 1 als er
+      twee of meer kanalen tussen zitten, en -1 als er 1 kanaal tussen zit, -5
+      als er geen kanaal tussen zit en -10 als de kanalen hetzelfde zijn
+    - de score van een node is de som van de scores van alle combinaties van
+      interfaces van die node, maal het aantal interfaces. dat laatste omdat
+      een positieve score hebben knapper is met meer interfaces dan met minder,
+      dus dat moet beloond. een negatieve score is erger met meer interfaces
+      (belangrijker node, waarschijnlijk) dan met minder, dus dat moet
+      bestraft.
+    - de totale score is de som van de scores van de nodes
+
+  het stukje "genetisch" aan het einde is afgeraffeld. mutation en
+  recombination gebeuren op de oplossing zelf ipv op een bitstring
+  representatie. selection is dom en neemt gewoon de helft beste oplossingen.
+
+  lvoge@cs.vu.nl *)
+
 (* a few constants *)
 let population_size = 20
@@ -4,16 +28,19 @@
 and mutation_rate = 0.05;;
 
-(* the type definitions. note the 'and' to string them together in a mutually
-   recursive blob so wi and node can refer to eachother *)
+(* 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 = {
-	winame: string;
-	node: node ref;
-	group: group ref;
-} and group = {
-	essid: string;
-	groupwis: wi ref list;
-} and node = {
-	nodename: string;
-	nodewis: wi list;
+	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;
 };;
 
@@ -21,10 +48,10 @@
 let groups = Hashtbl.create 4;;
 
-type score = int
- and channel = int;;
-
+(* some convenience functions *)
 let compose f g = fun x -> f(g(x));;
 let ($) = compose;;
 let maketuple a b = (a, b);;
+let head = List.hd;;
+let tail = List.tl;;
 (* given a hashtable, return all the keys as a list *)
 let keys t = Hashtbl.fold (fun k d a -> k::a) t [];;
@@ -37,15 +64,14 @@
 	match l with
 	  []	-> []
-	| x::xs	-> (List.map (maketuple x) xs)@(combinations xs)
-;;
+	| 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);
+	let scoretable = [ ((<=) 2,  1);
 			   ((==) 2, -1);
 			   ((==) 1, -5);
 			   ((==) 0, -10) ] in
-	let channel1 = c !(wi1.group) in
-	let channel2 = c !(wi2.group) 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
@@ -55,14 +81,14 @@
 	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
-	List.fold_left foldfunc 0 (combinations n.nodewis);;
+	List.fold_left foldfunc 0 (combinations n.node_wis);;
 
 let score_configuration c (ns: node list) =
-	let mapper g = Hashtbl.find c g.essid in
-	let foldfunc acc n = acc + (node_score mapper n) in
+	let foldfunc acc n = acc + (node_score (Hashtbl.find c) n) in
 	List.fold_left foldfunc 0 ns;;
-
-let add_wi_to_node n (w: wi) = { n with nodewis = (w::n.nodewis) };;
 
 (* given a filename, return a list of all the lines in the file with the given
@@ -78,15 +104,39 @@
 	with End_of_file -> !result
 
+let parse_pair nodename (wname, gname) = 
+	let new_wi = { wi_name = wname; wi_nodename = nodename; wi_essid = gname} in
+	let foo = try
+			let group = Hashtbl.find groups gname in
+			group.group_wis <- new_wi::group.group_wis;
+		  with Not_found ->
+			let group = { group_essid = gname; group_wis = [ new_wi ] } in
+			print_string "added group ";
+			print_string gname;
+			print_newline();
+			Hashtbl.add groups gname 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 bogus_node = { nodename = "foo"; nodewis = [] } in
-	Hashtbl.add nodes fname bogus_node;
-	Hashtbl.add groups fname 1;
+	let spacere = Str.regexp " " in
+	List.iter (parse_fields $ (Str.split spacere)) (snarf_lines fname)
 	;;
 
-let random_configuration =
+let random_configuration groups =
 	let conf = Hashtbl.create 30 in
 	Hashtbl.iter (fun k d -> Hashtbl.add conf k (1 + (Random.int 12))) groups;
 	conf
 
+(* Mutate the configuration in the given population at the given offset *)
 let mutate p i = 
 	Hashtbl.iter (fun essid chan -> let f = Random.float 1.0 in
@@ -94,10 +144,17 @@
 					  Hashtbl.replace p.(i) essid (1 + (Random.int 13))) p.(i);;
 
+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 main = 
-	List.iter parse_file (snarf_lines Sys.argv.(1));
+	parse_file Sys.argv.(1);
 	Random.self_init();
-	let population = Array.init population_size (fun _ -> random_configuration) in
+	let population = Array.init population_size (fun _ -> random_configuration groups) in
 	let last_high_score = ref (-1000000) in
 	let iterations_since_new_high_score = ref 0 in
+	let generation = ref 0 in
 	let all_nodes = values nodes in
 	while !iterations_since_new_high_score < max_stagnant_iterations do
@@ -112,5 +169,6 @@
 		let score_pop = Array.map (fun c -> ((score_configuration c all_nodes), c)) population in
 		(* sort on the first field *)
-		Array.sort (fun x y -> compare (fst x) (fst y)) score_pop;
+		Array.sort (fun x y -> compare (fst y) (fst x)) score_pop;
+		Array.blit (Array.map snd score_pop) 0 population 0 (Array.length score_pop);
 		(* now look at the best score and update the highscore if
 		   necessary *)
@@ -120,11 +178,15 @@
 			iterations_since_new_high_score := 0
 		end;
-		(*print_int high_score;*)
-		print_int !iterations_since_new_high_score;
-		print_newline();
-		incr iterations_since_new_high_score
+		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;
-	()
-;;
+	print_conf population.(0);;
 
 main
