From ffad29e4257c5486d5982efbafa842644bd9f44c Mon Sep 17 00:00:00 2001 From: karinemiras Date: Wed, 12 Feb 2020 16:30:15 +0100 Subject: [PATCH] reproducible code --- .../baseline_big.py | 0 ...bots_summary_renders_journal2_tilted_big.r | 86 +++ .../consolidate_experiments.py | 6 +- .../plasticoding_frontiers2020/flat_big.py | 150 +++++ .../plasticoding_frontiers2020/plastic_big.py | 0 .../run-experiments | 25 +- .../summary_measures_journal2_tilted_big_1.R | 528 ++++++++++++++++++ .../summary_measures_journal2_tilted_big_2.R | 365 +++++++++++- .../summary_measures_journal2_tilted_big_3.R | 51 +- .../plasticoding_frontiers2020/tilted_big.py | 150 +++++ 10 files changed, 1315 insertions(+), 46 deletions(-) mode change 100755 => 100644 experiments/plasticoding_frontiers2020/baseline_big.py create mode 100644 experiments/plasticoding_frontiers2020/flat_big.py mode change 100755 => 100644 experiments/plasticoding_frontiers2020/plastic_big.py mode change 100755 => 100644 experiments/plasticoding_frontiers2020/run-experiments create mode 100644 experiments/plasticoding_frontiers2020/summary_measures_journal2_tilted_big_1.R create mode 100644 experiments/plasticoding_frontiers2020/tilted_big.py diff --git a/experiments/plasticoding_frontiers2020/baseline_big.py b/experiments/plasticoding_frontiers2020/baseline_big.py old mode 100755 new mode 100644 diff --git a/experiments/plasticoding_frontiers2020/bestrobots_summary_renders_journal2_tilted_big.r b/experiments/plasticoding_frontiers2020/bestrobots_summary_renders_journal2_tilted_big.r index e69de29bb2..1faba877a2 100644 --- a/experiments/plasticoding_frontiers2020/bestrobots_summary_renders_journal2_tilted_big.r +++ b/experiments/plasticoding_frontiers2020/bestrobots_summary_renders_journal2_tilted_big.r @@ -0,0 +1,86 @@ + +library(sqldf) +require('magick') + +##### change paths/labels/params here ##### + + +paths = c( 'baseline_big', 'plastic_big' ) + +environments = list( + c( 'plane','tilted5'), + c( 'plane','tilted5') +) + +base_directory <- paste('journal2/', sep='') + +runs = list( c(1:20), c(1:20) ) +gens = 200 +pop = 100 +num_top = 1 + +analysis = 'images' + +##### change paths/labels/params here ##### + +output_directory = paste(base_directory,analysis, sep='') + + +file <-file(paste(output_directory,'/best.txt',sep=''), open="w") + +# for each method +for(m in 1:length(paths)) +{ + # for each repetition + for (exp in runs[[m]]) + { + + input_directory1 <- paste(base_directory, paths[m],'_',exp, '/data_fullevolution/',environments[[m]][1],sep='') + input_directory2 <- paste(base_directory, paths[m],'_',exp, '/selectedpop_', sep='') + + ids_gens = data.frame() + list = strsplit(list.files(paste(input_directory2, environments[[m]][1],'/selectedpop_',gens-1, sep='')), ' ') + for(geno in 1:pop) + { + genome = data.frame(cbind(c(gens), c(strsplit(strsplit(list [[geno]],'_')[[1]][3],'.png')[[1]][1] ))) + names(genome)<-c('generation','robot_id') + ids_gens = rbind(ids_gens,genome) + } + + measures = read.table(paste(input_directory1,"/all_measures.tsv", sep=''), header = TRUE, fill=TRUE) + bests = sqldf(paste("select robot_id, cons_fitness from measures inner join ids_gens using (robot_id) order by cons_fitness desc limit",num_top)) + + for(b in 1:nrow(bests)) + { + + writeLines( paste(paths[m],'exp',exp,bests[b,'robot_id'] ,bests[b,'cons_fitness'] ), file ) + print( paste(paths[m],'exp',exp,bests[b,'robot_id'] ,bests[b,'cons_fitness'] )) + + phenotype= bests[b,'robot_id'] + + for (env in 1:length(environments[[m]])) + { + patha = paste(input_directory2, environments[[m]][env], "/selectedpop_",gens-1,sep="") + + body <- list.files(patha, paste("body_robot_",phenotype,".png$",sep=""), full.names = TRUE) + body = image_read(body) + body = image_scale(body, "100x100") + body = image_border(image_background(body, "white"), "white", "5x5") + + if(b == 1 && env == 1) + { + bodies = body + }else{ + bodies = c(bodies, body) + } + } + } + + side_by_side = image_append(bodies, stack=F) + image_write(side_by_side, path = paste(output_directory,"/",paths[m],'_', environments[[m]][env], "_bodies_best_",exp,".png",sep=''), format = "png") + + } +} + + +close(file) diff --git a/experiments/plasticoding_frontiers2020/consolidate_experiments.py b/experiments/plasticoding_frontiers2020/consolidate_experiments.py index 21df238414..fbdd9dc878 100644 --- a/experiments/plasticoding_frontiers2020/consolidate_experiments.py +++ b/experiments/plasticoding_frontiers2020/consolidate_experiments.py @@ -4,12 +4,14 @@ # set these variables according to your experiments # dirpath = 'data/' experiments_type = [ - + 'flat_big', +'tilted_big', 'plastic_big' ,'baseline_big' ] environments = { - + 'flat_big': ['plane'], +'tilted_big': ['tilted5'], 'plastic_big': ['plane','tilted5'] ,'baseline_big': ['plane','tilted5'] } diff --git a/experiments/plasticoding_frontiers2020/flat_big.py b/experiments/plasticoding_frontiers2020/flat_big.py new file mode 100644 index 0000000000..9449d9ff61 --- /dev/null +++ b/experiments/plasticoding_frontiers2020/flat_big.py @@ -0,0 +1,150 @@ +#!/usr/bin/env python3 +import asyncio + +from pyrevolve import parser +from pyrevolve.evolution import fitness +from pyrevolve.evolution.selection import multiple_selection, tournament_selection +from pyrevolve.evolution.population import Population, PopulationConfig +from pyrevolve.evolution.pop_management.steady_state import steady_state_population_management +from pyrevolve.experiment_management import ExperimentManagement +from pyrevolve.genotype.plasticoding.crossover.crossover import CrossoverConfig +from pyrevolve.genotype.plasticoding.crossover.standard_crossover import standard_crossover +from pyrevolve.genotype.plasticoding.initialization import random_initialization +from pyrevolve.genotype.plasticoding.mutation.mutation import MutationConfig +from pyrevolve.genotype.plasticoding.mutation.standard_mutation import standard_mutation +from pyrevolve.genotype.plasticoding.plasticoding import PlasticodingConfig +from pyrevolve.tol.manage import measures +from pyrevolve.util.supervisor.simulator_queue import SimulatorQueue +from pyrevolve.util.supervisor.analyzer_queue import AnalyzerQueue +from pyrevolve.custom_logging.logger import logger +import sys + +async def run(): + """ + The main coroutine, which is started below. + """ + + # experiment params # + num_generations = 200 + population_size = 100 + offspring_size = 100 + front = None + + # environment world and z-start + environments = {'plane': 0.03} + + genotype_conf = PlasticodingConfig( + max_structural_modules=15, + plastic=False, + ) + + mutation_conf = MutationConfig( + mutation_prob=0.8, + genotype_conf=genotype_conf, + ) + + crossover_conf = CrossoverConfig( + crossover_prob=0.8, + ) + # experiment params # + + # Parse command line / file input arguments + settings = parser.parse_args() + experiment_management = ExperimentManagement(settings, environments) + do_recovery = settings.recovery_enabled and not experiment_management.experiment_is_new() + + logger.info('Activated run '+settings.run+' of experiment '+settings.experiment_name) + + if do_recovery: + gen_num, has_offspring, next_robot_id = experiment_management.read_recovery_state(population_size, + offspring_size) + + if gen_num == num_generations-1: + logger.info('Experiment is already complete.') + return + else: + gen_num = 0 + next_robot_id = 1 + + def fitness_function_plane(robot_manager, robot): + return fitness.displacement_velocity_hill(robot_manager, robot, False) + + fitness_function = {'plane': fitness_function_plane} + + population_conf = PopulationConfig( + population_size=population_size, + genotype_constructor=random_initialization, + genotype_conf=genotype_conf, + fitness_function=fitness_function, + mutation_operator=standard_mutation, + mutation_conf=mutation_conf, + crossover_operator=standard_crossover, + crossover_conf=crossover_conf, + selection=lambda individuals: tournament_selection(individuals, environments, 2), + parent_selection=lambda individuals: multiple_selection(individuals, 2, tournament_selection, environments), + population_management=steady_state_population_management, + population_management_selector=tournament_selection, + evaluation_time=settings.evaluation_time, + offspring_size=offspring_size, + experiment_name=settings.experiment_name, + experiment_management=experiment_management, + environments=environments, + front=front + ) + + settings = parser.parse_args() + + simulator_queue = {} + analyzer_queue = None + + previous_port = None + for environment in environments: + + settings.world = environment + settings.z_start = environments[environment] + + if previous_port is None: + port = settings.port_start + previous_port = port + else: + port = previous_port+settings.n_cores + previous_port = port + + simulator_queue[environment] = SimulatorQueue(settings.n_cores, settings, port) + await simulator_queue[environment].start() + + analyzer_queue = AnalyzerQueue(1, settings, port+settings.n_cores) + await analyzer_queue.start() + + population = Population(population_conf, simulator_queue, analyzer_queue, next_robot_id) + + if do_recovery: + + if gen_num >= 0: + # loading a previous state of the experiment + await population.load_snapshot(gen_num) + logger.info('Recovered snapshot '+str(gen_num)+', pop with ' + str(len(population.individuals))+' individuals') + + if has_offspring: + individuals = await population.load_offspring(gen_num, population_size, offspring_size, next_robot_id) + gen_num += 1 + logger.info('Recovered unfinished offspring '+str(gen_num)) + + if gen_num == 0: + await population.init_pop(individuals) + else: + population = await population.next_gen(gen_num, individuals) + + experiment_management.export_snapshots(population.individuals, gen_num) + else: + # starting a new experiment + experiment_management.create_exp_folders() + await population.init_pop() + experiment_management.export_snapshots(population.individuals, gen_num) + + while gen_num < num_generations-1: + gen_num += 1 + population = await population.next_gen(gen_num) + experiment_management.export_snapshots(population.individuals, gen_num) + + # output result after completing all generations... diff --git a/experiments/plasticoding_frontiers2020/plastic_big.py b/experiments/plasticoding_frontiers2020/plastic_big.py old mode 100755 new mode 100644 diff --git a/experiments/plasticoding_frontiers2020/run-experiments b/experiments/plasticoding_frontiers2020/run-experiments old mode 100755 new mode 100644 index 86bb03c846..a48cea1da7 --- a/experiments/plasticoding_frontiers2020/run-experiments +++ b/experiments/plasticoding_frontiers2020/run-experiments @@ -20,16 +20,25 @@ while true done done - - - + while true + do + for i in {1..20}; do + ./revolve.py --experiment-name karines_experiments/data/flat_big_$i --run $i --manager experiments/karines_experiments/flat_big.py --n-cores 4 --port-start 11141 --evaluation-time 50; -while true + sleep 5s + done +done + + + while true do - sleep 900s; - kill $( ps aux | grep 'gzserver' | awk '{print $2}'); - kill $( ps aux | grep 'revolve.py' | awk '{print $2}'); - sleep 60s; + for i in {1..20}; do + ./revolve.py --experiment-name karines_experiments/data/tilted_big_$i --run $i --manager experiments/karines_experiments/tilted_big.py --n-cores 4 --port-start 11141 --evaluation-time 50; + + sleep 5s + done done + + diff --git a/experiments/plasticoding_frontiers2020/summary_measures_journal2_tilted_big_1.R b/experiments/plasticoding_frontiers2020/summary_measures_journal2_tilted_big_1.R new file mode 100644 index 0000000000..0beb61d404 --- /dev/null +++ b/experiments/plasticoding_frontiers2020/summary_measures_journal2_tilted_big_1.R @@ -0,0 +1,528 @@ + library(ggplot2) + library(sqldf) + library(plyr) + library(dplyr) + library(trend) + library(purrr) + library(ggsignif) + + base_directory <-paste('journal2', sep='') + +analysis = 'analysis_journal2_tilted_big_1' + +output_directory = paste(base_directory,'/',analysis ,sep='') + +#### CHANGE THE PARAMETERS HERE #### + + +experiments_type = c( 'flat_big', 'tilted_big' ) + +environments = list(c( 'plane'), c('tilted5') ) + +methods = c() +for (exp in 1:length(experiments_type)) +{ + for (env in 1:length(environments[[exp]])) + { + methods = c(methods, paste(experiments_type[exp], environments[[exp]][env], sep='_')) + } +} + +initials = c( 'p', 't' ) + +experiments_labels = c( 'Static: Flat', 'Static: Tilted') + + runs = list( c(1:20), c(1:20) ) + + gens = 200 + pop = 100 + + #### CHANGE THE PARAMETERS HERE #### + + sig = 0.05 + line_size = 30 + show_markers = TRUE#FALSE + show_legends = FALSE + experiments_type_colors = c( '#009999' , '#cc9900' ) # weird green and weird yellow + + measures_names = c( + 'displacement_velocity_hill', + 'head_balance', + 'contacts', + 'displacement_velocity', + 'branching', + 'branching_modules_count', + 'limbs', + 'extremities', + 'length_of_limbs', + 'extensiveness', + 'coverage', + 'joints', + 'hinge_count', + 'active_hinges_count', + 'brick_count', + 'touch_sensor_count', + 'brick_sensor_count', + 'proportion', + 'width', + 'height', + 'absolute_size', + 'sensors', + 'symmetry', + 'avg_period', + 'dev_period', + 'avg_phase_offset', + 'dev_phase_offset', + 'avg_amplitude', + 'dev_amplitude', + 'avg_intra_dev_params', + 'avg_inter_dev_params', + 'sensors_reach', + 'recurrence', + 'synaptic_reception', + 'fitness', + 'cons_fitness' + ) + + # add proper labels soon... + measures_labels = c( + 'Speed (cm/s)', + 'Balance', + 'Contacts', + 'displacement_velocity', + 'Branching', + 'branching_modules_count', + 'Rel number of limbs', + 'extremities', + 'Rel. Length of Limbs', + 'extensiveness', + 'coverage', + 'Rel. Number of Joints', + 'hinge_count', + 'active_hinges_count', + 'brick_count', + 'touch_sensor_count', + 'brick_sensor_count', + 'Proportion', + 'width', + 'height', + 'Size', + 'sensors', + 'Symmetry', + 'Average Period', + 'dev_period', + 'avg_phase_offset', + 'dev_phase_offset', + 'avg_amplitude', + 'dev_amplitude', + 'avg_intra_dev_params', + 'avg_inter_dev_params', + 'sensors_reach', + 'recurrence', + 'synaptic_reception', + 'Fitness', + 'Number of slaves' + ) + + + measures_snapshots_all = NULL + + for (exp in 1:length(experiments_type)) + { + for(run in runs[[exp]]) + { + for (env in 1:length(environments[[exp]])) + { + input_directory <- paste(base_directory, '/', + experiments_type[exp], '_',sep='') + + measures = read.table(paste(input_directory, run, '/data_fullevolution/', + environments[[exp]][env], "/all_measures.tsv", sep=''), header = TRUE, fill=TRUE) + for( m in 1:length(measures_names)) + { + measures[measures_names[m]] = as.numeric(as.character(measures[[measures_names[m]]])) + } + + snapshots = read.table(paste(input_directory, run,'/selectedpop_', + environments[[exp]][env],"/snapshots_ids.tsv", sep=''), header = TRUE) + + measures_snapshots = sqldf('select * from snapshots inner join measures using(robot_id) order by generation') + + measures_snapshots$run = run + measures_snapshots$displacement_velocity_hill = measures_snapshots$displacement_velocity_hill*100 + measures_snapshots$run = as.factor(measures_snapshots$run) + measures_snapshots$method = paste(experiments_type[exp], environments[[exp]][env],sep='_') + + if ( is.null(measures_snapshots_all)){ + measures_snapshots_all = measures_snapshots + }else{ + measures_snapshots_all = rbind(measures_snapshots_all, measures_snapshots) + } + } + } + } + + + fail_test = sqldf(paste("select method,run,generation,count(*) as c from measures_snapshots_all group by 1,2,3 having c<",gens," order by 4")) + + + measures_snapshots_all = sqldf("select * from measures_snapshots_all where cons_fitness IS NOT NULL") + + + + + measures_averages_gens_1 = list() + measures_averages_gens_2 = list() + + measures_ini = list() + measures_fin = list() + + for (met in 1:length(methods)) + { + + measures_aux = c() + query ='select run, generation' + for (i in 1:length(measures_names)) + { + query = paste(query,', avg(',measures_names[i],') as ', methods[met], '_',measures_names[i],'_avg', sep='') + } + query = paste(query,' from measures_snapshots_all + where method="', methods[met],'" group by run, generation', sep='') + + temp = sqldf(query) + + measures_averages_gens_1[[met]] = temp + + temp = measures_averages_gens_1[[met]] + + temp$generation = as.numeric(temp$generation) + + measures_ini[[met]] = sqldf(paste("select * from temp where generation=0")) + measures_fin[[met]] = sqldf(paste("select * from temp where generation=",gens-1)) + query = 'select generation' + for (i in 1:length(measures_names)) + { + # later renames vars _avg_SUMMARY, just to make it in the same style as the quantile variables + query = paste(query,', avg(', methods[met], '_',measures_names[i],'_avg) as ' + ,methods[met],'_',measures_names[i],'_avg', sep='') + query = paste(query,', max(', methods[met],'_',measures_names[i],'_avg) as ' + ,methods[met],'_',measures_names[i],'_max', sep='') + query = paste(query,', stdev(', methods[met],'_',measures_names[i],'_avg) as ' + , methods[met],'_',measures_names[i],'_stdev', sep='') + query = paste(query,', median(', methods[met],'_',measures_names[i],'_avg) as ' + , methods[met],'_',measures_names[i],'_median', sep='') + + measures_aux = c(measures_aux, paste(methods[met],'_',measures_names[i],'_avg', sep='') ) + } + query = paste(query,' from temp group by generation', sep="") + + temp2 = sqldf(query) + + p <- c(0.25, 0.75) + p_names <- map_chr(p, ~paste0('Q',.x*100, sep="")) + p_funs <- map(p, ~partial(quantile, probs = .x, na.rm = TRUE)) %>% + set_names(nm = p_names) + + quantiles = data.frame(temp %>% + group_by(generation) %>% + summarize_at(vars(measures_aux), funs(!!!p_funs)) ) + + measures_averages_gens_2[[met]] = sqldf('select * from temp2 inner join quantiles using (generation)') + + } + + + for (met in 1:length(methods)) + { + if(met==1){ + measures_averages_gens = measures_averages_gens_2[[1]] + }else{ + measures_averages_gens = merge(measures_averages_gens, measures_averages_gens_2[[met]], all=TRUE, by = "generation") + } + } + + file <-file(paste(output_directory,'/trends.txt',sep=''), open="w") + + #tests trends in curves and difference between ini and fin generations + + + # ini VS fin + array_wilcoxon = list() + array_wilcoxon2 = list() + + # curve + array_mann = list() + + + for (m in 1:length(methods)) + { + + array_wilcoxon[[m]] = list() + array_mann[[m]] = list() + + for (i in 1:length(measures_names)) + { + + writeLines(paste(experiments_type[m],measures_names[i],'ini avg ',as.character( + mean(c(array(measures_ini[[m]][paste(methods[m],"_",measures_names[i],"_avg",sep='')]) )[[1]]) ) ,sep=" "), file ) + + + writeLines(paste(methods[m],measures_names[i],'fin avg ',as.character( + mean(c(array(measures_fin[[m]][paste(methods[m],"_",measures_names[i],"_avg",sep='')]) )[[1]]) ) ,sep=" "), file ) + + array_wilcoxon[[m]][[i]] = wilcox.test(c(array(measures_ini[[m]][paste(methods[m],"_",measures_names[i],"_avg",sep='')]))[[1]] , + c(array(measures_fin[[m]][paste(methods[m],"_",measures_names[i],"_avg",sep='')]))[[1]] + ) + + writeLines(c( + paste(methods[m],'iniVSfin',measures_names[i],'wilcox p: ',as.character(round(array_wilcoxon[[m]][[i]]$p.value,4)), sep=' ') + ,paste(methods[m],'iniVSfin',measures_names[i],'wilcox est: ',as.character(round(array_wilcoxon[[m]][[i]]$statistic,4)), sep=' ') + + ), file) + + + #tests trends + array_mann[[m]][[i]] = mk.test(c(array(measures_averages_gens_2[[m]][paste(methods[m],"_",measures_names[i],'_median',sep='')]) )[[1]], + continuity = TRUE) + + + writeLines(c( + paste(experiments_type[m],measures_names[i], ' Mann-Kendall median p', as.character(round(array_mann[[m]][[i]]$p.value,4)),sep=' '), + paste(experiments_type[m],measures_names[i], ' Mann-Kendall median s', as.character(round(array_mann[[m]][[i]]$statistic,4)),sep=' ') + ), file) + + } + + } + + + + # tests final generation among experiments_type + + aux_m = length(methods) + + if (aux_m>1) + { + + # fins + array_wilcoxon2[[1]] = list() + array_wilcoxon2[[2]] = list() + + aux_m = aux_m -1 + count_pairs = 0 + for(m in 1:aux_m) + { + aux = m+1 + for(m2 in aux:length(methods)) + { + + count_pairs = count_pairs+1 + array_wilcoxon2[[1]][[count_pairs]] = list() + + for (i in 1:length(measures_names)) + { + + writeLines(paste(methods[m],measures_names[i],'fin avg ',as.character( + mean(c(array(measures_fin[[m]][paste(methods[m],"_",measures_names[i],"_avg",sep='')]) )[[1]]) ) ,sep=" "), file ) + + writeLines(paste(methods[m2],measures_names[i],'fin avg ',as.character( + mean(c(array(measures_fin[[m2]][paste(methods[m2],"_",measures_names[i],"_avg",sep='')]) )[[1]]) ) ,sep=" "), file ) + + array_wilcoxon2[[1]][[count_pairs]][[i]] = wilcox.test(c(array(measures_fin[[m]][paste(methods[m],"_",measures_names[i],"_avg",sep='')]))[[1]] , + c(array(measures_fin[[m2]][paste(methods[m2],"_",measures_names[i],"_avg",sep='')]))[[1]] + ) + + writeLines(c( + paste(methods[m],'VS',methods[m],measures_names[i],'fin avg wilcox p: ',as.character(round(array_wilcoxon2[[1]][[count_pairs]][[i]]$p.value,4)), sep=' ') + ,paste(methods[m],'VS',methods[m2],measures_names[i],'fin avg wilcox est: ',as.character(round(array_wilcoxon2[[1]][[count_pairs]][[i]]$statistic,4)), sep=' ') + + ), file) + + } + + + array_wilcoxon2[[2]][[count_pairs]] = paste(initials[m],initials[m2],sep='') + + } + } + + } + + close(file) + + # plots measures + + for (type_summary in c('means','quants')) + { + + + for (i in 1:length(measures_names)) + { + tests1 = '' + tests2 = '' + tests3 = '' + break_aux = 0 + + graph <- ggplot(data=measures_averages_gens, aes(x=generation)) + + for(m in 1:length(methods)) + { + if(type_summary == 'means') + { + graph = graph + geom_ribbon(aes_string(ymin=paste(methods[m],'_',measures_names[i],'_avg','-',methods[m],'_',measures_names[i],'_stdev',sep=''), + ymax=paste(methods[m],'_',measures_names[i],'_avg','+',methods[m],'_',measures_names[i],'_stdev',sep='') ), + fill=experiments_type_colors[m] , color=experiments_type_colors[m],alpha=0.2) + }else + { + graph = graph + geom_ribbon(aes_string(ymin=paste(methods[m],'_',measures_names[i],'_avg_Q25',sep=''), + ymax=paste(methods[m],'_',measures_names[i],'_avg_Q75',sep='') ), + fill=experiments_type_colors[m] , color=experiments_type_colors[m],alpha=0.2) + } + } + + for(m in 1:length(methods)) + { + if(type_summary == 'means') + { + if(show_legends == TRUE){ + graph = graph + geom_line(aes_string(y=paste(methods[m],'_',measures_names[i],'_avg',sep=''), colour=shQuote(experiments_labels[m]) ), size=2) + }else{ + graph = graph + geom_line(aes_string(y=paste(methods[m],'_',measures_names[i],'_avg',sep='') ),size=2, color = experiments_type_colors[m]) + } + + }else{ + if(show_legends == TRUE){ + graph = graph + geom_line(aes_string(y=paste(methods[m],'_',measures_names[i],'_median',sep='') , colour=shQuote(experiments_labels[m]) ),size=2 ) + }else{ + graph = graph + geom_line(aes_string(y=paste(methods[m],'_',measures_names[i],'_median',sep='') ),size=2, color = experiments_type_colors[m] ) + } + } + + if (length(array_mann)>0) + { + if (length(array_mann[[m]])>0) + { + if(!is.na(array_mann[[m]][[i]]$p.value)) + { + if(array_mann[[m]][[i]]$p.value<=sig) + { + if(array_mann[[m]][[i]]$statistic>0){ direction = "/ "} else { direction = "\\ "} + tests1 = paste(tests1, initials[m],direction,sep="") + } + } + } + } + } + + if (length(array_wilcoxon[[m]])>0) + { + for(m in 1:length(methods)) + { + if(!is.na(array_wilcoxon[[m]][[i]]$p.value)) + { + if(array_wilcoxon[[m]][[i]]$p.value<=sig) + { + tests2 = paste(tests2, initials[m],'C ', sep='') + } + } + } + } + + if (length(array_wilcoxon2)>0) + { + for(p in 1:length(array_wilcoxon2[[1]])) + { + if (length(array_wilcoxon2[[1]][[p]])>0) + { + if(!is.na(array_wilcoxon2[[1]][[p]][[i]]$p.value)) + { + if(array_wilcoxon2[[1]][[p]][[i]]$p.value<=sig) + { + if(nchar(tests3)>line_size && break_aux == 0){ + tests3 = paste(tests3, '\n') + break_aux = 1 + } + tests3 = paste(tests3, array_wilcoxon2[[2]][[p]],'D ',sep='') + } + } + } + } + } + + max_y = 0 + min_y = 0 + if (measures_names[i] == 'displacement_velocity_hill' ) { + max_y = 6 + min_y = -0.5} + if (measures_names[i] == 'head_balance' || measures_names[i] == 'limbs' || measures_names[i] == 'joints') { max_y = 1.1} + if (measures_names[i] == 'proportion' ) { max_y = 1} + if (measures_names[i] == 'absolute_size' ) { max_y = 16} + + + graph = graph + labs( y=measures_labels[i], x="Generation") + if (max_y>0) { + graph = graph + coord_cartesian(ylim = c(min_y, max_y)) + } + + if(show_markers == TRUE){ + graph = graph + labs( y=measures_labels[i], x="Generation", subtitle = paste(tests1,'\n', tests2, '\n', tests3, sep='')) + } + graph = graph + theme(legend.position="bottom" , legend.text=element_text(size=20), axis.text=element_text(size=27),axis.title=element_text(size=25), + plot.subtitle=element_text(size=25 )) + + ggsave(paste( output_directory,'/',type_summary,'_' ,measures_names[i],'_generations.pdf', sep=''), graph , device='pdf', height = 10, width = 10) + } + + } + + + + + for (i in 1:length(measures_names)) + { + + max_y = 0 + min_y = 0 + if (measures_names[i] == 'displacement_velocity_hill' ) { + max_y = 6 + min_y = -0.5} + if (measures_names[i] == 'head_balance' || measures_names[i] == 'limbs' || measures_names[i] == 'joints') { max_y = 1.1} + if (measures_names[i] == 'proportion' ) { max_y = 1} + if (measures_names[i] == 'absolute_size' ) { max_y = 16} + + all_final_values = data.frame() + for (exp in 1:length(methods)) + { + temp = data.frame( c(measures_fin[[exp]][paste(methods[exp],'_',measures_names[i],'_avg', sep='')])) + colnames(temp) <- 'values' + + temp$type = experiments_labels[exp] + all_final_values = rbind(all_final_values, temp) + } + + g1 <- ggplot(data=all_final_values, aes(x= type , y=values, color=type )) + + geom_boxplot(position = position_dodge(width=0.9),lwd=2, outlier.size = 4) + + labs( x="Environment", y=measures_labels[i]) + + g1 = g1 + scale_color_manual(values=experiments_type_colors) + + g1 = g1 + theme(legend.position="none" , text = element_text(size=45) , + plot.title=element_text(size=40), axis.text=element_text(size=45), + axis.title=element_text(size=50), + axis.text.x = element_text(angle = 20, hjust = 1))+ + stat_summary(fun.y = mean, geom="point" ,shape = 16, size=11) + + comps = list(c( 'Static: Flat', 'Static: Tilted') ) + + g1 = g1 + geom_signif( test="wilcox.test", size=2, textsize=22, + comparisons = comps, + map_signif_level=c("***"=0.001,"**"=0.01, "*"=0.05) ) + if (max_y>0) { + g1 = g1 + coord_cartesian(ylim = c(min_y, max_y)) + } + + ggsave(paste(output_directory,"/",measures_names[i],"_boxes.pdf",sep = ""), g1, device = "pdf", height=18, width = 10) + + } + + \ No newline at end of file diff --git a/experiments/plasticoding_frontiers2020/summary_measures_journal2_tilted_big_2.R b/experiments/plasticoding_frontiers2020/summary_measures_journal2_tilted_big_2.R index 93b86f4236..834dcbb729 100644 --- a/experiments/plasticoding_frontiers2020/summary_measures_journal2_tilted_big_2.R +++ b/experiments/plasticoding_frontiers2020/summary_measures_journal2_tilted_big_2.R @@ -6,7 +6,7 @@ library(purrr) library(ggsignif) - base_directory <-paste('data', sep='') + base_directory <-paste('journal2', sep='') analysis = 'analysis_journal2_tilted_big_2' @@ -30,8 +30,9 @@ for (exp in 1:length(experiments_type)) initials = c( 'b', 'p' ) experiments_labels = c( 'Baseline' , 'Plastic') +experiments_labels2 = c( 'Baseline: Flat' , 'Plastic: Flat') - runs = list( c(1:20), c(1,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,20,21,22) ) + runs = list( c(1:20), c(1:20) ) gens = 200 pop = 100 @@ -106,7 +107,7 @@ experiments_labels = c( 'Baseline' , 'Plastic') 'width', 'height', 'Size', - 'sensors', + 'Sensors', 'Symmetry', 'Average Period', 'dev_period', @@ -116,8 +117,8 @@ experiments_labels = c( 'Baseline' , 'Plastic') 'dev_amplitude', 'avg_intra_dev_params', 'avg_inter_dev_params', - 'sensors_reach', - 'recurrence', + 'Sensors Reach', + 'Recurrence', 'synaptic_reception', 'Fitness', 'Number of slaves' @@ -151,6 +152,7 @@ experiments_labels = c( 'Baseline' , 'Plastic') measures_snapshots$displacement_velocity_hill = measures_snapshots$displacement_velocity_hill*100 measures_snapshots$run = as.factor(measures_snapshots$run) measures_snapshots$method = paste(experiments_type[exp], environments[[exp]][env],sep='_') + measures_snapshots$method_label = experiments_labels2[exp] if ( is.null(measures_snapshots_all)){ measures_snapshots_all = measures_snapshots @@ -171,10 +173,10 @@ experiments_labels = c( 'Baseline' , 'Plastic') # densities - measures_snapshots_all_densities = sqldf(paste("select * from measures_snapshots_all where generation=199 ",sep='' )) + measures_snapshots_all_densities = sqldf(paste("select * from measures_snapshots_all where generation=199",sep='' )) - measures_names_densities = c('length_of_limbs','proportion', 'absolute_size','head_balance','joints', 'limbs') - measures_labels_densities = c('Rel. Length of Limbs','Proportion', 'Size','Balance','Rel. Number of Joints', 'Rel. Number of Limbs') + measures_names_densities = c('length_of_limbs','proportion', 'absolute_size','head_balance','joints', 'limbs', 'recurrence', 'sensors', 'sensors_reach','displacement_velocity_hill') + measures_labels_densities = c('Rel. Length of Limbs','Proportion', 'Size','Balance','Rel. Number of Joints', 'Rel. Number of Limbs', 'Recurrence', 'Sensors', 'Sensors Reach', 'Speed (cm/s)') for (i in 1:length(measures_names_densities)) { @@ -184,16 +186,21 @@ experiments_labels = c( 'Baseline' , 'Plastic') if(i != j) { + + summary = sqldf(paste('select method_label,',measures_names_densities[j], ' as x,', measures_names_densities[i], + " as y, count(*) as n from measures_snapshots_all_densities + group by 1,2 order by n", sep='')) - graph <- ggplot(measures_snapshots_all_densities, aes_string(x=measures_names_densities[j], y= measures_names_densities[i]))+ - geom_density_2d(aes(colour = method ), alpha=0.7, size=3 )+ - scale_color_manual(values = experiments_type_colors )+ - labs( x = measures_labels_densities[j], y= measures_labels_densities[i] )+ - theme(legend.position="none" , axis.text=element_text(size=21),axis.title=element_text(size=22), - plot.subtitle=element_text(size=25 )) + - coord_cartesian(ylim = c(0, 1), xlim = c(0, 1)) + graph = ggplot(data=summary,aes(x=x ,y=y ,fill=n)) + + stat_density_2d(geom = "raster", aes(fill = stat(density)), contour = FALSE)+ + labs( x = measures_labels_densities[j], y= measures_labels_densities[i] )+ + theme(legend.position="none" , strip.text = element_text( size = 20 ), plot.title=element_text(size=25), + axis.text=element_text(size=17),axis.title=element_text(size=20) ) + + coord_cartesian(ylim = c(0, 1), xlim = c(0, 1))+ facet_grid(. ~ method_label) + ggsave(paste( output_directory ,'/density_',measures_names_densities[i],'_', measures_names_densities[j],'.png', sep=''), graph , - device='png', height = 6, width = 6) + device='png', height = 6, width = 10) + } } @@ -240,4 +247,328 @@ experiments_labels = c( 'Baseline' , 'Plastic') query = paste(query,', median(', methods[met],'_',measures_names[i],'_avg) as ' , methods[met],'_',measures_names[i],'_median', sep='') - \ No newline at end of file + measures_aux = c(measures_aux, paste(methods[met],'_',measures_names[i],'_avg', sep='') ) + } + query = paste(query,' from temp group by generation', sep="") + + temp2 = sqldf(query) + + p <- c(0.25, 0.75) + p_names <- map_chr(p, ~paste0('Q',.x*100, sep="")) + p_funs <- map(p, ~partial(quantile, probs = .x, na.rm = TRUE)) %>% + set_names(nm = p_names) + + quantiles = data.frame(temp %>% + group_by(generation) %>% + summarize_at(vars(measures_aux), funs(!!!p_funs)) ) + + measures_averages_gens_2[[met]] = sqldf('select * from temp2 inner join quantiles using (generation)') + + } + + + for (met in 1:length(methods)) + { + if(met==1){ + measures_averages_gens = measures_averages_gens_2[[1]] + }else{ + measures_averages_gens = merge(measures_averages_gens, measures_averages_gens_2[[met]], all=TRUE, by = "generation") + } + } + + file <-file(paste(output_directory,'/trends.txt',sep=''), open="w") + + #tests trends in curves and difference between ini and fin generations + + + # ini VS fin + array_wilcoxon = list() + array_wilcoxon2 = list() + + # curve + array_mann = list() + + + for (m in 1:length(methods)) + { + + array_wilcoxon[[m]] = list() + array_mann[[m]] = list() + + for (i in 1:length(measures_names)) + { + + writeLines(paste(experiments_type[m],measures_names[i],'ini avg ',as.character( + mean(c(array(measures_ini[[m]][paste(methods[m],"_",measures_names[i],"_avg",sep='')]) )[[1]]) ) ,sep=" "), file ) + + + writeLines(paste(methods[m],measures_names[i],'fin avg ',as.character( + mean(c(array(measures_fin[[m]][paste(methods[m],"_",measures_names[i],"_avg",sep='')]) )[[1]]) ) ,sep=" "), file ) + + array_wilcoxon[[m]][[i]] = wilcox.test(c(array(measures_ini[[m]][paste(methods[m],"_",measures_names[i],"_avg",sep='')]))[[1]] , + c(array(measures_fin[[m]][paste(methods[m],"_",measures_names[i],"_avg",sep='')]))[[1]] + ) + + writeLines(c( + paste(methods[m],'iniVSfin',measures_names[i],'wilcox p: ',as.character(round(array_wilcoxon[[m]][[i]]$p.value,4)), sep=' ') + ,paste(methods[m],'iniVSfin',measures_names[i],'wilcox est: ',as.character(round(array_wilcoxon[[m]][[i]]$statistic,4)), sep=' ') + + ), file) + + + #tests trends + array_mann[[m]][[i]] = mk.test(c(array(measures_averages_gens_2[[m]][paste(methods[m],"_",measures_names[i],'_median',sep='')]) )[[1]], + continuity = TRUE) + + + writeLines(c( + paste(experiments_type[m],measures_names[i], ' Mann-Kendall median p', as.character(round(array_mann[[m]][[i]]$p.value,4)),sep=' '), + paste(experiments_type[m],measures_names[i], ' Mann-Kendall median s', as.character(round(array_mann[[m]][[i]]$statistic,4)),sep=' ') + ), file) + + } + + } + + + + # tests final generation among experiments_type + + aux_m = length(methods) + + if (aux_m>1) + { + + # fins + array_wilcoxon2[[1]] = list() + array_wilcoxon2[[2]] = list() + + aux_m = aux_m -1 + count_pairs = 0 + for(m in 1:aux_m) + { + aux = m+1 + for(m2 in aux:length(methods)) + { + + count_pairs = count_pairs+1 + array_wilcoxon2[[1]][[count_pairs]] = list() + + for (i in 1:length(measures_names)) + { + + writeLines(paste(methods[m],measures_names[i],'fin avg ',as.character( + mean(c(array(measures_fin[[m]][paste(methods[m],"_",measures_names[i],"_avg",sep='')]) )[[1]]) ) ,sep=" "), file ) + + writeLines(paste(methods[m2],measures_names[i],'fin avg ',as.character( + mean(c(array(measures_fin[[m2]][paste(methods[m2],"_",measures_names[i],"_avg",sep='')]) )[[1]]) ) ,sep=" "), file ) + + array_wilcoxon2[[1]][[count_pairs]][[i]] = wilcox.test(c(array(measures_fin[[m]][paste(methods[m],"_",measures_names[i],"_avg",sep='')]))[[1]] , + c(array(measures_fin[[m2]][paste(methods[m2],"_",measures_names[i],"_avg",sep='')]))[[1]] + ) + + writeLines(c( + paste(methods[m],'VS',methods[m],measures_names[i],'fin avg wilcox p: ',as.character(round(array_wilcoxon2[[1]][[count_pairs]][[i]]$p.value,4)), sep=' ') + ,paste(methods[m],'VS',methods[m2],measures_names[i],'fin avg wilcox est: ',as.character(round(array_wilcoxon2[[1]][[count_pairs]][[i]]$statistic,4)), sep=' ') + + ), file) + + } + + + array_wilcoxon2[[2]][[count_pairs]] = paste(initials[m],initials[m2],sep='') + + } + } + + } + + close(file) + + + + # plots measures + + for (type_summary in c('means','quants')) + { + + + for (i in 1:length(measures_names)) + { + tests1 = '' + tests2 = '' + tests3 = '' + break_aux = 0 + + graph <- ggplot(data=measures_averages_gens, aes(x=generation)) + + for(m in 1:length(methods)) + { + if(type_summary == 'means') + { + graph = graph + geom_ribbon(aes_string(ymin=paste(methods[m],'_',measures_names[i],'_avg','-',methods[m],'_',measures_names[i],'_stdev',sep=''), + ymax=paste(methods[m],'_',measures_names[i],'_avg','+',methods[m],'_',measures_names[i],'_stdev',sep='') ), + fill=experiments_type_colors[m] , color=experiments_type_colors[m],alpha=0.2) + }else + { + graph = graph + geom_ribbon(aes_string(ymin=paste(methods[m],'_',measures_names[i],'_avg_Q25',sep=''), + ymax=paste(methods[m],'_',measures_names[i],'_avg_Q75',sep='') ), + fill=experiments_type_colors[m] , color=experiments_type_colors[m],alpha=0.2) + } + } + + for(m in 1:length(methods)) + { + if(type_summary == 'means') + { + if(show_legends == TRUE){ + graph = graph + geom_line(aes_string(y=paste(methods[m],'_',measures_names[i],'_avg',sep=''), colour=shQuote(experiments_labels[m]) ), size=2) + }else{ + graph = graph + geom_line(aes_string(y=paste(methods[m],'_',measures_names[i],'_avg',sep='') ),size=2, color = experiments_type_colors[m]) + } + + }else{ + if(show_legends == TRUE){ + graph = graph + geom_line(aes_string(y=paste(methods[m],'_',measures_names[i],'_median',sep='') , colour=shQuote(experiments_labels[m]) ),size=2 ) + }else{ + graph = graph + geom_line(aes_string(y=paste(methods[m],'_',measures_names[i],'_median',sep='') ),size=2, color = experiments_type_colors[m] ) + } + } + + if (length(array_mann)>0) + { + if (length(array_mann[[m]])>0) + { + if(!is.na(array_mann[[m]][[i]]$p.value)) + { + if(array_mann[[m]][[i]]$p.value<=sig) + { + if(array_mann[[m]][[i]]$statistic>0){ direction = "/ "} else { direction = "\\ "} + tests1 = paste(tests1, initials[m],direction,sep="") + } + } + } + } + } + + if (length(array_wilcoxon[[m]])>0) + { + for(m in 1:length(methods)) + { + if(!is.na(array_wilcoxon[[m]][[i]]$p.value)) + { + if(array_wilcoxon[[m]][[i]]$p.value<=sig) + { + tests2 = paste(tests2, initials[m],'C ', sep='') + } + } + } + } + + if (length(array_wilcoxon2)>0) + { + for(p in 1:length(array_wilcoxon2[[1]])) + { + if (length(array_wilcoxon2[[1]][[p]])>0) + { + if(!is.na(array_wilcoxon2[[1]][[p]][[i]]$p.value)) + { + if(array_wilcoxon2[[1]][[p]][[i]]$p.value<=sig) + { + if(nchar(tests3)>line_size && break_aux == 0){ + tests3 = paste(tests3, '\n') + break_aux = 1 + } + tests3 = paste(tests3, array_wilcoxon2[[2]][[p]],'D ',sep='') + } + } + } + } + } + + + max_y = 0 + min_y = 0 + if (measures_names[i] == 'displacement_velocity_hill' ) { + max_y = 2.5 + min_y = -0.5} + if (measures_names[i] == 'head_balance' || measures_names[i] == 'limbs' || measures_names[i] == 'joints') { max_y = 1} + if (measures_names[i] == 'proportion' ) { max_y = 1} + if (measures_names[i] == 'absolute_size' ) { max_y = 16} + + + graph = graph + labs( y=measures_labels[i], x="Generation", title="Flat Season") + if (max_y>0) { + graph = graph + coord_cartesian(ylim = c(min_y, max_y)) + } + + if(show_markers == TRUE){ + graph = graph + labs( y=measures_labels[i], x="Generation", subtitle = paste(tests1,'\n', tests2, '\n', tests3, sep='')) + } + graph = graph + theme(legend.position="bottom" , legend.text=element_text(size=20), axis.text=element_text(size=27),axis.title=element_text(size=25), + plot.subtitle=element_text(size=25 ),plot.title=element_text(size=25 )) + + ggsave(paste( output_directory,'/',type_summary,'_' ,measures_names[i],'_generations.pdf', sep=''), graph , device='pdf', height = 10, width = 10) + + } + + } + + + + for (i in 1:length(measures_names)) + { + + + all_final_values = data.frame() + for (exp in 1:length(methods)) + { + temp = data.frame( c(measures_fin[[exp]][paste(methods[exp],'_',measures_names[i],'_avg', sep='')])) + colnames(temp) <- 'values' + + temp$type = experiments_labels[exp] + all_final_values = rbind(all_final_values, temp) + } + + g1 <- ggplot(data=all_final_values, aes(x= type , y=values, color=type )) + + geom_boxplot(position = position_dodge(width=0.9),lwd=2, outlier.size = 4) + + labs( x="Environment", y=measures_labels[i], title="Flat Season") + + + max_y = 0 + min_y = 0 + if (measures_names[i] == 'displacement_velocity_hill' ) { + g1 = g1 + geom_hline(yintercept=1.32, linetype="dashed", color = "red") + max_y = 4.8 + min_y = -0.5} + if (measures_names[i] == 'head_balance' || measures_names[i] == 'limbs' + || measures_names[i] == 'joints' || measures_names[i] == 'sensors_reach') { max_y = 1.15} + if (measures_names[i] == 'recurrence' ) { max_y = 0.8} + if (measures_names[i] == 'sensors' ) { max_y = 0.6} + if (measures_names[i] == 'proportion' ) { max_y = 1} + if (measures_names[i] == 'absolute_size' ) { max_y = 16} + + + g1 = g1 + scale_color_manual(values= experiments_type_colors ) + + g1 = g1 + theme(legend.position="none" , text = element_text(size=45) , + plot.title=element_text(size=45), axis.text=element_text(size=45), + axis.title=element_text(size=50), + axis.text.x = element_text(angle = 20, hjust = 0.9), + plot.margin=margin(t = 0.5, r = 0.5, b = 0.5, l = 1.3, unit = "cm"))+ + stat_summary(fun.y = mean, geom="point" ,shape = 16, size=11) + + comps = list( c( 'Baseline', 'Plastic') ) + + g1 = g1 + geom_signif( test="wilcox.test", size=2, textsize=22, + comparisons = comps, + map_signif_level=c("***"=0.001,"**"=0.01, "*"=0.05) ) + if (max_y>0) { + g1 = g1 + coord_cartesian(ylim = c(min_y, max_y)) + } + + ggsave(paste(output_directory,"/",measures_names[i],"_boxes.pdf",sep = ""), g1, device = "pdf", height=18, width = 10) + + } + + \ No newline at end of file diff --git a/experiments/plasticoding_frontiers2020/summary_measures_journal2_tilted_big_3.R b/experiments/plasticoding_frontiers2020/summary_measures_journal2_tilted_big_3.R index 6f57f18d83..95ac49c970 100644 --- a/experiments/plasticoding_frontiers2020/summary_measures_journal2_tilted_big_3.R +++ b/experiments/plasticoding_frontiers2020/summary_measures_journal2_tilted_big_3.R @@ -6,7 +6,7 @@ library(purrr) library(ggsignif) - base_directory <-paste('data', sep='') + base_directory <-paste('journal2', sep='') analysis = 'analysis_journal2_tilted_big_3' @@ -15,6 +15,7 @@ output_directory = paste(base_directory,'/',analysis ,sep='') #### CHANGE THE PARAMETERS HERE #### experiments_type = c( 'baseline_big', 'plastic_big' ) +experiments_labels2 = c( 'Baseline: Tilted' , 'Plastic: Tilted') environments = list( c( 'tilted5'), c( 'tilted5') ) @@ -30,8 +31,9 @@ for (exp in 1:length(experiments_type)) initials = c( 'b', 'p' ) experiments_labels = c( 'Baseline' , 'Plastic') +experiments_labels2 = c( 'Baseline: Tilted' , 'Plastic: Tilted') - runs = list( c(1:20), c(1,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,20,21,22) ) + runs = list( c(1:20),c(1:20) ) gens = 200 pop = 100 @@ -106,7 +108,7 @@ experiments_labels = c( 'Baseline' , 'Plastic') 'width', 'height', 'Size', - 'sensors', + 'Sensors', 'Symmetry', 'Average Period', 'dev_period', @@ -116,8 +118,8 @@ experiments_labels = c( 'Baseline' , 'Plastic') 'dev_amplitude', 'avg_intra_dev_params', 'avg_inter_dev_params', - 'sensors_reach', - 'recurrence', + 'Sensors Reach', + 'Recurrence', 'synaptic_reception', 'Fitness', 'Number of slaves' @@ -151,6 +153,7 @@ experiments_labels = c( 'Baseline' , 'Plastic') measures_snapshots$displacement_velocity_hill = measures_snapshots$displacement_velocity_hill*100 measures_snapshots$run = as.factor(measures_snapshots$run) measures_snapshots$method = paste(experiments_type[exp], environments[[exp]][env],sep='_') + measures_snapshots$method_label = experiments_labels2[exp] if ( is.null(measures_snapshots_all)){ measures_snapshots_all = measures_snapshots @@ -171,10 +174,10 @@ experiments_labels = c( 'Baseline' , 'Plastic') # densities - measures_snapshots_all_densities = sqldf(paste("select * from measures_snapshots_all where generation=199 ",sep='' )) + measures_snapshots_all_densities = sqldf(paste("select * from measures_snapshots_all where generation=199",sep='' )) - measures_names_densities = c('length_of_limbs','proportion', 'absolute_size','head_balance','joints', 'limbs') - measures_labels_densities = c('Rel. Length of Limbs','Proportion', 'Size','Balance','Rel. Number of Joints', 'Rel. Number of Limbs') + measures_names_densities = c('length_of_limbs','proportion', 'absolute_size','head_balance','joints', 'limbs', 'recurrence', 'sensors', 'sensors_reach','displacement_velocity_hill') + measures_labels_densities = c('Rel. Length of Limbs','Proportion', 'Size','Balance','Rel. Number of Joints', 'Rel. Number of Limbs', 'Recurrence', 'Sensors', 'Sensors Reach', 'Speed (cm/s)') for (i in 1:length(measures_names_densities)) { @@ -185,20 +188,28 @@ experiments_labels = c( 'Baseline' , 'Plastic') if(i != j) { - graph <- ggplot(measures_snapshots_all_densities, aes_string(x=measures_names_densities[j], y= measures_names_densities[i]))+ - geom_density_2d(aes(colour = method ), alpha=0.7, size=3 )+ - scale_color_manual(values = experiments_type_colors )+ - labs( x = measures_labels_densities[j], y= measures_labels_densities[i] )+ - theme(legend.position="none" , axis.text=element_text(size=21),axis.title=element_text(size=22), - plot.subtitle=element_text(size=25 )) + - coord_cartesian(ylim = c(0, 1), xlim = c(0, 1)) + summary = sqldf(paste('select method_label,',measures_names_densities[j], ' as x,', measures_names_densities[i], + " as y, count(*) as n from measures_snapshots_all_densities + group by 1,2 order by n", sep='')) + + graph = ggplot(data=summary,aes(x=x ,y=y ,fill=n)) + + stat_density_2d(geom = "raster", aes(fill = stat(density)), contour = FALSE)+ + labs( x = measures_labels_densities[j], y= measures_labels_densities[i] )+ + theme(legend.position="none" , strip.text = element_text( size = 20 ), plot.title=element_text(size=25), + axis.text=element_text(size=17),axis.title=element_text(size=20) ) + + coord_cartesian(ylim = c(0, 1), xlim = c(0, 1))+ facet_grid(. ~ method_label) + ggsave(paste( output_directory ,'/density_',measures_names_densities[i],'_', measures_names_densities[j],'.png', sep=''), graph , - device='png', height = 6, width = 6) + device='png', height = 6, width = 10) + + } } } + + measures_averages_gens_1 = list() measures_averages_gens_2 = list() @@ -510,7 +521,6 @@ experiments_labels = c( 'Baseline' , 'Plastic') { - all_final_values = data.frame() for (exp in 1:length(methods)) { @@ -523,7 +533,7 @@ experiments_labels = c( 'Baseline' , 'Plastic') g1 <- ggplot(data=all_final_values, aes(x= type , y=values, color=type )) + geom_boxplot(position = position_dodge(width=0.9),lwd=2, outlier.size = 4) + - labs( x="Environment", y=measures_labels[i], title="Flat Season") + labs( x="Environment", y=measures_labels[i], title="Tilted Season") max_y = 0 min_y = 0 @@ -531,7 +541,10 @@ experiments_labels = c( 'Baseline' , 'Plastic') g1 = g1 + geom_hline(yintercept=1.32, linetype="dashed", color = "red") max_y = 4.8 min_y = -0.5} - if (measures_names[i] == 'head_balance' || measures_names[i] == 'limbs' || measures_names[i] == 'joints') { max_y = 1.1} + if (measures_names[i] == 'head_balance' || measures_names[i] == 'limbs' + || measures_names[i] == 'joints' || measures_names[i] == 'sensors_reach') { max_y = 1.15} + if (measures_names[i] == 'recurrence' ) { max_y = 0.8} + if (measures_names[i] == 'sensors' ) { max_y = 0.6} if (measures_names[i] == 'proportion' ) { max_y = 1} if (measures_names[i] == 'absolute_size' ) { max_y = 16} diff --git a/experiments/plasticoding_frontiers2020/tilted_big.py b/experiments/plasticoding_frontiers2020/tilted_big.py new file mode 100644 index 0000000000..057a57522e --- /dev/null +++ b/experiments/plasticoding_frontiers2020/tilted_big.py @@ -0,0 +1,150 @@ +#!/usr/bin/env python3 +import asyncio + +from pyrevolve import parser +from pyrevolve.evolution import fitness +from pyrevolve.evolution.selection import multiple_selection, tournament_selection +from pyrevolve.evolution.population import Population, PopulationConfig +from pyrevolve.evolution.pop_management.steady_state import steady_state_population_management +from pyrevolve.experiment_management import ExperimentManagement +from pyrevolve.genotype.plasticoding.crossover.crossover import CrossoverConfig +from pyrevolve.genotype.plasticoding.crossover.standard_crossover import standard_crossover +from pyrevolve.genotype.plasticoding.initialization import random_initialization +from pyrevolve.genotype.plasticoding.mutation.mutation import MutationConfig +from pyrevolve.genotype.plasticoding.mutation.standard_mutation import standard_mutation +from pyrevolve.genotype.plasticoding.plasticoding import PlasticodingConfig +from pyrevolve.tol.manage import measures +from pyrevolve.util.supervisor.simulator_queue import SimulatorQueue +from pyrevolve.util.supervisor.analyzer_queue import AnalyzerQueue +from pyrevolve.custom_logging.logger import logger +import sys + +async def run(): + """ + The main coroutine, which is started below. + """ + + # experiment params # + num_generations = 200 + population_size = 100 + offspring_size = 100 + front = None + + # environment world and z-start + environments = {'tilted5': 0.1} + + genotype_conf = PlasticodingConfig( + max_structural_modules=15, + plastic=False, + ) + + mutation_conf = MutationConfig( + mutation_prob=0.8, + genotype_conf=genotype_conf, + ) + + crossover_conf = CrossoverConfig( + crossover_prob=0.8, + ) + # experiment params # + + # Parse command line / file input arguments + settings = parser.parse_args() + experiment_management = ExperimentManagement(settings, environments) + do_recovery = settings.recovery_enabled and not experiment_management.experiment_is_new() + + logger.info('Activated run '+settings.run+' of experiment '+settings.experiment_name) + + if do_recovery: + gen_num, has_offspring, next_robot_id = experiment_management.read_recovery_state(population_size, + offspring_size) + + if gen_num == num_generations-1: + logger.info('Experiment is already complete.') + return + else: + gen_num = 0 + next_robot_id = 1 + + def fitness_function_tilted(robot_manager, robot): + return fitness.displacement_velocity_hill(robot_manager, robot, False) + + fitness_function = {'tilted5': fitness_function_tilted} + + population_conf = PopulationConfig( + population_size=population_size, + genotype_constructor=random_initialization, + genotype_conf=genotype_conf, + fitness_function=fitness_function, + mutation_operator=standard_mutation, + mutation_conf=mutation_conf, + crossover_operator=standard_crossover, + crossover_conf=crossover_conf, + selection=lambda individuals: tournament_selection(individuals, environments, 2), + parent_selection=lambda individuals: multiple_selection(individuals, 2, tournament_selection, environments), + population_management=steady_state_population_management, + population_management_selector=tournament_selection, + evaluation_time=settings.evaluation_time, + offspring_size=offspring_size, + experiment_name=settings.experiment_name, + experiment_management=experiment_management, + environments=environments, + front=front + ) + + settings = parser.parse_args() + + simulator_queue = {} + analyzer_queue = None + + previous_port = None + for environment in environments: + + settings.world = environment + settings.z_start = environments[environment] + + if previous_port is None: + port = settings.port_start + previous_port = port + else: + port = previous_port+settings.n_cores + previous_port = port + + simulator_queue[environment] = SimulatorQueue(settings.n_cores, settings, port) + await simulator_queue[environment].start() + + analyzer_queue = AnalyzerQueue(1, settings, port+settings.n_cores) + await analyzer_queue.start() + + population = Population(population_conf, simulator_queue, analyzer_queue, next_robot_id) + + if do_recovery: + + if gen_num >= 0: + # loading a previous state of the experiment + await population.load_snapshot(gen_num) + logger.info('Recovered snapshot '+str(gen_num)+', pop with ' + str(len(population.individuals))+' individuals') + + if has_offspring: + individuals = await population.load_offspring(gen_num, population_size, offspring_size, next_robot_id) + gen_num += 1 + logger.info('Recovered unfinished offspring '+str(gen_num)) + + if gen_num == 0: + await population.init_pop(individuals) + else: + population = await population.next_gen(gen_num, individuals) + + experiment_management.export_snapshots(population.individuals, gen_num) + else: + # starting a new experiment + experiment_management.create_exp_folders() + await population.init_pop() + experiment_management.export_snapshots(population.individuals, gen_num) + + while gen_num < num_generations-1: + gen_num += 1 + population = await population.next_gen(gen_num) + experiment_management.export_snapshots(population.individuals, gen_num) + + # output result after completing all generations...