layout.R 6.64 KB
Newer Older
Heraut Louis's avatar
Heraut Louis committed
# Usefull library
library(ggplot2)
library(scales)
library(qpdf)
library(gridExtra)
library(gridtext)
library(dplyr)
library(grid)
library(ggh4x)
library(RColorBrewer)


# Sourcing R file
source('plotting/panel.R', encoding='latin1')


Heraut Louis's avatar
Heraut Louis committed
panels_layout = function (df_data, df_meta, layout_matrix, figdir='', filedir_opt='', filename_opt='', variable='', df_trend=NULL, p_threshold=0.1, unit2day=365.25, type='', period=NULL, missRect=FALSE, time_header=NULL, info_header=TRUE, time_ratio=2, var_ratio=3) {
Heraut Louis's avatar
Heraut Louis committed
    
    if (all(class(df_data) != 'list')) {
        df_data = list(df_data)
    }

    nbp = length(df_data)

    if (all(class(df_trend) != 'list')) {
        df_trend = list(df_trend)
        if (length(df_trend) == 1) {
            df_trend = replicate(nbp, df_trend)
        }}

    if (all(class(p_threshold) != 'list')) {
        p_threshold = list(p_threshold)
        if (length(p_threshold) == 1) {
            p_threshold = replicate(nbp, p_threshold)
        }}
  
    if (all(class(unit2day) != 'list')) {
        unit2day = list(unit2day)
        if (length(unit2day) == 1) {
            unit2day = replicate(nbp, unit2day)
        }}

    if (all(class(type) != 'list')) {
        type = list(type)
        if (length(type) == 1) {
            type = replicate(nbp, type)
        }}

    if (all(class(missRect) != 'list')) {
        missRect = list(missRect)
        if (length(missRect) == 1) {
            missRect = replicate(nbp, missRect)
        }}

    list_df2plot = vector(mode='list', length=nbp)
    minTrend = c()
    maxTrend = c()

    for (i in 1:nbp) {
        
        df2plot = list(data=df_data[[i]], 
                       trend=df_trend[[i]],
                       p_threshold=p_threshold[[i]],
                       unit2day=unit2day[[i]],
                       type=type[[i]],
                       missRect=missRect[[i]])
        
        okTrend = df_trend[[i]]$trend[df_trend[[i]]$p <= p_threshold[[i]]]

        minTrend[i] = min(okTrend, na.rm=TRUE)
        maxTrend[i] = max(okTrend, na.rm=TRUE)

        list_df2plot[[i]] = df2plot
    }


    outfile = "Panels"
    if (filename_opt != '') {
        outfile = paste(outfile, '_', filename_opt, sep='')
    }
    outfile = paste(outfile, '.pdf', sep='')

    # If there is not a dedicated figure directory it creats one
    outdir = file.path(figdir, filedir_opt, sep='')
    if (!(file.exists(outdir))) {
        dir.create(outdir)
    }

    outdirTmp = file.path(outdir, 'tmp')
    if (!(file.exists(outdirTmp))) {
        dir.create(outdirTmp)
    }

    # Get all different stations code
    Code = levels(factor(df_meta$code))
    nCode = length(Code)
    
    for (code in Code) {
        
        # Print code of the station for the current plotting
        print(paste("Plotting for station :", code))
Heraut Louis's avatar
Heraut Louis committed
        
        nbh = as.numeric(info_header) + as.numeric(!is.null(time_header))
        nbg = nbp + nbh

        P = vector(mode='list', length=nbg)

        if (info_header) {
            Htext = text_panel(code, df_meta)
            P[[1]] = Htext
        }

        if (!is.null(time_header)) {

            time_header_code = time_header[time_header$code == code,]
            
Heraut Louis's avatar
Heraut Louis committed
            Htime = time_panel(time_header_code, df_trend_code=NULL,
                               period=period, missRect=TRUE,
                               unit2day=365.25, type='Q')

            P[[2]] = Htime
        }


        nbcol = ncol(as.matrix(layout_matrix))
        for (i in 1:nbp) {
            df_data = list_df2plot[[i]]$data
            df_trend = list_df2plot[[i]]$trend
            p_threshold = list_df2plot[[i]]$p_threshold
            unit2day = list_df2plot[[i]]$unit2day
            missRect = list_df2plot[[i]]$missRect
            type = list_df2plot[[i]]$type
Heraut Louis's avatar
Heraut Louis committed
            df_data_code = df_data[df_data$code == code,] 
            df_trend_code = df_trend[df_trend$code == code,]

            if (df_trend_code$p <= p_threshold){
                color_res = get_color(df_trend_code$trend, 
                                      minTrend[i],
                                      maxTrend[i], 
                                      palette_name='perso',
                                      reverse=FALSE)

                color = color_res$color
                palette = color_res$palette

            } else {            
                color = NULL
                palette = NULL
            }
            
            p = time_panel(df_data_code, df_trend_code, type=type,
                           p_threshold=p_threshold, missRect=missRect,
                           unit2day=unit2day, last=(i > nbp-nbcol),
                           color=color)

            P[[i+nbh]] = p

        }
        
        layout_matrix = as.matrix(layout_matrix)
        nel = nrow(layout_matrix)*ncol(layout_matrix)

        idNA = which(is.na(layout_matrix), arr.ind=TRUE)

        layout_matrix[idNA] = seq(max(layout_matrix, na.rm=TRUE) + 1,
                                  max(layout_matrix, na.rm=TRUE) + 1 +
                                  nel)

        layout_matrix_H = layout_matrix + nbh


        LM = c()
        LMcol = ncol(layout_matrix_H)
        LMrow = nrow(layout_matrix_H)
        for (i in 1:(LMrow+nbh)) {

Heraut Louis's avatar
Heraut Louis committed
            if (info_header & i == 1) {
Heraut Louis's avatar
Heraut Louis committed
                LM = rbind(LM, rep(i, times=LMcol))
Heraut Louis's avatar
Heraut Louis committed
            } else if (!is.null(time_header) & i == 2) {
                LM = rbind(LM,
                           matrix(rep(rep(i, times=LMcol),
                                      times=time_ratio),
                                  ncol=LMcol, byrow=TRUE))
            # if (i <= nbh) {
                # LM = rbind(LM, rep(i, times=LMcol))

Heraut Louis's avatar
Heraut Louis committed
            } else {
                LM = rbind(LM, 
                           matrix(rep(layout_matrix_H[i-nbh,],
Heraut Louis's avatar
Heraut Louis committed
                                      times=var_ratio),
Heraut Louis's avatar
Heraut Louis committed
                                  ncol=LMcol, byrow=TRUE))
            }}

        plot = grid.arrange(grobs=P, layout_matrix=LM)
        
        # plot = grid.arrange(rbind(cbind(ggplotGrob(P[[2]]), ggplotGrob(P[[2]])), cbind(ggplotGrob(P[[3]]), ggplotGrob(P[[3]]))), heights=c(1/3, 2/3))
        

        # Saving
        ggsave(plot=plot, 
               path=outdirTmp,
               filename=paste(as.character(code), '.pdf', sep=''),
               width=21, height=29.7, units='cm', dpi=100)

    }

    # mat = matrice_panel(list_df2plot, df_meta)

    # # Saving matrix plot
    # ggsave(plot=mat, 
    #        path=outdirTmp,
    #        filename=paste('matrix', '.pdf', sep=''),
    #        width=21, height=29.7, units='cm', dpi=100)

    # PDF combine
    pdf_combine(input=file.path(outdirTmp, list.files(outdirTmp)),
                output=file.path(outdir, outfile))
    unlink(outdirTmp, recursive=TRUE)

}