R/plots.R

In ratkovic-judgeresearch/shinyPublic: Functions for JudgeResearch Shiny

#'  Plot for GA Function
#'
#' 
#' @export
#'
# devtools::load_all('~/Dropbox/Github/shinyPublic')
# options(device="quartz")
# reportName <- "practiceGAreport.rds"
# plotGALoss(reportName)
plotGALoss <- function(reportName, xmin = 0, xmax = 1){
  loadFile(objName = "reportList", fileName = reportName)
  par(mar=c(3,3.1,.2,.2), oma=c(0,.5,0,0), bg = "#03123a59")
  lossObj <- reportList[["byGen"]][["loss"]]
  xmin <- floor(xmin*nrow(lossObj))
  xmin <- max(xmin,1)
  maxGen <- ceiling(nrow(lossObj)*xmax)
  xmax <- min(maxGen, nrow(lossObj))
  lossObj <- lossObj[xmin:maxGen,]
  # if(!is.null(xmax)) maxGen <- xmax
  ylim.use <- range(lossObj[,-c(1:10)])
  ymin.axis <- floor(ylim.use[2]*10)/10
  ymax.axis <- ceiling(ylim.use[1]*10)/10
  if(xmin < 1) xmin <- 1
  if(xmin >= maxGen) xmin <- maxGen-2
  xlim.use <- c(xmin, maxGen)
  
  diffax <- round(abs(round((ymax.axis-ymin.axis)*10)/50)*10)/10
  ylim.ticks <- seq(ymin.axis+2*diffax,ymax.axis-2*diffax, by=-diffax)
  plot(lossObj[,1], lossObj[,"100%"],type="n", xlim = xlim.use,
       ylim = range(lossObj[,-c(1:4)]),#[xmin:maxGen,-c(1:4)]),
       xlab="",ylab="", xaxt="n", yaxt="n")
  axis(1,at=floor(floor(0:((maxGen/5)+1)*5)),col = "white")
  axis(2,at=ylim.ticks,col = "white")
  mtext(side=1,"Generation",font=2,line=1.9, family = "MarkPro")
  mtext(side=2,"Fitness",font=2,line=2, las=0, family = "MarkPro")
  
  rect(par("usr")[1],par("usr")[3],par("usr")[2],par("usr")[4],col = "gray90")
  # abline(v=(0:maxGen)*5,col="white")
  # abline(h=ylim.ticks,col="white")
  
  generateJRcolors <- function(z){
    seqCol <- (0:z)/z
    suffixCol <- NULL
    for(i in 1:(z+1)){
      colCurr <- rgb(1,0,0,seqCol[i])
      suffixCol[i] <- gsub("#FF0000","",colCurr)
    }
    paste("#03123a",suffixCol,sep="")
  }
  
  JRColorBase <- generateJRcolors(20)
  for(i in 0:19){
    name1 <- paste(i*5, "%", sep="")
    name2 <- paste((i+1)*5, "%", sep="")

    polygon(x = c(lossObj[,"generation"], rev(lossObj[,"generation"])),
            y = c(lossObj[,name1]-0.001, rev(lossObj[,name2])+0.001),
            col=JRColorBase[i],
            border = NA#rgb(0,0,1,alpha=1)#rgb(0,0,1, alpha=(i+1)/21)
    )
    if(name1%in%c("25%","50%","75%")) lines(lossObj[,"generation"],lossObj[,name1],col="#03123a", lwd=1)
  }
}