#Code to reproduce https://mbq.me/blog/nomads ## Simulation #$ #Generate votes, as complex numbers generateVotes<-function(N=500,p=0.3) exp(1i*ifelse(pz return(z/abs(z)) } baselineDistance<-function(trials=1000,...) distance(exp(1i*runif(trials,0,2*pi))) singleDistance<-function(trials=1000,p=0.3,...) distance(sample(generateVotes(N=trials,p))) ensembleDistance<-function(trials=1000,N=500,p=0.3,...) replicate(trials,distance(vote(generateVotes(N,p)))) #Make simulation simulationA<-function(trials=10000,p=c(.01,.03,.05,.1,.3,.5,.7,.75,.8)){ BD<-data.frame( p=0, Solution="Random direction", Distance=baselineDistance(trials) ) RD<-do.call(rbind,lapply(p,function(p) data.frame( p=p, Solution="Single nomad", Distance=singleDistance(trials,p) ) )) VD500<-do.call(rbind,lapply(p,function(p) data.frame( p=p, Solution="Ensemble voting 500", Distance=ensembleDistance(trials,500,p) ) )) VD5k<-do.call(rbind,lapply(p,function(p) data.frame( p=p, Solution="Ensemble voting 5k", Distance=ensembleDistance(trials,5000,p) ) )) rbind(BD,RD,VD500,VD5k)->U U$p<-factor(U$p) U } #Generate "hedgehog" plots as SVG paths, for nom2.brew.svg genPath<-function(z,r=90) paste(sprintf("M0,0L%0.1f,%0.1f",r*Re(z),r*Im(z)),collapse="") genPaths<-function(N=50,p=0.01){ ans<-list() exp(1i*runif(floor(N*(1-p)),0,2*pi))->ans$guessing exp(1i*rnorm(ceiling(N*p),0,5/180*pi))->ans$knowing #Voting result sum(c(ans$guessing,ans$knowing))->vote #Vector averages of both, normalised sum(ans$guessing)/abs(vote)->ans$ave_guess sum(ans$knowing)/abs(vote)->ans$ave_know #Final, normalised direction vote/abs(vote)->ans$vote lapply(ans,genPath) } genPathsCelebrity<-function(N=50,p=0.01){ ans<-list() exp(1i*rnorm(floor(N*(1-p)),runif(1,0,2*pi),1.5))->ans$guessing exp(1i*rnorm(ceiling(N*p),0,5/180*pi))->ans$knowing #Voting result sum(c(ans$guessing,ans$knowing))->vote #Vector averages of both, normalised sum(ans$guessing)/abs(vote)->ans$ave_guess sum(ans$knowing)/abs(vote)->ans$ave_know #Final, normalised direction vote/abs(vote)->ans$vote lapply(ans,genPath) } makeAll<-function(){ nom2.brew.svg<-' <% source("nomads.R"); set.seed(2); %> <% genPaths(N=500,p=0.1)->ans %> <% genPaths(N=500,p=0.1)->ans %> <% genPaths(N=500,p=0.1)->ans %> <% genPaths(N=500,p=0.1)->ans %> <% genPaths(N=500,p=0.1)->ans %> ' nom3.brew.svg<-' <% source("nomads.R"); set.seed(2); %> <% genPaths(N=500,p=0.1)->ans %> <% genPathsCelebrity(N=500,p=0.1)->ans %> <% genPathsCelebrity(N=500,p=0.1)->ans %> <% genPathsCelebrity(N=500,p=0.1)->ans %> <% genPathsCelebrity(N=500,p=0.1)->ans %> ' library(ggplot2) library(brew) #Run simulationA simulationA()->simA #Plot ptA<-ggplot(simA,aes(y=Distance,fill=Solution,x=p))+ geom_hline(yintercept=1/7)+ geom_boxplot(outlier.size=NA)+ theme(legend.position="bottom") ggsave("nom1.svg") #Make SVG animations brew(text=nom2.brew.svg,output='nom2.svg') brew(text=nom3.brew.svg,output='nom3.svg') }