#] #] ********************* #] loaddefs link d_Qndfs 'genetic algorithm.ndf' # www.BillHowell.ca 02Sep07 Warning: Use Courier constant-width font and no-line-wrap to view this file! (eg. using Notepad in Windows) Otherwise the code doesn't line up and it's hard to read. f_geneticAlgo := 'genetic algorithm.ndf' ; loaddefs_start f_geneticAlgo ; #**************************** # List of operators, generated with : # $ cat "$d_Qndfs""genetic algorithm.ndf" | grep "^#]" | sed 's/^#\]/ /' # ********************* loaddefs link d_Qndfs 'genetic algorithm.ndf' stnormal IS OP x - normal IS - de_normal IS OP mean stddev x - linear IS OP low high fraction - transcribe IS OP gene_transform gene_low gene_high sample - first_less IS OP a b - test_fn IS OP gene - randomize_list IS OP a - find_atom_paths IS OPERATION Array - deepplaceall IS OP C A - gene_initialize IS - adjust IS OP low high distribn stddev random_x val_original - crossover IS OP g1 g2 - mutate IS OP gene - evolve IS - #*********************************** adjust&_o := f_genetic ; crossover&_o := f_genetic ; deepplaceall&_o := f_genetic ; de_normal&_o := f_genetic ; evolve&_e := f_genetic ; evolve_snow&_v := f_genetic ; first_less&_o := f_genetic ; fout&_v := f_genetic ; gene_initialize&_o := f_genetic ; ice_height_init_spaces&_v := f_genetic ; linear&_o := f_genetic ; mutate&_o := f_genetic ; normal&_o := f_genetic ; randomize_list&_o := f_genetic ; stnormal&_o := f_genetic ; test_fn&_o := f_genetic ; transcribe&_o := f_genetic ; # externals defined in other files (evol_... and gene_... are internal to this file for examples) gene_distribns IS EXTERNAL variable ; gene_distribns&_v := f_genetic ; gene_highs IS EXTERNAL variable ; gene_highs&_v := f_genetic ; gene_indexes IS EXTERNAL variable ; gene_indexes&_v := f_genetic ; gene_leaf_shape IS EXTERNAL variable ; gene_leaf_shape&_v := f_genetic ; gene_lows IS EXTERNAL variable ; gene_lows&_v := f_genetic ; gene_mutation_rates IS EXTERNAL variable ; gene_mutation_rates&_v := f_genetic ; gene_paths IS EXTERNAL variable ; gene_paths&_v := f_genetic ; gene_shape IS EXTERNAL variable ; gene_shape&_v := f_genetic ; gene_stdev IS EXTERNAL variable ; gene_stdev&_v := f_genetic ; gene_talley IS EXTERNAL variable ; gene_talley&_v := f_genetic ; gene_transforms IS EXTERNAL variable ; gene_transforms&_v := f_genetic ; evol_crossover IS EXTERNAL variable ; evol_crossover&_v := f_genetic ; evol_duplication IS EXTERNAL variable ; evol_duplication&_v := f_genetic ; evol_func IS EXTERNAL variable ; evol_func&_v := f_genetic ; evol_mutation_rate IS EXTERNAL variable ; evol_mutation_rate&_v := f_genetic ; evol_n_gen IS EXTERNAL variable ; evol_n_gen&_v := f_genetic ; evol_n_offspring IS EXTERNAL variable ; evol_n_offspring&_v := f_genetic ; evol_n_parents IS EXTERNAL variable ; evol_n_parents&_v := f_genetic ; evol_stddev_decay IS EXTERNAL variable ; evol_stddev_decay&_v := f_genetic ; #****************************** General operators # gaussian distribution from QNial, Smillie stats IF flag_debug THEN write 'loading stnormal' ; ENDIF ; #] stnormal IS OP x - stnormal IS OP x { recip (2 times pi power 0.5) times exp (opp 0.5 times prod [pass,pass] x) } IF flag_debug THEN write 'loading normal' ; ENDIF ; #] normal IS - normal IS stnormal div[minus[second,first first],second first] % de_normal IS OP mean stddev x { mean * (1 [- , +] (exp ((opp x / stddev) power 2))) } IF flag_debug THEN write 'loading de_normal' ; ENDIF ; #] de_normal IS OP mean stddev x - de_normal IS OP mean stddev x { mean * (1 [- , +] (exp ((opp x / stddev) power 2))) } # other stuff IF flag_debug THEN write 'loading linear' ; ENDIF ; #] linear IS OP low high fraction - linear IS OP low high fraction { low + ((high - low) * fraction) } IF flag_debug THEN write 'loading transcribe' ; ENDIF ; #] transcribe IS OP gene_transform gene_low gene_high sample - transcribe IS OP gene_transform gene_low gene_high sample { APPLY gene_transform (gene_low gene_high sample) } IF flag_debug THEN write 'loading first_less' ; ENDIF ; #] first_less IS OP a b - first_less IS OP a b { (first a) <= (first b) } IF flag_debug THEN write 'loading test_fn' ; ENDIF ; #] test_fn IS OP gene - test_fn IS OP gene { EACH sum EACH sum gene } # randomize_list - "a" must have valence = 1, shape >= 1 IF flag_debug THEN write 'loading randomize_list' ; ENDIF ; #] randomize_list IS OP a - randomize_list IS OP a { len := first gage shape a ; IF len = 1 THEN a ELSE index_take := floor ((random 1) * len) ; test_left := link ([index_take take, (index_take + 1) drop] a) ; (solitary a@index_take) link (randomize_list test_left) ENDIF } # find_atom_paths - original findpaths from NialLib IF flag_debug THEN write 'loading find_atom_paths' ; ENDIF ; #] find_atom_paths IS OPERATION Array - find_atom_paths IS OPERATION Array { findpath2 IS OPERATION Array Pathsofar { IF atomic Array THEN solitary Pathsofar ELSE link EACHALL findpath2 Array ( Pathsofar EACHRIGHT append grid Array ) ENDIF } ; findpath2 Array Null } IF flag_debug THEN write 'loading deepplaceall' ; ENDIF ; #] deepplaceall IS OP C A - # deepplaceall - original deepplace from NialLib deepplaceall IS OP C A { FOR i WITH C DO B Path := i ; ii := first Path ; A := ((B (rest Path)) deepplace (ii pick A)) ii place A ; ENDFOR ; A } #**************************** Evolutionary computation-specific operators IF flag_debug THEN write 'loading gene_initialize' ; ENDIF ; #] gene_initialize IS - gene_initialize IS { NONLOCAL evol_n_offspring gene_lows gene_highs gene_transforms ; samples := EACH EACH link (LEAF random (evol_n_offspring reshape (solitary LEAF tally gene_lows)) ) ; TWIG transcribe (EACH first (EACH [EACH pack pack] (gene_transforms gene_lows gene_highs EACHRIGHT append samples))) } # Normal distribution - here's my best guess without a book X := (x - u)^2 / sigma x := u + sqrt(X * sigma) IF flag_debug THEN write 'loading adjust' ; ENDIF ; #] adjust IS OP low high distribn stddev random_x val_original - adjust IS OP low high distribn stddev random_x val_original { IF distribn = "Uniform THEN y := val_original + ((2 * (random_x - 0.5) * stddev)) ; ELSEIF distribn = "Gaussian THEN IF first (< (random 1) 0.5) THEN signer := -1. ELSE signer := 1. ENDIF ; y := val_original + (sqrt (random_x * stddev) * signer) ; ELSE y := quiet_fault '?adjust - distribution not provided' ; ENDIF ; IF isfault y THEN y ELSEIF y < low THEN low ELSEIF y > high THEN high ELSE y ENDIF } # crossover - right now retain best n_parent of the last generation, add newbies, so ALL new_gen are crossover and/or mutation crossovers DON't currently exchange genes of different types (position) crossover ALL evol_n_parents, mutate both old & new NOTE: must ensure that evol_n_offspring >= evol_n_parents!! IF flag_debug THEN write 'loading crossover' ; ENDIF ; #] crossover IS OP g1 g2 - crossover IS OP g1 g2 { NONLOCAL evol_crossover gene_indexes gene_shape ; gene_swaps := (evol_crossover > random gene_shape) sublist gene_indexes ; g1_swap := gene_swaps choose g1 ; g1 := (gene_swaps choose g2) gene_swaps placeall g1 ; g2 := g1_swap gene_swaps placeall g2 ; g1 g2 } # mutate - IF flag_debug THEN write 'loading mutate' ; ENDIF ; #] mutate IS OP gene - mutate IS OP gene { NONLOCAL gene_distribns gene_highs gene_leaf_shape gene_lows gene_mutation_rates gene_paths gene_stdev ; % ; mutation_paths := (gene_mutation_rates > random gene_leaf_shape) sublist gene_paths ; IF empty mutation_paths THEN gene ELSE lows := mutation_paths EACHLEFT reach gene_lows ; highs := mutation_paths EACHLEFT reach gene_highs ; stdevs := mutation_paths EACHLEFT reach gene_stdev ; distribns := mutation_paths EACHLEFT reach gene_distribns ; val_originals := mutation_paths EACHLEFT reach gene ; random_xs := random (shape mutation_paths) ; val_mutants := EACH adjust (pack (lows highs distribns stdevs random_xs val_originals)) ; (val_mutants EACHBOTH pair mutation_paths) deepplaceall gene ENDIF } # evolve IF flag_debug THEN write 'loading evolve' ; ENDIF ; #] evolve IS - evolve IS { NONLOCAL gene_distribns gene_lows gene_highs gene_paths gene_shape gene_talley gene_transforms evol_func evol_n_gen evol_n_offspring evol_n_parents evol_stddev_decay ; % ; offspring := gene_initialize ; gene_feed := null ; gene_oldlist := null ; % not used here - see full version for all genes generated ; % ; FOR i WITH tell evol_n_gen DO fn_evals := EACHRIGHT apply evol_func offspring ; break ; writescreen (link (string i) ' ' (string (sum fn_evals / gage shape fn_evals)) ) ; gene_feed := evol_n_parents take (cull SORT first_less ((fn_evals EACHBOTH append offspring) link gene_feed) ) ; gene_feed_noeval := EACH second gene_feed ; offspring_base := evol_n_offspring reshape gene_feed_noeval ; gene_crossover_pairs := EACHBOTH pair ([pass, randomize_list] offspring_base) ; % must be an even number - to make pairs ; offspring_initial := link EACH crossover gene_crossover_pairs ; % de-pair them now!! ; offspring_cross&mutate := EACH mutate offspring_initial ; % ALL are crossovered, only a few mutated coarsely ; offspring_mutate_gentle := EACH mutate gene_feed_noeval ; % ALL are mutated - at least one gene ; gene_stdev := gene_stdev * evol_stddev_decay ; offspring := cull (link gene_feed_noeval offspring_cross&mutate offspring_mutate_gentle) ; ENDFOR ; post gene_feed } # old style - retain all genes for final printout.. FOR i WITH tell evol_n_gen DO fn_evals := apply evol_func offspring ; gene_feed gene_lost := [evol_n_parents take, evol_n_parents drop] (cull SORT first_less ((fn_evals EACHBOTH append offspring) link gene_feed) ) ; gene_oldlist := gene_lost link gene_oldlist ; % ; gene_feed_noeval := EACH second gene_feed ; offspring_base := evol_n_offspring reshape gene_feed_noeval ; gene_crossover_pairs := EACHBOTH pair ([pass, randomize_list] offspring_base) ; % must be an even number - to make pairs ; offspring_initial := link EACH crossover gene_crossover_pairs ; % de-pair them now!! ; offspring_cross&mutate := EACH mutate offspring_initial ; % ALL are crossovered, only a few mutated coarsely ; offspring_mutate_gentle := EACH mutate gene_feed_noeval ; % ALL are mutated - at least one gene ; offspring := cull (link gene_feed_noeval offspring_cross&mutate offspring_mutate_gentle) ; writescreen (link (string i) ENDFOR ; post link gene_feed gene_oldlist # Examples setlogname 'C:\Documents and Settings\William Neil Howell\My Documents\Climate\Howell\Glaciation model 004\auto.nlg' ; set "log ; % ; % gene_specs ((factor_snow factor_melt) (threshold_snow threshold_melt) (solitary albedo_factor) (solitary ice_flow_3000)) ; gene_lows := (( 0. 0. ) ( 0. 0. ) (solitary 0.0 ) (solitary 0. )) ; gene_highs := ((10. 10. ) (10. 10. ) (solitary 0.0 ) (solitary 1000. )) ; gene_stdev := (( 3. 3. ) ( 3. 3. ) (solitary 0.0 ) (solitary 300. )) ; gene_mutation_rates := link ((0.05 0.05 ) ( 0.05 0.05 ) (solitary 0.05 ) (solitary 0.05 )) ; gene_transforms := (("linear "linear ) ("linear "linear ) (solitary "linear ) (solitary "linear )) ; gene_distribns := (("Poisson "Poisson ) ("Poisson "Poisson ) (solitary "Poisson ) (solitary "Poisson )) ; gene_distribns := (("Gaussian "Gaussian ) ("Gaussian "Gaussian ) (solitary "Gaussian ) (solitary "Gaussian )) ; gene_distribns := (("Uniform "Uniform ) ("Uniform "Uniform ) (solitary "Uniform ) (solitary "Uniform )) ; gene_shape := gage shape gene_lows ; gene_leaf_shape := gage shape (link gene_lows) ; gene_indexes := tell gene_shape ; gene_paths := find_atom_paths gene_lows ; gene_talley := LEAF tally gene_lows ; % gene_specs -> gene_distribns gene_lows gene_highs gene_indexes gene_leaf_shape gene_paths gene_shape gene_talley gene_transforms ; % ; % evolve_params -> evol_crossover evol_duplication evol_func evol_n_gen evol_n_offspring evol_n_parents evol_stddev_decay ; evol_func := "test_fn ; evol_n_gen := 20 ; evol_n_parents := 20 ; evol_n_offspring := 30 ; evol_crossover := 0.30 ; evol_duplication := 0.0 ; evol_stddev_decay := 0.95 ; # tests Results post (deepplaceall (solitary (22.54 (0 1))) gene_lows) '|0. 22.54|0. 0.|0.|0.|' post (deepplaceall ( (33.54 (1 0)) (0.9999 (3 0)) (-12 (1 1)) ) gene_lows) '|0. 0.|33.54 -12|0.|0.9999|' post (crossover gene_lows gene_highs) 'eg. ||10. 10.|0. 0.|0.|0.|||0. 0.|10. 10.|0.|1000.|| ' post gene_initialize 'big data!! not shown here' adjust 0. 10. "Uniform 0.2 0.3 5 '4.92' adjust 0. 10. "Uniform 0.2 (first random 1) 5 '???' adjust 0. 10. "Gaussian 0.2 (first random 1) 5 '???' adjust 0. 10. "Poisson 0.2 (first random 1) 5 '???' (gene_mutation_rates > random gene_leaf_shape) sublist gene_paths mutate gene_lows For i WITH tell 10 DO write mutate gene_lows ENDFOR evolve loaddefs_ended f_geneticAlgo ; # enddoc