#'Function to convert any numerical array to a grid of coloured triangles. 
#'
#'This function converts a numerical data array into a coloured 
#'grid with triangles. It is useful for a slide or article to present tabular results as 
#'colors instead of numbers. This can be used to compare the outputs of two or four categories (e.g. modes 
#' of variability, clusters, or forecast systems). 
#'
#'@param var an array with three dimensions: rows, columns and categories 
#'  containing the values to be displayed in a colored image with triangles.
#'@param poscols the dimension that will be represented as columns.
#'@param posrows the dimension that will be reprsented as rows.
#'@param brks A vector of the color bar intervals. The length must be one more 
#'  than the parameter 'cols'. Use ColorBar() to generate default values.
#'@param cols A vector of valid colour identifiers for color bar. The length
#'  must be one less than the parameter 'brks'. Use ColorBar() to generate 
#'  default values.
#'@param toptitle A string of the title of the grid. Set NULL as default.   
#'@param sig_var logical array with the same dimensions as 'var' to add layers 
#'  to the plot. A value of TRUE at a grid cell will draw a dot/symbol on the 
#'  corresponding triangle of the plot. Set NULL as default.
#'@param pch_sig symbol to be used to represent sig_var. Takes 18 
#' (diamond) by default. See 'pch' in par() for additional 
#' accepted options.
#'@param col_sig colour of the symbol to represent sig_var. 
#'@param cex_sig parameter to increase/reduce the size of the symbols used 
#'  to represent sig_var.
#'@param xlabels A vector of labels of the x-axis The length must be 
#'  length of the col of parameter 'var'. Set the sequence from 1 to the 
#'  length of the row of parameter 'var' as default.
#'@param xtitle A string of title of the x-axis. Set NULL as default.
#'@param ylabels A vector of labels of the y-axis The length must be 
#'  length of the row of parameter 'var'. Set the sequence from 1 to the 
#'  length of the row of parameter 'var' as default. 
#'@param ytitle A string of title of the y-axis. Set NULL as default.
#'@param legend A logical value to decide to draw the color bar legend or not. 
#'  Set TRUE as default.
#'@param lab_legend A vector of labels indicating what is represented in each 
#'category (i.e. triangle). Set the sequence from 1 to the length of 
#' the categories (2 or 4).  
#'@param cex_leg a number to indicate the increase/reductuion of the lab_legend used 
#'  to represent sig_var.
#'@param col_leg color of the legend (triangles).
#'@param fileout A string of full directory path and file name indicating where 
#'  to save the plot. If not specified (default), a graphics device will pop up. 
#'@param size_units A string indicating the units of the size of the device 
#'  (file or window) to plot in. Set 'px' as default. See ?Devices and the 
#'  creator function of the corresponding device.
#'@param res A positive number indicating resolution of the device (file or window) 
#'  to plot in. See ?Devices and the creator function of the corresponding device.
#'@param ... The additional parameters to be passed to function ColorBar() in 
#'  s2dverification for color legend creation.
#'@return A figure in popup window by default, or saved to the specified path.
#'
#'@author History:\cr
#'1.0  -  2019-10  (V.Torralba, \email{veronica.torralba@bsc.es})  -  Original code
#'
#'@examples 
#'#Example with random data
#' arr1<- arr1<- array(runif(n = 12 * 7 * 4, min=-1, max=1),dim = c(12,7,4))
#'arr2<- array(TRUE,dim = dim(arr1))
#'arr2[which(arr1 < 0.3)] = FALSE
#'PlotTableTriangles(var = arr1,
#'                   cols = c('white','#fef0d9','#fdd49e','#fdbb84','#fc8d59',
#'                            '#e34a33','#b30000', '#7f0000'),
#'                   brks = c(-1, 0, 0.1, 0.2, 0.3, 0.4, 0.5, 0.6, 1),
#'                   xtitle = "Target month", ytitle = "Lead time",
#'                 xlabels = c("Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul",
#'                               "Aug", "Sep", "Oct", "Nov", "Dec"))
#'@importFrom grDevices dev.new dev.off dev.cur 
#'@export

PlotTableTriangles<-function(var,poscols=1,posrows=2,cols=NULL,brks=NULL,
                             toptitle=NULL,
                             sig_var=NULL,col_sig='black',pch_sig=18,
                             cex_sig=1,
                             xlabels=NULL, xtitle=NULL, 
                             ylabels=NULL, ytitle=NULL,
                             legend=TRUE,lab_legend=NULL,
                             cex_leg=1,col_leg='black',
                             fileout=NULL,
                             size_units = 'px', res = 100,
                             figure.width = 1,
                             ...){
  # Checking the dimensions
  vardim<-dim(var)
  nrow<-vardim[posrows]
  ncol<-vardim[poscols]
  poscat<-vardim[setdiff(1:length(vardim),c(posrows,poscols))]
  
  # If there is any filenames to store the graphics, process them
  # to select the right device 
  if (!is.null(fileout)) {
    deviceInfo <- s2dverification:::.SelectDevice(fileout = fileout,
                                                  width = 80 * ncol * figure.width, 
                                                  height = 80 * nrow,
                                                  units = size_units, res = res)
    saveToFile <- deviceInfo$fun
    fileout <- deviceInfo$files
  }
  
  # Open connection to graphical device
  if (!is.null(fileout)) {
    saveToFile(fileout)
  } else if (names(dev.cur()) == 'null device') {
    dev.new(units = size_units, res = res,
            width = 8 * figure.width, height = 5)
  }
  
  if (!is.null(sig_var)){
    if (!is.logical(sig_var)){
      stop('sig_var array should be provided as TRUE/FALSE')
    }
    if (all(dim(sig_var)!=dim(var))){
      stop('sig_var array should have the same dimensions that var')
    }
  }
  
  if (length(vardim)!=3){
    stop('var must be an array with three dimensions (4, cols, rows) ')
  }
  
  if (poscat!=4 && poscat!=2){
    stop('var must be an array with one of the dimensions being equal to 4 or 2')
  }
  
  # The dimensions are named 
  names(dim(var))[poscols]<-'cols'
  names(dim(var))[posrows]<-'rows'
  names(dim(var))[setdiff(1:length(vardim),c(posrows,poscols))]<-'cat'
  
  if (!is.null(sig_var)){
    names(dim(sig_var))<-names(dim(var))
  }
  
  # Checking what is available and generating missing information 
  if (!is.null(lab_legend)&&length(lab_legend)!=4){
    stop('The legend should contain 4 names')
  }
  
  if (is.null(xlabels)){
    xlabels=1:ncol
  }
  if (is.null(ylabels)){
    ylabels=1:nrow
  }
  if (is.null(brks)){
    brks<-seq(min(var),max(var),length.out = 9)
  }
  if (is.null(cols)){
    cols<-rev(brewer.pal(length(brks)-1,'RdBu'))
  }
  
  # The colours for each triangle/category are defined
  var_cat <- array(cols[length(cols)], dim = vardim)
  names(dim(var_cat)) <- names(dim(var))
  for (i in (length(cols) - 1):1) {
    var_cat[var < brks[i + 1]] <- cols[i]
  }
  
  if(legend){
    layout(matrix(c(1,2,1,3),2,2,byrow=T),widths =c(10,2),heights=c(10,2))
    par(oma=c(1,1,1,1),mar=c(5,4,4,0))
    if(is.null(lab_legend)){
      lab_legend=1:4
    }
  }
  
  plot(ncol,nrow,xlim = c(0,ncol),ylim=c(0,nrow), xaxs="i",yaxs='i',type="n", 
       xaxt="n", yaxt="n",ann=F,axes=F)
  
  box(col='black',lwd=1)
  
  if (! is.null(toptitle)){
    title(toptitle, cex=1.5)
  }
  
  if (!is.null(xtitle)){
    mtext(side = 1, text = xtitle, line = 4, cex=1.5)
  }
  if (!is.null(ytitle)){
    mtext(side = 2, text = ytitle, line = 2.5, cex=1.5)
  }
  
  axis(1, at=(1:ncol)-0.5, las=2, labels=xlabels, cex.axis=1.5)
  axis(2, at=(1:nrow)-0.5, las=2, labels=ylabels, cex.axis=1.5)
  
  
  #The triangles are plotted
  for(p in 1:ncol){
    for(l in 1:nrow){
      if (poscat==4){
        coord_triangl <- list(xs=list(c(p-1, p-0.5, p-1),c(p-1, p-0.5, p),c(p, p-0.5, p),c(p-1, p-0.5, p)),
                              ys=list( c(l-1, -0.5+l, l), c(l-1, -0.5+l, l-1),c(l-1, -0.5+l, l),c(l, -0.5+l, l)))
        
        coord_sig <- list(x=c(p-0.75,p-0.5,p-0.25,p-0.5),y=c(l-0.5,l-0.75,l-0.5,l-0.25))
      }
      
      if (poscat==2){
        coord_triangl<- list(xs=list(c(p-1, p, p),c(p-1, p, p-1)),
                             ys=list( c(l-1,l-1, l), c(l-1, l, l)))
        coord_sig<- list(x=c(p-(2/3),p-(1/3)),y=c(l-(1/3),l-(2/3)))
      }
      for (n in 1:poscat) {
        polygon(coord_triangl$xs[[n]],
                coord_triangl$ys[[n]],
                col = Subset(
                  var_cat,
                  along = c('cat', 'cols', 'rows'),
                  indices = list(n, p, l)))
        if (!is.null(sig_var) &&
            Subset(sig_var,along = c('cat', 'cols', 'rows'),
                   indices = list(n, p, l))) {
          points(
            x = coord_sig$x[n],
            y = coord_sig$y[n],
            pch = pch_sig,
            cex = cex_sig,
            col = col_sig
          )
        }
      }
    }
  }
  
  # legend
  
  if(legend){
    # Colorbar
    par(mar=c(0,0,0,0))
    ColorBar(brks = brks, cols = cols, vert=T,draw_ticks = T, draw_separators = T,
             extra_margin = c(0,0,2.5,0),label_scale = 1.5,...)
    
    par(mar=c(0.5,2.5,0,2.5))
    plot(1,1,xlim = c(0,1),ylim=c(0,1), xaxs="i",yaxs='i',type="n", 
         xaxt="n", yaxt="n",ann=F,axes=F)
    
    box(col=col_leg)
    p=l=1
    if (poscat==4){
      coord_triangl <- list(xs=list(c(p-1, p-0.5, p-1),c(p-1, p-0.5, p),c(p, p-0.5, p),c(p-1, p-0.5, p)),
                            ys=list( c(l-1, -0.5+l, l), c(l-1, -0.5+l, l-1),c(l-1, -0.5+l, l),c(l, -0.5+l, l)))
      
      coord_sig <- list(x=c(p-0.75,p-0.5,p-0.25,p-0.5),y=c(l-0.5,l-0.75,l-0.5,l-0.25))
    }
    
    if (poscat==2){
      coord_triangl<- list(xs=list(c(p-1, p, p),c(p-1, p, p-1)),
                           ys=list( c(l-1,l-1, l), c(l-1, l, l)))
      coord_sig<- list(x=c(p-(2/3),p-(1/3)),y=c(l-(1/3),l-(2/3)))
    }
    for (n in 1:poscat) {
      polygon(coord_triangl$xs[[n]],
              coord_triangl$ys[[n]],border=col_leg)
      text(x=coord_sig$x[[n]],y=coord_sig$y[[n]],labels = lab_legend[n],cex=cex_leg,col=col_leg)
      
    }
  }
  
  # If the graphic was saved to file, close the connection with the device
  if (!is.null(fileout)) dev.off()
}

