R/BoxplotParametersOnPOF.R

In hydroMOPSO: Multi-Objective Optimisation with Focus on Environmental Models

BoxplotParametersOnPOF <- function(Results,
                                   legend = NULL,
                                   col.param = NULL,
                                   col.lines = NULL,
                                   name.param = NULL,
                                   lwd = 2,
                                   main = "study case #1",
                                   drty.out = "MOPSO.out",
                                   cex.main = 1,
                                   cex.lab = 1,
                                   cex.axis = 1,
                                   cex.leg = 1,
                                   do.png = FALSE
                              ){

  oldpar <- par(no.readonly = TRUE)
  on.exit(par(oldpar))

  if(!is.null(Results[["hydroResults"]])){
    Results <- Results[["hydroResults"]]
  }


  analysis.period <- Results[["AnalysisPeriod"]]

  if(do.png){

    if(!dir.exists(paste0(drty.out, "/", analysis.period, "/png.out"))){
      dir.create(paste0(drty.out, "/", analysis.period, "/png.out"), recursive = TRUE)
    }
  }

 
  nobjs <- Results[["Dimensions"]][1,1]
  
  obj.names <- as.character(Results[["ObjsNames"]])

  parameter.set.pof <- Results[["ParticlesFilledPOF"]][,-c(1:(nobjs+1))]

  
  raw.some.particles <- matrix(NA, ncol = ncol(Results[["ParticleBestCS"]]), nrow = 1 + length(Results[["ParticleBestObjs"]]))
  colnames(raw.some.particles) <- colnames(Results[["ParticleBestCS"]])
  raw.some.particles[1,] <- as.numeric(Results[["ParticleBestCS"]][1,])
  
  for(i in 1:length(Results[["ParticleBestObjs"]])){
    raw.some.particles[i+1,] <- as.numeric(Results[["ParticleBestObjs"]][[i]][1,])
  }

  some.particles <- raw.some.particles[,-c(1:(nobjs+1))]
  


  particle.bcs <- Results[["ParticleBestCS"]][-c(1:(1+nobjs))]
  objs.bcs <- Results[["ParticleBestCS"]][c(2:(1+nobjs))]


  particles.best.objs <- lapply(Results[["ParticleBestObjs"]], "[", -c(1:(1+nobjs)))
  objs.best.objs <- lapply(Results[["ParticleBestObjs"]], "[", c(2:(1+nobjs)))




  nparam <- ncol(parameter.set.pof)



  samp.colors1 <- c("#A6CEE3","#1F78B4","#B2DF8A","#33A02C","#FB9A99","#E31A1C",
                   "#FDBF6F","#FF7F00","#CAB2D6","#6A3D9A","#FFFF99","#B15928",
                   "#8DD3C7","#FFFFB3","#BEBADA","#FB8072","#80B1D3","#FDB462",
                   "#B3DE69","#FCCDE5","#D9D9D9","#BC80BD","#CCEBC5","#FFED6F")

  samp.colors2 <- c("#E41A1C","#377EB8","#4DAF4A","#984EA3","#FF7F00",
                    "#FFFF33","#A65628","#F781BF","#999999")

  
  # Parameters on Pareto Front =====================================================================================
  
  if(do.png){
    png(filename=paste0(drty.out, "/", analysis.period, "/png.out/Parameters_on_Pareto_Optimal_Front_Boxplots.png"), width = 3840, height = 2160, res = 280)
  }
  
  nplots <- nparam + 1
  
  nrow.lay <- floor(sqrt(nplots))
  ncol.lay <- floor(sqrt(nplots))+1
  
  ncol.lay <- ifelse(nrow.lay*ncol.lay<nplots, ncol.lay + 1, ncol.lay)
  
  par(mfrow = c(nrow.lay, ncol.lay), oma = c(0, 0, 2, 0), mar = c(2,4,3,2))
  
  ###
  
  names.sol <- c("Best Compromise Solution", paste0("Best ",obj.names))

  if(!is.null(legend)){

    names.sol[1:(min(length(legend),length(names.sol)))] <- legend[1:(min(length(legend),length(names.sol)))]

  }
  


  colors.sol <- rep("", length(nobjs))

  if(nparam<=24){
    colors.sol1 <- samp.colors1[1:nparam]
  }else{
    colors.sol1 <- c(samp.colors1, sample(samp.colors1, size = nparam - 24, replace = TRUE))
  }
  

  if(!is.null(col.param)){

    colors.sol1[1:(min(length(col.param),length(colors.sol1)))] <- col.param[1:(min(length(col.param),length(colors.sol1)))]

  }


  #--

  if(nrow(some.particles)<=9){
    colors.sol2 <- samp.colors2[1:nrow(some.particles)]
  }else{
    colors.sol2 <- c(samp.colors2, sample(samp.colors2, size = nrow(some.particles) - 9, replace = TRUE))
  }


  if(!is.null(col.lines)){

    colors.sol2[1:(min(length(col.lines),length(colors.sol2)))] <- col.lines[1:(min(length(col.lines),length(colors.sol2)))]

  }

  #----


  param.names <- colnames(parameter.set.pof)



  if(!is.null(name.param)){

    param.names[1:(min(length(name.param),length(param.names)))] <- name.param[1:(min(length(name.param),length(param.names)))]

  }


  if(file.exists(paste0("MOPSO.in/ParamRanges.txt"))){

    file.ranges <- read.table(paste0("MOPSO.in/ParamRanges.txt"), header = TRUE, row.names = 2)

    type.change <- file.ranges[param.names, "TypeChange"]

    param.names <- apply(cbind(param.names, paste0(type.change, " change")), 1, paste, collapse = "\n")

  }



  #---------


  
  ltype <- sample(c("dashed", "dotted", "dotdash", "longdash", "twodash"), size = nrow(some.particles), replace = TRUE)
  
  for(i in 1:nparam){
    boxplot(parameter.set.pof[,i], main = param.names[i],
            col = colors.sol1[i])
    
    for(j in 1:nrow(some.particles)){
      abline(h = some.particles[j,i], col = colors.sol2[j], lty = ltype[j], lwd = lwd)
    }
    
    
  }
  
  plot(c(0,1),c(0,1),type = "n", axes = FALSE, xlab = "", ylab = "",
      cex.main = cex.main, cex.lab = cex.lab, cex.axis = cex.axis)

  legend(x = 0.5, y = 0.5,xjust = 0.5, yjust = 0.5,
         legend = names.sol, 
         col = colors.sol2, 
         lty = ltype,
         lwd = lwd,
         bty = "n", 
         cex = cex.leg, 
         text.col = "black", 
         horiz = FALSE, 
         inset = c(0.1, 0.1))
  
  mtext("Parameters on Pareto Front", outer = TRUE, cex = 1.5, font = 2)
  
  if(do.png){
    dev.off()
  }
  
}