R/utils_ntradeapp.R

In qPRAentry: Quantitative Pest Risk Assessment at the Entry Step

data_input <- function(ns, data_name, title_data, partner = TRUE, extra=FALSE){
  fluidRow(
    shinyWidgets::dropMenu(
      arrow = FALSE,
      maxWidth = "100%",
      placement = "bottom-start",
      hideOnClick = TRUE,
      actionButton(ns(paste0(data_name, "_menu")),
                   h5(strong(title_data, style = "color:#327FB0")),
                   icon = icon("angle-down"),
                   width = "100%"),
      width = "100%",
      fileInput(ns(data_name),
                "Data file (CSV):",
                accept = c('.csv'),
                width = "100%"),
      fluidRow(
        column(9, class="inline",
               numericInput(ns(paste0("units", data_name)),
                            HTML("Data units &nbsp;&nbsp;&nbsp;<b>X</b>"),
                            value = 1)
        ),
        column(3,  class="unitslab",
               textOutput(ns(paste0("unitsOutput", data_name))))
      ),
      br(),
      h4("Column names:", style = "color:#327FB0"),
      shinyWidgets::pickerInput(
        inputId = ns(paste0("reporter_", data_name)),
        label = "Reporter:",
        choices = c("Data must be uploaded"),
        multiple = FALSE,
        width ="fit"
      ),
      if(partner){
        shinyWidgets::pickerInput(
          inputId = ns(paste0("partner_", data_name)),
          label = "Partner:",
          choices = c("Data must be uploaded"),
          multiple = FALSE,
          width ="fit"
        )
      },
      shinyWidgets::pickerInput(
        inputId = ns(paste0("value_", data_name)),
        label = "Values:",
        choices = c("Data must be uploaded"),
        multiple = FALSE,
        width ="fit"
      ),
      shinyWidgets::pickerInput(
        inputId = ns(paste0("time_period_", data_name)),
        label = "Time period:",
        choices = c("Data must be uploaded"),
        multiple = FALSE,
        width ="fit"
      ),
      if(extra){
        shinyWidgets::pickerInput(
          inputId = ns(paste0("extra_partner_", data_name)),
          label = "Partner countries:",
          choices = c("Data must be uploaded"),
          multiple = TRUE,
          width = "100%",
          options = list(`actions-box` = TRUE)
        )
      },
      br(),
      actionButton(ns(paste0("done_", data_name)), "Done", class="enable")
    )#dropdown
  )
}

colnames_select <- function(df, data_name, partner=TRUE, session = session){
  updatePickerInput(session = session,
                    inputId = paste0("reporter_", data_name),
                    # selected = character(0),
                    selected = "reporter",
                    choices = sort(colnames(df)))
  if(partner){
    updatePickerInput(session = session,
                      inputId = paste0("partner_", data_name),
                      # selected = character(0),
                      selected = "partner",
                      choices = sort(colnames(df)))
  }
  updatePickerInput(session = session,
                    inputId = paste0("value_", data_name),
                    # selected = character(0),
                    selected = "OBS_VALUE",
                    choices = sort(colnames(df)))
  updatePickerInput(session = session,
                    inputId = paste0("time_period_", data_name),
                    # selected = character(0),
                    selected = "TIME_PERIOD",
                    choices = sort(colnames(df)))
}

data_summary <- function(df, group, value){
  df <- df %>%
    group_by(!! sym(group)) %>%
    summarise(Mean = mean(!! sym(value), na.rm=TRUE),
              SD = sd(!! sym(value), na.rm=TRUE)) %>%
    replace(is.na(.), 0)
  df
}

plot_dataUpload <- function(df, dfName, timePeriod, yLab,
                            plotTitle, legendTitle=NULL){
  country_IDs <- extra_total <- extra_pest <- intra_import <- intra_export <- 
    internal_production <- text1 <- text2 <- Mean <- SD <- Trade <- 
    trade_mean <- trade_sd <- value <- time_period <- NULL
  
  if(dfName == "ExtraTotal"){
    if(length(timePeriod)==1){
      Total <- df %>%
        select(country_IDs, extra_total) %>%
        mutate(value=extra_total,
               text1 = paste0(country_IDs, "\nTotal: ", round(extra_total,2)))
      Pest <- df %>%
        select(country_IDs, extra_pest) %>%
        mutate(value = extra_pest,
               text2 = paste0(country_IDs, "\nPest present: ", round(value,2)))
      
      pl <- ggplot(NULL, aes(country_IDs, value)) +
        geom_col_interactive(aes(fill = "Total", tooltip=text1, data_id=country_IDs), 
                             data = Total, alpha = 0.5) +
        geom_col_interactive(aes(fill= "Pest present", tooltip=text2, data_id=country_IDs), 
                             data = Pest, alpha = 0.7)
      
    }else{
      Total <- df %>%
        select(country_IDs, extra_total) %>%
        data_summary(group="country_IDs", value="extra_total") %>%
        mutate(text1 = paste0(country_IDs, " - Total\nMean: ", round(Mean,2),
                              "\nSD: ", round(SD,2)))
      Pest <- df %>%
        select(country_IDs, extra_pest) %>%
        data_summary(group="country_IDs", value="extra_pest") %>%
        mutate(text2 = paste0(country_IDs, " - Pest present\nMean: ", round(Mean,2),
                              "\nSD: ", round(SD,2)))
      pl <- ggplot(NULL, aes(country_IDs, Mean)) +
        geom_col_interactive(aes(fill = "Total", tooltip=text1, data_id=country_IDs), 
                             data = Total, alpha = 0.5) +
        geom_errorbar(aes(ymin=Mean-SD, ymax=Mean+SD),
                      data = Total, width=.2, color="#6D6C6C") +
        geom_col_interactive(aes(fill="Pest present", tooltip=text2, data_id=country_IDs), 
                             data = Pest, alpha = 0.7) +
        geom_errorbar(aes(ymin=Mean-SD, ymax=Mean+SD),
                      data = Pest, width=.2, color="#6D6C6C")
    }
  }else if(dfName == "Intra"){
    if(length(timePeriod)==1){
      intraEU <- df %>%
        select(country_IDs, intra_import, intra_export) %>%
        rename(Import = intra_import,
               Export = intra_export) %>%
        pivot_longer(cols=c('Import', 'Export'),
                     names_to='Trade',
                     values_to='value')
      pl <- ggplot(intraEU, aes(country_IDs, value, fill=Trade, data_id=country_IDs))+
        geom_col_interactive(position = "dodge", alpha=0.7,
                             aes(tooltip = paste0(country_IDs, "\n", Trade, ": ", 
                                                  round(value,2)))) +
        scale_fill_manual(values =c("#009E73", "orange"))
    }else{
      intraEU_mean <- df %>%
        select(country_IDs, time_period, intra_import, intra_export) %>%
        group_by(country_IDs) %>%
        summarise(Import = mean(intra_import),
                  Export = mean(intra_export)) %>%
        pivot_longer(cols=c('Import', 'Export'),
                     names_to="Trade",
                     values_to="trade_mean")
      
      intraEU_sd <- df %>%
        select(country_IDs, time_period, intra_import, intra_export) %>%
        group_by(country_IDs) %>%
        summarise(Import = sd(intra_import),
                  Export = sd(intra_export)) %>%
        pivot_longer(cols=c('Import', 'Export'),
                     names_to="Trade",
                     values_to="trade_sd")
      
      intraEU <- intraEU_mean %>%
        left_join(intraEU_sd, by = join_by(country_IDs, Trade)) %>%
        replace(is.na(.), 0)
      
      pl <- ggplot(intraEU, aes(country_IDs, trade_mean, fill=Trade, data_id=country_IDs))+
        geom_col_interactive(position = "dodge", alpha=0.7,
                             aes(tooltip = paste0(country_IDs,
                                                  "\n", Trade, " Mean: ", round(trade_mean,2),
                                                  "\n", Trade, " SD: ", round(trade_sd,2))))+
        geom_errorbar(aes(ymin=trade_mean-trade_sd, ymax=trade_mean+trade_sd),
                      position=position_dodge(.9), width=.3, color="#6D6C6C")+
        scale_fill_manual(values =c("#009E73", "orange"))
    }
    
  }else if(dfName == "IP"){
    if(length(timePeriod)==1){
      pl <- ggplot(df, aes(country_IDs, internal_production, data_id=country_IDs)) +
        geom_col_interactive(alpha = 0.7, fill="#CAD100",
                             aes(tooltip = paste0(country_IDs, ": ", 
                                                  round(internal_production,2)) ))
    }else{
      df <- df %>%
        select(country_IDs, internal_production, time_period) %>%
        data_summary(group="country_IDs", value="internal_production")
      pl <- ggplot(df, aes(country_IDs, Mean, data_id=country_IDs))+
        geom_col_interactive(position = "dodge", alpha=0.7, fill="#CAD100",
                             aes(tooltip=paste0(country_IDs, "\nMean: ", round(Mean,2),
                                                "\nSD: ", round(SD,2))))+
        geom_errorbar(aes(ymin=Mean-SD, ymax=Mean+SD),
                      width=.2, color="#6D6C6C")
    }
  }
  
  if(!is.null(legendTitle)){
    pl <- pl + guides(fill=guide_legend(title=legendTitle))
  }
  pl <- pl +
    xlab("")+
    ylab(yLab)+
    ggtitle(plotTitle)+
    theme(legend.position = "top",
          legend.text = element_text(size=9),
          legend.title = element_text(size=10),
          title = element_text(size=10),
          axis.text = element_text(size=8))
  return(pl)
}

plot_byCountry <- function(df, dfName, idx, yLab, plotTitle, legendTitle=NULL){
  country_IDs <- extra_total <- extra_pest <- intra_import <- time_period <- value <- 
    intra_export <- Trade <- internal_production <- NULL
  if(dfName=="ExtraTotal"){
    Total <- df %>%
      select(country_IDs, time_period, extra_total) %>%
      rename(value = extra_total) %>%
      filter(country_IDs==idx)
    Pest <- df %>%
      select(country_IDs, time_period, extra_pest) %>%
      rename(value = extra_pest) %>%
      filter(country_IDs==idx)
    v_max <- max(Total$value, na.rm=T)
    pl <- ggplot(NULL, aes(as.factor(time_period), value)) +
      geom_col(aes(fill = "Total"), data = Total, alpha = 0.5) +
      geom_col(aes(fill="Pest present"), data = Pest, alpha = 0.7)
  }else if(dfName=="Intra"){
    intraEU <- df %>%
      select(country_IDs, time_period, intra_import, intra_export) %>%
      rename(Import = intra_import,
             Export = intra_export) %>%
      filter(country_IDs==idx) %>%
      pivot_longer(cols=c('Import', 'Export'),
                   names_to='Trade',
                   values_to='value')
    v_max <- max(intraEU$value, na.rm=T)
    pl <- ggplot(intraEU, aes(as.factor(time_period), value, fill=Trade))+
      geom_col(position = "dodge", alpha=0.7) +
      scale_fill_manual(values =c("#009E73", "orange"))
  }else if(dfName=="IP"){
    IP_time <- df %>%
      select(country_IDs, time_period, internal_production) %>%
      rename(value = internal_production) %>%
      filter(country_IDs==idx)
    v_max <- max(IP_time$value, na.rm=T)
    pl <- ggplot(IP_time, aes(as.factor(time_period), value))+
      geom_col(fill="#CAD100", alpha=0.7)
  }
  if(!is.null(legendTitle)){
    pl <- pl + guides(fill=guide_legend(title=legendTitle))
  }
  pl <- pl +
    ylim(0, v_max) +
    xlab("Time period") +
    ylab(yLab) +
    ggtitle(paste(plotTitle, idx, sep=" ")) +
    theme(legend.position = "top",
          legend.text = element_text(size=14),
          legend.title = element_text(size=14),
          title = element_text(size=15),
          axis.text = element_text(size=12))
  
  return(pl)
}