##
##  Plot Flow Diagrams
##
##  James Honaker, March 6, 2006
##

rm(list=ls())

library(tcltk)

run.ev<-function(){
  gvect<-c(as.numeric(tclvalue(g11)),as.numeric(tclvalue(g21)),as.numeric(tclvalue(g31)),as.numeric(tclvalue(g12)),as.numeric(tclvalue(g22)),as.numeric(tclvalue(g32)),as.numeric(tclvalue(g13)),as.numeric(tclvalue(g23)),as.numeric(tclvalue(g33)))
  G<-matrix(gvect,3,3)
  xvect<-c(as.numeric(tclvalue(x011)),as.numeric(tclvalue(x021)),as.numeric(tclvalue(x031)),as.numeric(tclvalue(x041)),as.numeric(tclvalue(x051)),as.numeric(tclvalue(x061)),as.numeric(tclvalue(x071)),as.numeric(tclvalue(x081)),as.numeric(tclvalue(x091)),as.numeric(tclvalue(x101)),as.numeric(tclvalue(x111)),as.numeric(tclvalue(x121)),as.numeric(tclvalue(x131)),as.numeric(tclvalue(x141)),as.numeric(tclvalue(x151)),as.numeric(tclvalue(x012)),as.numeric(tclvalue(x022)),as.numeric(tclvalue(x032)),as.numeric(tclvalue(x042)),as.numeric(tclvalue(x052)),as.numeric(tclvalue(x062)),as.numeric(tclvalue(x072)),as.numeric(tclvalue(x082)),as.numeric(tclvalue(x092)),as.numeric(tclvalue(x102)),as.numeric(tclvalue(x112)),as.numeric(tclvalue(x122)),as.numeric(tclvalue(x132)),as.numeric(tclvalue(x142)),as.numeric(tclvalue(x152)))
  xall<-matrix(xvect,length(xvect)/2,2)
  xall<-cbind(xall,1-xall[,1]-xall[,2])
  rounds<-60
  a<-ev(G,xall,rounds)
}

ev<-function(G,xall,rounds){

#print(xall)

for(jj in 1:nrow(xall)){

x<-xall[jj,]
x<-abs(x)/sum(abs(x))

n<-rounds
history<-matrix(0,n+1,3)
history[1, ]<-x



for(i in 1:n){
  fx<-G%*%x
  fbar<-t(x)%*%G%*%x
  x<-x * (fx/as.numeric(fbar))
  history[i+1,]<-x
}
y.prime<-history[,1]*sqrt(3)/2
x.prime<-(history[,2]-history[,3])/2

x.corners<-c(0.5,-0.5,0,0.5)
y.corners<-c(0,0,sqrt(3)/2,0)


plot(x.corners,y.corners,ylim=c(-0.1,1.1),xlim=c(-0.6,0.6),main="Population Profile of Evolved Game",xlab="",ylab="",type="l",axes=FALSE)
for(i in 1:(n-1)){
arrows(x.prime[i], y.prime[i], x.prime[i+1], y.prime[i+1],  length = 0.05, angle = 30, code = 2, col = par("fg"), lty = NULL, lwd = par("lwd"), xpd = NULL)
par(new=TRUE)
}


}

plot(x.corners,y.corners,ylim=c(-0.1,1.1),xlim=c(-0.6,0.6),main="Population Profile of Evolved Game",xlab="",ylab="",type="l",axes=FALSE)
epsilon<-0.1
text(x=0,y=sqrt(3)/2+epsilon,labels="top" )
text(x=0.5,y=0-epsilon,labels="center" )
text(x=-0.5,y=0-epsilon,labels="bottom" )


return(1)
}


require(tcltk)
tt<-tktoplevel()
tkwm.title(tt, "Evolutionary Flow Diagram")
g11 <- tclVar("4")
g12 <- tclVar("7")
g13 <- tclVar("3")
g21 <- tclVar("5")
g22 <- tclVar("3")
g23 <- tclVar("3")
g31 <- tclVar("4")
g32 <- tclVar("4")
g33 <- tclVar("5")

x011<- tclVar("0.05")
x012<- tclVar("0.05")
x021<- tclVar("0.05")
x022<- tclVar("0.2")
x031<- tclVar("0.05")
x032<- tclVar("0.35")
x041<- tclVar("0.05")
x042<- tclVar("0.6")
x051<- tclVar("0.05")
x052<- tclVar("0.75")
x061<- tclVar("0.05")
x062<- tclVar("0.89")
x071<- tclVar("0.2")
x072<- tclVar("0.05")
x081<- tclVar("0.35")
x082<- tclVar("0.05")
x091<- tclVar("0.6")
x092<- tclVar("0.05")
x101<- tclVar("0.75")
x102<- tclVar("0.05")
x111<- tclVar("0.9")
x112<- tclVar("0.05")
x121<- tclVar("0.2")
x122<- tclVar("0.75")
x131<- tclVar("0.35")
x132<- tclVar("0.6")
x141<- tclVar("0.6")
x142<- tclVar("0.35")
x151<- tclVar("0.75")
x152<- tclVar("0.2")



entry.g11 <-tkentry(tt,width="5",textvariable=g11)
entry.g12 <-tkentry(tt,width="5",textvariable=g12)
entry.g13 <-tkentry(tt,width="5",textvariable=g13)

entry.g21 <-tkentry(tt,width="5",textvariable=g21)
entry.g22 <-tkentry(tt,width="5",textvariable=g22)
entry.g23 <-tkentry(tt,width="5",textvariable=g23)

entry.g31 <-tkentry(tt,width="5",textvariable=g31)
entry.g32 <-tkentry(tt,width="5",textvariable=g32)
entry.g33 <-tkentry(tt,width="5",textvariable=g33)

entry.x011 <-tkentry(tt,width="5",textvariable=x011)
entry.x012 <-tkentry(tt,width="5",textvariable=x012)
entry.x021 <-tkentry(tt,width="5",textvariable=x021)
entry.x022 <-tkentry(tt,width="5",textvariable=x022)
entry.x031 <-tkentry(tt,width="5",textvariable=x031)
entry.x032 <-tkentry(tt,width="5",textvariable=x032)
entry.x041 <-tkentry(tt,width="5",textvariable=x041)
entry.x042 <-tkentry(tt,width="5",textvariable=x042)
entry.x051 <-tkentry(tt,width="5",textvariable=x051)
entry.x052 <-tkentry(tt,width="5",textvariable=x052)
entry.x061 <-tkentry(tt,width="5",textvariable=x061)
entry.x062 <-tkentry(tt,width="5",textvariable=x062)
entry.x071 <-tkentry(tt,width="5",textvariable=x071)
entry.x072 <-tkentry(tt,width="5",textvariable=x072)
entry.x081 <-tkentry(tt,width="5",textvariable=x081)
entry.x082 <-tkentry(tt,width="5",textvariable=x082)
entry.x091 <-tkentry(tt,width="5",textvariable=x091)
entry.x092 <-tkentry(tt,width="5",textvariable=x092)
entry.x101 <-tkentry(tt,width="5",textvariable=x101)
entry.x102 <-tkentry(tt,width="5",textvariable=x102)
entry.x111 <-tkentry(tt,width="5",textvariable=x111)
entry.x112 <-tkentry(tt,width="5",textvariable=x112)
entry.x121 <-tkentry(tt,width="5",textvariable=x121)
entry.x122 <-tkentry(tt,width="5",textvariable=x122)

entry.x131 <-tkentry(tt,width="5",textvariable=x131)
entry.x132 <-tkentry(tt,width="5",textvariable=x132)
entry.x141 <-tkentry(tt,width="5",textvariable=x141)
entry.x142 <-tkentry(tt,width="5",textvariable=x142)
entry.x151 <-tkentry(tt,width="5",textvariable=x151)
entry.x152 <-tkentry(tt,width="5",textvariable=x152)



#tcl("set","calc.x13","0.5")

#somefunction<-function(){
#  tclvalue(calc.x13)<-paste(1-as.numeric(tclvalue(x11)))
#}


tkbind(entry.x011,"<Return>", function(){tclvalue(calc.x013)<-paste(1-as.numeric(tclvalue(x011))-as.numeric(tclvalue(x012)))})
tkbind(entry.x021,"<Return>", function(){tclvalue(calc.x023)<-paste(1-as.numeric(tclvalue(x021))-as.numeric(tclvalue(x022)))})
tkbind(entry.x031,"<Return>", function(){tclvalue(calc.x033)<-paste(1-as.numeric(tclvalue(x031))-as.numeric(tclvalue(x032)))})
tkbind(entry.x041,"<Return>", function(){tclvalue(calc.x043)<-paste(1-as.numeric(tclvalue(x041))-as.numeric(tclvalue(x042)))})
tkbind(entry.x051,"<Return>", function(){tclvalue(calc.x053)<-paste(1-as.numeric(tclvalue(x051))-as.numeric(tclvalue(x052)))})
tkbind(entry.x061,"<Return>", function(){tclvalue(calc.x063)<-paste(1-as.numeric(tclvalue(x061))-as.numeric(tclvalue(x062)))})
tkbind(entry.x071,"<Return>", function(){tclvalue(calc.x073)<-paste(1-as.numeric(tclvalue(x071))-as.numeric(tclvalue(x072)))})
tkbind(entry.x081,"<Return>", function(){tclvalue(calc.x083)<-paste(1-as.numeric(tclvalue(x081))-as.numeric(tclvalue(x082)))})
tkbind(entry.x091,"<Return>", function(){tclvalue(calc.x093)<-paste(1-as.numeric(tclvalue(x091))-as.numeric(tclvalue(x092)))})
tkbind(entry.x101,"<Return>", function(){tclvalue(calc.x103)<-paste(1-as.numeric(tclvalue(x101))-as.numeric(tclvalue(x102)))})
tkbind(entry.x111,"<Return>", function(){tclvalue(calc.x113)<-paste(1-as.numeric(tclvalue(x111))-as.numeric(tclvalue(x112)))})
tkbind(entry.x121,"<Return>", function(){tclvalue(calc.x123)<-paste(1-as.numeric(tclvalue(x121))-as.numeric(tclvalue(x122)))})

tkbind(entry.x012,"<Return>", function(){tclvalue(calc.x013)<-paste(1-as.numeric(tclvalue(x011))-as.numeric(tclvalue(x012)))})
tkbind(entry.x022,"<Return>", function(){tclvalue(calc.x023)<-paste(1-as.numeric(tclvalue(x021))-as.numeric(tclvalue(x022)))})
tkbind(entry.x032,"<Return>", function(){tclvalue(calc.x033)<-paste(1-as.numeric(tclvalue(x031))-as.numeric(tclvalue(x032)))})
tkbind(entry.x042,"<Return>", function(){tclvalue(calc.x043)<-paste(1-as.numeric(tclvalue(x041))-as.numeric(tclvalue(x042)))})
tkbind(entry.x052,"<Return>", function(){tclvalue(calc.x053)<-paste(1-as.numeric(tclvalue(x051))-as.numeric(tclvalue(x052)))})
tkbind(entry.x062,"<Return>", function(){tclvalue(calc.x063)<-paste(1-as.numeric(tclvalue(x061))-as.numeric(tclvalue(x062)))})
tkbind(entry.x072,"<Return>", function(){tclvalue(calc.x073)<-paste(1-as.numeric(tclvalue(x071))-as.numeric(tclvalue(x072)))})
tkbind(entry.x082,"<Return>", function(){tclvalue(calc.x083)<-paste(1-as.numeric(tclvalue(x081))-as.numeric(tclvalue(x082)))})
tkbind(entry.x092,"<Return>", function(){tclvalue(calc.x093)<-paste(1-as.numeric(tclvalue(x091))-as.numeric(tclvalue(x092)))})
tkbind(entry.x102,"<Return>", function(){tclvalue(calc.x103)<-paste(1-as.numeric(tclvalue(x101))-as.numeric(tclvalue(x102)))})
tkbind(entry.x112,"<Return>", function(){tclvalue(calc.x113)<-paste(1-as.numeric(tclvalue(x111))-as.numeric(tclvalue(x112)))})
tkbind(entry.x122,"<Return>", function(){tclvalue(calc.x123)<-paste(1-as.numeric(tclvalue(x121))-as.numeric(tclvalue(x122)))})

tkbind(entry.x132,"<Return>", function(){tclvalue(calc.x133)<-paste(1-as.numeric(tclvalue(x131))-as.numeric(tclvalue(x132)))})
tkbind(entry.x142,"<Return>", function(){tclvalue(calc.x143)<-paste(1-as.numeric(tclvalue(x141))-as.numeric(tclvalue(x142)))})
tkbind(entry.x152,"<Return>", function(){tclvalue(calc.x153)<-paste(1-as.numeric(tclvalue(x151))-as.numeric(tclvalue(x152)))})


calc.x013 <- tclVar( paste(1-as.numeric(tclvalue(x011))-as.numeric(tclvalue(x012)) ))
calc.x023 <- tclVar( paste(1-as.numeric(tclvalue(x021))-as.numeric(tclvalue(x022)) ))
calc.x033 <- tclVar( paste(1-as.numeric(tclvalue(x031))-as.numeric(tclvalue(x032)) ))
calc.x043 <- tclVar( paste(1-as.numeric(tclvalue(x041))-as.numeric(tclvalue(x042)) ))
calc.x053 <- tclVar( paste(1-as.numeric(tclvalue(x051))-as.numeric(tclvalue(x052)) ))
calc.x063 <- tclVar( paste(1-as.numeric(tclvalue(x061))-as.numeric(tclvalue(x062)) ))

calc.x073 <- tclVar( paste(1-as.numeric(tclvalue(x071))-as.numeric(tclvalue(x072)) ))
calc.x083 <- tclVar( paste(1-as.numeric(tclvalue(x081))-as.numeric(tclvalue(x082)) ))
calc.x093 <- tclVar( paste(1-as.numeric(tclvalue(x091))-as.numeric(tclvalue(x092)) ))
calc.x103 <- tclVar( paste(1-as.numeric(tclvalue(x101))-as.numeric(tclvalue(x102)) ))
calc.x113 <- tclVar( paste(1-as.numeric(tclvalue(x111))-as.numeric(tclvalue(x112)) ))
calc.x123 <- tclVar( paste(1-as.numeric(tclvalue(x121))-as.numeric(tclvalue(x122)) ))

calc.x133 <- tclVar( paste(1-as.numeric(tclvalue(x131))-as.numeric(tclvalue(x132)) ))
calc.x143 <- tclVar( paste(1-as.numeric(tclvalue(x141))-as.numeric(tclvalue(x142)) ))
calc.x153 <- tclVar( paste(1-as.numeric(tclvalue(x151))-as.numeric(tclvalue(x152)) ))


fontHeading <- tkfont.create(family="times",size=14,weight="bold",slant="italic")
fontVector  <- tkfont.create(family="courier",slant="italic",size=12)
fontMatrix  <- tkfont.create(family="courier",weight="bold",size=12)

tkgrid(tklabel(tt,text="Please enter the fitness matrix.",font=fontHeading),row=1,column=1,columnspan=4)
tkgrid(tklabel(tt,text="T",font=fontVector),row=2,column=2)
tkgrid(tklabel(tt,text="C",font=fontVector),row=2,column=3)
tkgrid(tklabel(tt,text="B",font=fontVector),row=2,column=4)

tkgrid(tklabel(tt,text="Top",font=fontVector),row=3,column=1)
tkgrid(entry.g11,row=3,column=2)
tkgrid(entry.g12,row=3,column=3)
tkgrid(entry.g13,row=3,column=4)
tkgrid(tklabel(tt,text="Center",font=fontVector),row=4,column=1)
tkgrid(entry.g21,row=4,column=2)
tkgrid(entry.g22,row=4,column=3)
tkgrid(entry.g23,row=4,column=4)
tkgrid(tklabel(tt,text="Bottom",font=fontVector),row=5,column=1)
tkgrid(entry.g31,row=5,column=2)
tkgrid(entry.g32,row=5,column=3)
tkgrid(entry.g33,row=5,column=4)

tkgrid(tklabel(tt,text="Please enter some starting values.",font=fontHeading),row=6,column=1,columnspan=4)

tkgrid(tklabel(tt,text="x1",font=fontVector),row=7,column=2)
tkgrid(tklabel(tt,text="x2",font=fontVector),row=7,column=3)
tkgrid(tklabel(tt,text="x3",font=fontVector),row=7,column=4)


tkgrid(entry.x011,row=8,column=2)
tkgrid(entry.x012,row=8,column=3)
tkgrid(tklabel(tt,textvariable=calc.x013),row=8,column=4)

tkgrid(entry.x021,row=9,column=2)
tkgrid(entry.x022,row=9,column=3)
tkgrid(tklabel(tt,textvariable=calc.x023),row=9,column=4)

tkgrid(entry.x031,row=10,column=2)
tkgrid(entry.x032,row=10,column=3)
tkgrid(tklabel(tt,textvariable=calc.x033),row=10,column=4)

tkgrid(entry.x041,row=11,column=2)
tkgrid(entry.x042,row=11,column=3)
tkgrid(tklabel(tt,textvariable=calc.x043),row=11,column=4)

tkgrid(entry.x051,row=12,column=2)
tkgrid(entry.x052,row=12,column=3)
tkgrid(tklabel(tt,textvariable=calc.x053),row=12,column=4)

tkgrid(entry.x061,row=13,column=2)
tkgrid(entry.x062,row=13,column=3)
tkgrid(tklabel(tt,textvariable=calc.x063),row=13,column=4)

tkgrid(entry.x071,row=14,column=2)
tkgrid(entry.x072,row=14,column=3)
tkgrid(tklabel(tt,textvariable=calc.x073),row=14,column=4)

tkgrid(entry.x081,row=15,column=2)
tkgrid(entry.x082,row=15,column=3)
tkgrid(tklabel(tt,textvariable=calc.x083),row=15,column=4)

tkgrid(entry.x091,row=16,column=2)
tkgrid(entry.x092,row=16,column=3)
tkgrid(tklabel(tt,textvariable=calc.x093),row=16,column=4)

tkgrid(entry.x101,row=17,column=2)
tkgrid(entry.x102,row=17,column=3)
tkgrid(tklabel(tt,textvariable=calc.x103),row=17,column=4)

tkgrid(entry.x111,row=18,column=2)
tkgrid(entry.x112,row=18,column=3)
tkgrid(tklabel(tt,textvariable=calc.x113),row=18,column=4)

tkgrid(entry.x121,row=19,column=2)
tkgrid(entry.x122,row=19,column=3)
tkgrid(tklabel(tt,textvariable=calc.x123),row=19,column=4)

tkgrid(entry.x131,row=20,column=2)
tkgrid(entry.x132,row=20,column=3)
tkgrid(tklabel(tt,textvariable=calc.x133),row=20,column=4)

tkgrid(entry.x141,row=21,column=2)
tkgrid(entry.x142,row=21,column=3)
tkgrid(tklabel(tt,textvariable=calc.x143),row=21,column=4)

tkgrid(entry.x151,row=22,column=2)
tkgrid(entry.x152,row=22,column=3)
tkgrid(tklabel(tt,textvariable=calc.x153),row=22,column=4)


OK.but <- tkbutton(tt,text=" Run ",command=function()run.ev())

tkgrid(OK.but,row=23,column=4)
tkfocus(tt)