nutrientModeling/app.R
In GeraldCNelson/nutmod: Calculates nutrient information worldwide
#' Shiny app for the nutrient modelling results
#' title: "Shiny app for the nutrient modelling results"
#' @keywords shiny app
#' @name app.R
#' @author Gerald C. Nelson, \\email{nelson.gerald.c@@gmail.com}
#' @description
#' This script contains the shiny app for the nutrient modeling website
#Copyright (C) 2015-2018 Gerald C,Nelson, except where noted
# This program is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE, See the
# GNU General Public License for more details at http://www.gnu.org/licenses/.
# To make sure data and script files are up to date, first run copyFilestoNutrientModeling.R
# This is a Shiny web application. You can run the application by clicking
# the 'Run App' button in RStudio
source("global.R") # load all the background functions and packages
source("globaldata.R")
source("modules.R")
#note install packages feature in global.R is commented out
source("initializationValues.R")
# Define UI -----
ui <- fluidPage(
theme = shinytheme("lumen"),
title = "Nutrient modeling",
# router_ui(),
useShinyjs(debug = TRUE),
div(
id = "loading_page",
includeHTML("www/introText.html")
),
hidden( # used to make the tabs not appear until the data sets are finished loading
div(id = "mainTabsetPanel",
tabsetPanel(
# Introduction tab panel -----
tabPanel(title = "Introduction",
sidebarLayout(
sidebarPanel( width = 3,
includeHTML("www/countryChoice.html"),
# button_UI("first"),
# button_selectize("first"),
country_choice_mod_ui("countryName"),
selectizeInput(inputId = "userCountryName", label = "Choose country", choices = countryNames, selected = NULL),
selectizeInput(inputId = "userScenarioName", label = "Choose scenario", choices = scenarioNames, selected = initialScenarioName)),
mainPanel(includeHTML("www/introText.html")))),
# Affordability tab panel ------
tabPanel(title = "Affordability",
sidebarLayout(
sidebarPanel(width = 3,
selectizeInput(inputId = "affordabilityCountryName", label = "Choose country", choices = countryNames,
options = list(placeholder = "Select country")),
downloadButton("downloadData.afford", "Download")),
mainPanel(titlePanel("Food expenditure, per capita income and affordability"),
includeHTML("www/affordabilityText.html"),
DT::dataTableOutput("affordabilityTable"),
includeHTML("www/tableNote_affordability.html")))),
# food availability tab panel ------
tabPanel(title = "Food Availability",
verticalLayout(
titlePanel("Average daily food availability by food group"),
includeHTML("www/availabilityText.html"),
selectizeInput(inputId = "availabilityCountryName", label = "Choose country",
choices = countryNames,
options = list(placeholder = "Select country")),
ggiraphOutput("availabilitySpiderGraphP1", height = "700px"),
DT::dataTableOutput("availabilityTableP1"),
downloadButton("downloadData.avail", "Download")
)),
# nutrient availability by food group tab panel ------
tabPanel(title = "Nutrient availability",
sidebarLayout(
sidebarPanel(width = 3,
selectizeInput(inputId = "FGcountryName", label = "Choose country", choices = countryNames),
selectizeInput(inputId = "nutrientGroup", label = "Choose a nutrient group", choices = c("vitamins", "minerals", "macronutrients")),
downloadButton("downloadData.nutAvailFG", "Download")),
mainPanel(titlePanel("Nutrient availability"),
includeHTML("www/foodGroupSpiderGraphText.html"),
div(radioButtons("FGscenarioName", "Choose scenario (See glossary for details):",
list("SSP2_NoCC", "SSP2_HGEM", "SSP1_NoCC", "SSP3_NoCC"), inline = TRUE), style = "display:center-align"),
uiOutput("plot.NutAvailFGbarGraphP1"),
DT::dataTableOutput("NutAvailFGTable"),
includeHTML("www/nutrientDescription.html")))),
#nutrient adequacy tab panel -----
tabPanel(title = "Nutrient Adequacy",
verticalLayout(
titlePanel("Nutrient adequacy and kilocalorie availability"),
includeHTML("www/adequacyText.html"),
selectizeInput(inputId = "adequacyCountryName", label = "Choose country", choices = countryNames),
column(width = 12, ggiraphOutput("adequacySpiderGraphtot", height = "700px")),
fluidRow(
column(width = 2, radioButtons("adequacyScenarioName", "Choose scenario",
list("SSP2_NoCC", "SSP2_HGEM", "SSP1_NoCC", "SSP3_NoCC"), inline = TRUE)),
column(width = 5, plotOutput("energyQuantityBarPlot", height = "200px")),
column(width = 5, plotOutput("energyShareBarPlot", height = "200px"))),
fluidRow(
column(width = 12, DT::dataTableOutput("adequacyTableTot"))),
fluidRow(
column(width = 12, DT::dataTableOutput("energyQuantityTable"))),
fluidRow(
column(width = 12, DT::dataTableOutput("energyShareTable"))),
fluidRow(
column(width = 2, downloadButton("downloadData.adequacy.macro", "Macro")),
column(width = 2, downloadButton("downloadData.adequacy.vits", "Vitamins")),
column(width = 2, downloadButton("downloadData.adequacy.minrls", "Minerals")),
column(width = 2, downloadButton("downloadData.energyRat", "Energy share")),
column(width = 2, downloadButton("downloadData.energyQ", "Kcals"))
)
)),
# Nutrient quality tab panel ------
tabPanel(title = "Nutrient Quality",
tabsetPanel(
# AMDR tab panel -----
tabPanel(title = "Acceptable Macronutrient Distribution Range (AMDR)",
sidebarLayout(
sidebarPanel(width = 3,
selectizeInput(inputId = "AMDRCountryName", label = "Choose country", choices = countryNames),
downloadButton("downloadData.AMDR", "Download")),
mainPanel(titlePanel("Acceptable Macronutrient Distribution Range (AMDR)"),
includeHTML("www/AMDRText.html"),
fluidRow(column(width = 12, ggiraphOutput("AMDRbarGraphP1"))),
fluidRow(column(width = 12, DT::dataTableOutput("AMDRTableP1"))),
includeHTML("www/tableNote_AMDR.html")))),
# nutrient balance tab panel -----
tabPanel(title = "Nutrient Balance Score",
sidebarLayout(
sidebarPanel(width = 3,
selectizeInput(inputId = "nutbalCountryName", label = "Choose country", choices = countryNames),
downloadButton("downloadData.nutbal", "Download")),
mainPanel(titlePanel("Nutrient Balance Score"),
includeHTML("www/nutbalGraphText.html"),
DT::dataTableOutput("nutbalTableP1")))),
# MRV tab panel -----
tabPanel(title = "Maximum Recommended Intake",
sidebarLayout(
sidebarPanel(width = 3,
selectizeInput(inputId = "MRVCountryName", label = "Choose country", choices = countryNames),
downloadButton("downloadData.MRV", "Download")),
mainPanel(titlePanel("Maximum Recommended Intake (MRV) ratios"),
includeHTML("www/MRVText.html"),
DT::dataTableOutput("MRVTableP1")))))), # added style='width: 1000px; height: 1000px' to try to reduce LR margins
# Diversity tab panel, with tabset ------
tabPanel("Dietary diversity",
tabsetPanel(
# Shannon diversity tab panel ------
tabPanel(title = "Shannon diversity index",
sidebarLayout(
sidebarPanel(width = 3,
selectizeInput(inputId = "diversityCountryName", label = "Choose country", choices = countryNames),
downloadButton("downloadData.ShannonDiversity", "Download")),
mainPanel(titlePanel("Shannon diversity index"),
includeHTML("www/shannonDiversityText.html"),
DT::dataTableOutput("diversityTable")))),
# nonstaple energy share tab panel ------
tabPanel(title = "Nonstaple share of dietary energy",
sidebarLayout(
sidebarPanel(width = 3,
selectizeInput(inputId = "nonstapleEnergyShareCountryName", label = "Choose country", choices = countryNames),
downloadButton("downloadData.nonStapleShare", "Download")),
mainPanel(
titlePanel("Nonstaple share of dietary energy"),
includeHTML("www/nonStapleShareGraphText.html"),
DT::dataTableOutput("nonStapleEnergyShareTable"),
includeHTML("www/tableNote_nonstapleShare.html")))),
# Rao's QE tab panel ------
tabPanel(title = "Rao's quadratic entropy metric",
sidebarLayout(
sidebarPanel(width = 3,
selectizeInput(inputId = "RaosQECountryName", label = "Choose country", choices = countryNames),
downloadButton("downloadData.RaoQE", "Download")),
mainPanel(
titlePanel("Rao's quadratic entropy metric"),
includeHTML("www/RaosQEGraphText.html"),
DT::dataTableOutput("RaosQETable")))))),
# glossary tab panel ------
tabPanel(title = "Glossary",
verticalLayout(
titlePanel("Glossary"),
includeHTML("www/glossaryText.html"))),
# data and developer information tabs with tabset -----
tabPanel(
"Developer Info",
tabsetPanel(
# data review and download tab panel ------
tabPanel(title = "Data",
sidebarLayout(
sidebarPanel(width = 3,
selectizeInput("dataset.full", "Choose a dataset:",
choices = datasetsToLoad.desc.complete),
downloadButton('downloadData.full', 'Download'),
includeHTML("www/downloadFullText.html")
),
mainPanel(
titlePanel("Data download"),
DT::dataTableOutput('table')))),
# filesCreated tab panel -----
tabPanel(
title = "Files",
verticalLayout(
titlePanel("Information on file content for developers"),
fluidRow(column(width = 12, div(DT::dataTableOutput("filesCreatedTable"), style = "font-size:80%", family = fontFamily))))),
# IMPACT metadata tab panel -----
tabPanel(title = "Region definitions",
verticalLayout(
titlePanel("Region names and codes"),
fluidRow(column(width = 12, div(DT::dataTableOutput("IMPACTmetadataTable"), style = "font-size:80%", family = fontFamily))))),
# Foodgroup lookup panel -----
tabPanel(title = "Food group lookup table",
verticalLayout(
titlePanel("Food group lookup table"),
fluidRow(column(width = 12, div(DT::dataTableOutput("IMPACTfoodgroupTable"), style = "font-size:80%", family = fontFamily))))),
# nutrient lookup -----
tabPanel(title = "Nutrient lookup table",
verticalLayout(
titlePanel("Nutrient lookup table"),
includeHTML("www/nutrientLookupText.html"),
fluidRow(column(width = 12, div(DT::dataTableOutput("nutrientLookup"), style = "font-size:80%", family = fontFamily))),
downloadButton("downloadData.nutrients.adj", "Download")
)),
# File documentation -----
tabPanel(title = "File documentation",
verticalLayout(
titlePanel("File documentation"),
fluidRow(column(width = 12, div(DT::dataTableOutput("fileDocumentation"), style = "font-size:80%", family = fontFamily))))))),
# Acknowledgements -----
tabPanel(title = "Acknowledgements",
verticalLayout(
includeHTML("www/acknowledgementsText.html"))),
tabPanel(title = "For further information",
verticalLayout(
includeHTML("www/furtherInformation.html")))
)
)
)
)
server <- function(input, output, session) {
# router(input, output)
GlobalData = callModule(GlobalDataModule, "globals")
# load_data(dataSetsToLoad) # load most of the data. Big files can be loaded elsewhere
reqRatio_sum_RDA <- data.table::rbindlist(list(reqRatio_sum_RDA_macro.var, reqRatio_sum_RDA_vits.var, reqRatio_sum_RDA_minrls.var))
# button_UI("first")
countryName <- callModule(country_choice_mod_server, "plot1_vars")
keepListCol <- c("scenario", "region_code.IMPACT159", "year", "pcGDPX0", "budget.PCX0", "incShare.PCX0")
dt.budgetShare[, setdiff(names(dt.budgetShare), keepListCol) := NULL]
dt.budgetShare[, scenario := gsub("-", "_", scenario)]
dt.budgetShare[, scenario := gsub("_REF", "", scenario)] # added for final version of paper Nov 3, 2018
colsToRound <- c("pcGDPX0", "budget.PCX0", "incShare.PCX0")
dt.budgetShare[, (colsToRound) := round(.SD, 2), .SDcols = colsToRound]
new.names <- c("Per Capita GDP", "Food expenditures", "Share of income")
data.table::setnames(dt.budgetShare, old = colsToRound, new = new.names)
dt.budgetShare[, year := gsub("X", "", year)]
dt.budgetShare.long <- data.table::melt(
data = dt.budgetShare,
id.vars = c("scenario", "region_code.IMPACT159", "year"),
measure.vars = new.names,
variable.name = "Variable",
value.name = "value",
variable.factor = FALSE
)
dt.budgetShare.long <- unique(dt.budgetShare.long)
formula.budgetShare <- paste("scenario + region_code.IMPACT159 + Variable ~ year")
dt.budgetShare.wide <- data.table::dcast(
dt.budgetShare.long,
formula = formula.budgetShare,
value.var = "value")
# foodAfford reactive -----
data.afford <- reactive({
countryName <- input$affordabilityCountryName
dt <- copy(dt.budgetShare.wide)
countryCode <- countryCodeLookup(countryName, fileloc("mData"))
dt <- dt[region_code.IMPACT159 %in% countryCode, ]
setnames(dt, old = "region_code.IMPACT159", new = "Country code")
dt[, scenario := factor(scenario, levels = scenarioNames)]
#dt[, scenario := gsub("", "", scenario)]
dt
})
# country name choice observer -----
# observe({
# countryName <- input$userCountryName
# # Can also set the label and select items
# updateSelectizeInput(session, "affordabilityCountryName", selected = countryName)
# updateSelectizeInput(session, "availabilityCountryName", selected = countryName)
# updateSelectizeInput(session, "adequacyCountryName", selected = countryName)
# updateSelectizeInput(session, "nutbalCountryName", selected = countryName)
# updateSelectizeInput(session, "AMDRCountryName", selected = countryName)
# updateSelectizeInput(session, "diversityCountryName", selected = countryName)
# updateSelectizeInput(session, "nonstapleEnergyShareCountryName", selected = countryName)
# updateSelectizeInput(session, "MRVCountryName", selected = countryName)
# updateSelectizeInput(session, "RaosQECountryName", selected = countryName)
# updateSelectizeInput(session, "FGcountryName", selected = countryName)
#
# # scenario choice observer -----
# scenarioName <- input$userScenarioName
# # Can also set the label and select items
# updateSelectizeInput(session, "availabilityScenarioName", selected = scenarioName)
# updateSelectizeInput(session, "adequacyScenarioName", selected = scenarioName)
# updateSelectizeInput(session, "FGscenarioName", selected = scenarioName)
# })
observe({
countryName <- input$userCountryName
# Can also set the label and select items
updateSelectizeInput(session, "affordabilityCountryName", selected = countryName)
updateSelectizeInput(session, "availabilityCountryName", selected = countryName)
updateSelectizeInput(session, "adequacyCountryName", selected = countryName)
updateSelectizeInput(session, "nutbalCountryName", selected = countryName)
updateSelectizeInput(session, "AMDRCountryName", selected = countryName)
updateSelectizeInput(session, "diversityCountryName", selected = countryName)
updateSelectizeInput(session, "nonstapleEnergyShareCountryName", selected = countryName)
updateSelectizeInput(session, "MRVCountryName", selected = countryName)
updateSelectizeInput(session, "RaosQECountryName", selected = countryName)
updateSelectizeInput(session, "FGcountryName", selected = countryName)
# scenario choice observer -----
scenarioName <- input$userScenarioName
# Can also set the label and select items
updateSelectizeInput(session, "availabilityScenarioName", selected = scenarioName)
updateSelectizeInput(session, "adequacyScenarioName", selected = scenarioName)
updateSelectizeInput(session, "FGscenarioName", selected = scenarioName)
})
# food availability reactive -----
data.foodAvail <- reactive({
countryName <- input$availabilityCountryName
scenarioName <- input$availabilityScenarioName
dt <- copy(dt.foodAvail_foodGroup.var)
spiderData <- spiderGraphData3(countryName, dt, displayColumnName = "food_group_code")
})
# food adequacy reactive -----
data.adequacy.tot <- reactive({
countryName <- input$adequacyCountryName
# scenarioName <- input$adequacyScenarioName
reqType <- reqRatio_sum_RDA
# reqType <- reqType[scenario %in% scenarioNames]
dt <- copy(reqType)
spiderData <- spiderGraphData2(countryName, dt, displayColumnName = "nutrient")
})
# food adequacy.macro reactive -----
data.adequacy.macro <- reactive({
countryName <- input$adequacyCountryName
scenarioName <- input$adequacyScenarioName
reqType <- reqRatio_sum_RDA_macro.var
dt <- copy(reqType)
spiderData <- spiderGraphData(countryName, scenarioName, dt, displayColumnName = "nutrient")
})
# food adequacy.vits reactive -----
data.adequacy.vits <- reactive({
countryName <- input$adequacyCountryName
scenarioName <- input$adequacyScenarioName
reqType <- reqRatio_sum_RDA_vits.var
dt <- copy(reqType)
spiderData <- spiderGraphData(countryName, scenarioName, dt, displayColumnName = "nutrient")
})
# food adequacy.minrls reactive -----
data.adequacy.minrls <- reactive({
countryName <- input$adequacyCountryName
scenarioName <- input$adequacyScenarioName
reqType <- reqRatio_sum_RDA_minrls.var
dt <- copy(reqType)
spiderData <- spiderGraphData(countryName, scenarioName, dt, displayColumnName = "nutrient")
})
# energy.quantity reactive -----
data.energy.quantity <- reactive({
countryName <- input$adequacyCountryName
scenarioName <- input$adequacyScenarioName
countryCode <- countryCodeLookup(countryName, fileloc("mData"))
keepListRow <- c("kcalsPerDay_other", "kcalsPerDay_carbohydrate",
"kcalsPerDay_fat", "kcalsPerDay_protein")
dt <- copy(dt.nutrients_kcals.var)
dt <- dt[nutrient %in% keepListRow,]
dt[, value := round(value, 1)][, nutrient := gsub("kcalsPerDay_", "", nutrient)]
spiderData <- graphData(countryName, scenarioName, dt, displayColumnName = "nutrient")
})
# energy.share reactive -----
data.energy.share <- reactive({
countryName <- input$adequacyCountryName
scenarioName <- input$adequacyScenarioName
countryCode <- countryCodeLookup(countryName, fileloc("mData"))
keepListRow <- c("kcalsPerDay_other_share", "kcalsPerDay_carbohydrate_share",
"kcalsPerDay_fat_share", "kcalsPerDay_protein_share")
dt <- copy(dt.nutrients_kcals.var)
dt <- dt[scenario %in% scenarioName & nutrient %in% keepListRow,]
dt[, value := round(value, 1)][, nutrient := gsub("kcalsPerDay_", "", nutrient)][, nutrient := gsub("_share", "", nutrient)]
spiderData <- graphData(countryName, scenarioName, dt, displayColumnName = "nutrient")
})
# nonStaple.share reactive -----
data.nonStaple.share <- reactive({
countryName <- input$nonstapleEnergyShareCountryName
countryCode <- countryCodeLookup(countryName, fileloc("mData"))
dt <- dt.KcalShare_nonstaple.var[region_code.IMPACT159 == countryCode,]
dt[, value := round(value, 2)]
#dt[, scenario := gsub("", "", scenario)]
dt[, year := gsub("X", "", year)]
dt
})
# MRV reactive -----
data.MRV <- reactive({
countryName <- input$MRVCountryName
countryCode <- countryCodeLookup(countryName, fileloc("mData"))
dt <- copy(dt.MRVRatios.var)
dt <- dt[region_code.IMPACT159 %in% countryCode ,]
# setnames(dt, old = "region_code.IMPACT159", new = "Country code")
dt[, value := round(value, 2)]
dt[, year := gsub("X", "", year)]
dt
})
# AMDR reactive -----
data.AMDR <- reactive({
countryName <- input$AMDRCountryName
barData <- barGraphData(countryName, inData = food_agg_AMDR_hi.var)
barData[, scenario := gsub("", "", scenario)][, year := gsub("X", "", year)]
})
# nutAvail reactive -----
data.nutAvailFG <- reactive({
countryName <- input$FGcountryName
scenarioName <- input$FGscenarioName
reqName <- input$nutrientGroup
if (!exists("dt.nutrients_sum_FG.var")) {
withProgress(message = 'Loading data', {
dt.nutrients_sum_FG.var <- getNewestVersion("dt.nutrients_sum_FG.var", fileloc("mData"))
dt.nutrients_sum_FG.var <- (dt.nutrients_sum_FG.var[year %in% years])
dt.nutrients_sum_FG.var <<- dt.nutrients_sum_FG.var[scenario %in% scenarioNames] # <<- should make it available all the time. Nov 11, 2016
incProgress(1)}
)
dt.nutrients_sum_FG.var
}
if (reqName %in% "macronutrients") nutrientGroup <- c("carbohydrate_g", "protein_g", "totalfiber_g", "fat_g")
if (reqName %in% "minerals") nutrientGroup <- c("calcium_mg", "iron_mg", "magnesium_mg", "phosphorus_mg", "potassium_g", "zinc_mg")
if (reqName %in% "vitamins") nutrientGroup <- c("folate_µg", "niacin_mg", "riboflavin_mg", "thiamin_mg", "vit_a_rae_µg", "vit_b6_mg",
"vit_b12_µg", "vit_c_mg", "vit_d_µg", "vit_e_mg", "vit_k_µg")
inData <- copy(dt.nutrients_sum_FG.var)
inData[, year := gsub("X", "", year)]
inData <- inData[nutrient %in% nutrientGroup]
displayColumnName <- "food_group_code" # all these food groups are included in each spidergraph
facetColumnName <- "nutrient" # one spider graph per facetColumnName
spiderData <- facetGraphData(countryName, scenarioName, inData, facetColumnName, displayColumnName)
})
# nutBalScore reactive -----
data.nutBalScore <- reactive({
countryName <- input$nutbalCountryName
countryCode <- countryCodeLookup(countryName, fileloc("mData"))
dt <- copy(dt.nutBalScore.var)
dt[, year := gsub("X", "", year)]
dt <- dt[region_code.IMPACT159 == countryCode,]
dt[, value := round(value, 2)]
formula.wide <- paste("scenario + region_code.IMPACT159 ~ year")
spiderData <- data.table::dcast(
data = dt,
formula = formula.wide,
value.var = "value")
})
# Shannon reactive -----
data.ShannonDiv <- reactive({
countryName <- input$diversityCountryName
countryCode <- countryCodeLookup(countryName, fileloc("mData"))
dt <- copy(dt.shannonDiversity.var)
keepListCol <- c("scenario","region_code.IMPACT159", "year", "SD", "SDnorm")
dt <- dt[, keepListCol, with = FALSE]
dt <- dt[region_code.IMPACT159 == countryCode,][, year := gsub("X", "", year)]
colsToRound <- c("SD", "SDnorm")
dt[, (colsToRound) := round(.SD, 2), .SDcols = colsToRound]
idVars <- c("scenario", "region_code.IMPACT159", "year")
measureVars <- names(dt)[!names(dt) %in% idVars]
dt.long <- data.table::melt(
data = dt,
id.vars = idVars,
measure.vars = measureVars,
variable.name = "Variable",
value.name = "value",
variable.factor = FALSE)
formula.wide <- paste("scenario + region_code.IMPACT159 + Variable ~ year")
dt.wide <- data.table::dcast(
data = dt.long,
formula = formula.wide,
value.var = "value")
dt.wide[, scenario := factor(scenario, levels = scenarioNames)]
dt.wide[, scenario := gsub("", "", scenario)]
})
# RaosQE reactive -----
data.RaosQE <- reactive({
countryName <- input$RaosQECountryName
countryCode <- countryCodeLookup(countryName, fileloc("mData"))
dt <- copy(dt.RAOqe.var)
dt <- dt[region_code.IMPACT159 == countryCode,]
dt[, value := round(value, 2)]
dt[, year := gsub("X", "", year)]
formula.wide <- paste("scenario + region_code.IMPACT159 ~ year")
spiderData <- data.table::dcast(
data = dt,
formula = formula.wide,
value.var = "value")
})
# full data set download reactive -----
datasetInput <- reactive({
get(datasetsToLoad.complete[match(input$dataset.full, datasetsToLoad.desc.complete)])
})
# affordabilityTable -----
output$affordabilityTable <- DT::renderDataTable({
dt <- copy(data.afford())
colsToConvert <- c("2010", "2030", "2050")
dt[, (colsToConvert) := lapply(.SD, sprintf, fmt="%#.2f"), .SDcols = colsToConvert]
dt[, scenario := factor(scenario, levels = scenarioNames)]
dt <- datatable(dt, rownames = FALSE, options = list(pageLength = 20, dom = 'iftp' ,
columnDefs = list(list(className = 'dt-right', targets = 3:5)) # targets start at column 0
))
})
output$downloadData.afford <- downloadHandler(
filename = function() {paste("afford_", "_", input$affordabilityCountryName, Sys.Date(), '.csv', sep = '') },
content = function(file) {write.csv(data.afford(), file)}
)
# availability graph server side -----
output$availabilitySpiderGraphP1 <- renderggiraph({
dt <- copy(data.foodAvail()) # this became a dataframe in the old ggplot2 code. I think I have fixed this. Dec 3, 2018
# scenarioName <- unique(dt$scenario)
data.table::setnames(dt, old = codeNames.foodGroups, new = foodGroupNamesWrap)
p <- spiderGraphOutput(spiderData = dt, nrow = 2)
# ggiraph(code = print(p), zoom_max = 1, selection_type = "single")
})
# availability table server side -----
output$availabilityTableP1 <- DT::renderDataTable({
dt <- as.data.table(copy(data.foodAvail()))
dt <- pivotWideToWideYear(dt)
nutrient <- "food group"
setnames(dt, old = "nutrient_foodGroup", new = nutrient) # new depends on whether dt is for food groups or nutrients
colsToRound <- names(dt)[!names(dt) %in% c("scenario", "region_code.IMPACT159", "year", nutrient)]
dt[,(colsToRound) := round(.SD,2), .SDcols = colsToRound]
data.table::setnames(dt, old = "region_code.IMPACT159", new = "country code")
data.table::setnames(dt, old = names(dt), new = capwords(names(dt)))
colsToConvert <- c("2010", "2030", "2050")
dt[, (colsToConvert) := lapply(.SD, sprintf, fmt="%#.2f"), .SDcols = colsToConvert]
dt <- datatable(dt, rownames = FALSE, options = list(pageLength = 20, dom = 'iftp' ,
columnDefs = list(list(className = 'dt-right', targets = 3:5)) # targets start at column 0
))
})
output$downloadData.avail <- downloadHandler(
filename = function() {paste("foodavail_", "_", input$availabilityCountryName, Sys.Date(), '.csv', sep = '') },
content = function(file) {write.csv(data.foodAvail(), file)}
)
# adequacy graphs server side -----
output$adequacySpiderGraphtot <- renderggiraph({
dt <- as.data.table(copy(data.adequacy.tot()))
# order of nutrients in the spider graph
newOrder <- c("scenario", "region_code.IMPACT159", "nutrientType", "year",
"carbohydrate_g", "protein_g", "totalfiber_g",
"calcium_mg", "iron_mg", "magnesium_mg", "phosphorus_mg", "potassium_g", "zinc_mg",
"folate_µg", "riboflavin_mg", "thiamin_mg",
"vit_a_rae_µg", "vit_b12_µg", "vit_b6_mg", "vit_c_mg", "vit_d_µg", "vit_e_mg", "vit_k_µg")
setcolorder(dt, neworder = newOrder)
scenarioName <- input$adequacyScenarioName
data.table::setnames(dt, old = codeNames.tot, new = nutNamesNoUnitsWrap)
p <- spiderGraphOutput(spiderData = dt, nrow = 2)
# print(p)
})
output$adequacySpiderGraphP1 <- renderPlot({
dt <- as.data.table(copy(data.adequacy.macro()))
scenarioName <- unique(dt$scenario)
data.table::setnames(dt, old = codeNames.macro, new = nutNamesNoUnitsWrap.macro)
p <- spiderGraphOutput(spiderData = dt, scenarioName)
print(p)
})
output$adequacySpiderGraphP2 <- renderPlot({
dt <- as.data.table(copy(data.adequacy.vits()))
scenarioName <- unique(dt$scenario)
data.table::setnames(dt, old = codeNames.vits, new = nutNamesNoUnitsWrap.vits)
p <- spiderGraphOutput(spiderData = dt, scenarioName)
print(p)
})
output$adequacySpiderGraphP3 <- renderPlot({
dt <- as.data.table(copy(data.adequacy.minrls()))
scenarioName <- unique(dt$scenario)
#dt[, scenario := gsub("", "", scenario)]
# data.table::setnames(dt, old = names(dt), new = capwords(names(dt)))
data.table::setnames(dt, old = codeNames.minrls, new = nutNamesNoUnitsWrap.minrls)
p <- spiderGraphOutput(dt, scenarioName)
print(p)
})
# adequacy tables server side -----
output$adequacyTableP1 <- DT::renderDataTable({
dt <- as.data.table(copy(data.adequacy.macro()))
dt <- pivotWideToWideYear(dt)
nutrient <- "nutrient"
data.table::setnames(dt, old = "nutrient_foodGroup", new = nutrient) # new depends on whether dt is for food groups or nutrients
data.table::setnames(dt, old = "region_code.IMPACT159", new = "country code")
data.table::setnames(dt, old = names(dt), new = capwords(names(dt)))
colsToConvert <- c("2010", "2030", "2050")
dt[, (colsToConvert) := lapply(.SD, sprintf, fmt="%#.2f"), .SDcols = colsToConvert]
dt <- datatable(dt, rownames = FALSE, options = list(pageLength = 20, dom = 'iftp' ,
columnDefs = list(list(className = 'dt-right', targets = 3:5)) # targets start at column 0
))
})
output$adequacyTableTot <- DT::renderDataTable({
dt <- as.data.table(copy(data.adequacy.tot()))
newOrder <- c("scenario", "region_code.IMPACT159", "nutrientType", "year",
"carbohydrate_g", "protein_g", "totalfiber_g",
"calcium_mg", "iron_mg", "magnesium_mg", "phosphorus_mg", "potassium_g", "zinc_mg",
"folate_µg", "riboflavin_mg", "thiamin_mg",
"vit_a_rae_µg", "vit_b12_µg", "vit_b6_mg", "vit_c_mg", "vit_d_µg", "vit_e_mg", "vit_k_µg")
setcolorder(dt, neworder = newOrder)
dt <- pivotWideToWideYear(dt)
nutrient <- "nutrient"
data.table::setnames(dt, old = "nutrient_foodGroup", new = nutrient) # new depends on whether dt is for food groups or nutrients
data.table::setnames(dt, old = "region_code.IMPACT159", new = "country code")
data.table::setnames(dt, old = names(dt), new = capwords(names(dt)))
colsToConvert <- c("2010", "2030", "2050")
dt[, (colsToConvert) := lapply(.SD, sprintf, fmt="%#.2f"), .SDcols = colsToConvert]
dt <- datatable(dt, rownames = FALSE, options = list(pageLength = 20, dom = 'iftp' ,
columnDefs = list(list(className = 'dt-right', targets = 3:5)) # targets start at column 0
))
})
output$downloadData.adequacy.macro <- downloadHandler(
filename = function() {paste("adeq_macro_", input$adequacyCountryName, "_", Sys.Date(), '.csv', sep = '') },
content = function(file) {write.csv(data.adequacy.macro(), file)}
)
output$adequacyTableP2 <- DT::renderDataTable({
dt <- as.data.table(copy(data.adequacy.vits()))
dt <- pivotWideToWideYear(dt)
nutrient <- "nutrient"
data.table::setnames(dt, old = "nutrient_foodGroup", new = nutrient) # new depends on whether dt is for food groups or nutrients
data.table::setnames(dt, old = "region_code.IMPACT159", new = "country code")
data.table::setnames(dt, old = names(dt), new = capwords(names(dt)))
colsToConvert <- c("2010", "2030", "2050")
dt[, (colsToConvert) := lapply(.SD, sprintf, fmt="%#.2f"), .SDcols = colsToConvert]
dt <- datatable(dt, rownames = FALSE, options = list(pageLength = 20, dom = 'iftp' ,
columnDefs = list(list(className = 'dt-right', targets = 3:5)) # targets start at column 0
))
})
output$downloadData.adequacy.vits <- downloadHandler(
filename = function() {paste("adeq_vits_", input$adequacyCountryName, "_", Sys.Date(), '.csv', sep = '') },
content = function(file) {write.csv(data.adequacy.vits(), file)}
)
output$adequacyTableP3 <- DT::renderDataTable({
dt <- copy(data.adequacy.minrls())
dt <- pivotWideToWideYear(dt)
nutrient <- "nutrient"
data.table::setnames(dt, old = "nutrient_foodGroup", new = nutrient) # new depends on whether dt is for food groups or nutrients
data.table::setnames(dt, old = "region_code.IMPACT159", new = "country code")
data.table::setnames(dt, old = names(dt), new = capwords(names(dt)))
colsToConvert <- c("2010", "2030", "2050")
dt[, (colsToConvert) := lapply(.SD, sprintf, fmt="%#.2f"), .SDcols = colsToConvert]
dt <- datatable(dt, rownames = FALSE, options = list(pageLength = 20, dom = 'iftp' ,
columnDefs = list(list(className = 'dt-right', targets = 3:5)) # targets start at column 0
))
})
output$downloadData.adequacy.minrls <- downloadHandler(
filename = function() {paste("adeq_minrls_", input$adequacyCountryName, "_", Sys.Date(), '.csv', sep = '') },
content = function(file) {write.csv(data.adequacy.minrls(), file)}
)
# energy ratio bar chart -----
output$energyShareBarPlot <- renderPlot({
dt <- copy(data.energy.share())
scenarioName <- unique(dt$scenario)
countryCode <- unique(dt$region_code.IMPACT159)
countryName <- countryNameLookup(countryCode)
titleText <- paste("Share of total kilocalories by macronutrient\n", "Country: ", countryName, "Scenario: ", scenarioName)
yLab <- "(percent)"
p <- ggplot(dt, aes(x = year, y = value, tooltip = value, fill = nutrient, order = c("region_name") )) +
geom_bar_interactive(stat = "identity") +
theme(axis.title.y = element_text(family = fontFamily, face = "plain"))
p <- p + theme(plot.title = element_text(hjust = 0.5, size = 10, family = fontFamily,
face = "plain")) + ggtitle(titleText)
p <- p + theme(axis.text = element_text(size = 10, family = fontFamily, face = "plain"))
p <- p + theme(legend.text = element_text(size = 10, family = fontFamily, face = "plain")) +
labs(y = yLab, x = NULL)
print(p)
})
# energy quantity bar chart -----
output$energyQuantityBarPlot <- renderPlot({
dt <- copy(data.energy.quantity())
scenarioName <- unique(dt$scenario)
countryCode <- unique(dt$region_code.IMPACT159)
countryName <- countryNameLookup(countryCode)
# colors_in <- c( "gray", "green", "blue", "red", "yellow" )
titleText <- paste("Average daily kilocalory availability\n", countryName,", Scenario:", scenarioName)
yLab <- "(kcals)"
p <- ggplot(dt, aes(x = year, y = value, tooltip = value, fill = nutrient, order = c("region_name") )) +
geom_bar_interactive(stat = "identity") +
theme(axis.title.y = element_text(family = fontFamily, face = "plain"))
p <- p + theme(plot.title = element_text(hjust = 0.5, size = 10, family = fontFamily,
face = "plain")) + ggtitle(titleText)
p <- p + theme(axis.text = element_text(size = 10, family = fontFamily, face = "plain"))
p <- p + theme(legend.text = element_text(size = 10, family = fontFamily, face = "plain")) +
labs(y = yLab, x = NULL)
print(p)
})
# energy share table -----
output$energyShareTable <- DT::renderDataTable({
dt.long <- copy(data.energy.share())
formula.wide <- paste("scenario + region_code.IMPACT159 + nutrient ~ year")
dt <- data.table::dcast(
data = dt.long,
formula = formula.wide,
value.var = "value")
nutrient <- "share of total energy"
data.table::setnames(dt, old = "nutrient", new = nutrient) # new depends on whether dt is for food groups or nutrients
data.table::setnames(dt, old = "region_code.IMPACT159", new = "country code")
data.table::setnames(dt, old = names(dt), new = capwords(names(dt)))
colsToConvert <- c("2010", "2030", "2050")
dt[, (colsToConvert) := lapply(.SD, sprintf, fmt="%#.2f"), .SDcols = colsToConvert]
dt <- datatable(dt, rownames = FALSE, options = list(pageLength = 20, dom = 'iftp' ,
columnDefs = list(list(className = 'dt-right', targets = 3:5)) # targets start at column 0
))
})
output$downloadData.energyRat <- downloadHandler(
filename = function() {paste("energyRatio", input$adequacyCountryName, "_", Sys.Date(), '.csv', sep = '') },
content = function(file) {write.csv(data.energy.share(), file)}
)
# energy quantity table -----
output$energyQuantityTable <- DT::renderDataTable({
dt.long <- copy(data.energy.quantity())
formula.wide <- paste("scenario + region_code.IMPACT159 + nutrient ~ year")
dt <- data.table::dcast(
data = dt.long,
formula = formula.wide,
value.var = "value")
nutrient <- "Kilocalories"
data.table::setnames(dt, old = "nutrient", new = nutrient) # new depends on whether dt is for food groups or nutrients
data.table::setnames(dt, old = "region_code.IMPACT159", new = "country code")
data.table::setnames(dt, old = names(dt), new = capwords(names(dt)))
colsToConvert <- c("2010", "2030", "2050")
dt[, (colsToConvert) := lapply(.SD, sprintf, fmt="%#.2f"), .SDcols = colsToConvert]
dt <- datatable(dt, rownames = FALSE, options = list(pageLength = 20, dom = 'iftp' ,
columnDefs = list(list(className = 'dt-right', targets = 3:5)) # targets start at column 0
))
})
output$downloadData.energyQ <- downloadHandler(
filename = function() {paste("energyQ", input$adequacyCountryName, "_", Sys.Date(), '.csv', sep = '') },
content = function(file) {write.csv(data.energy.quantity(), file)}
)
# adequacy AMDR graph server side ------
output$AMDRbarGraphP1 <- renderggiraph({
dt <- copy(data.AMDR())
p <- plotByRegionBarAMDRinShiny(barData = dt, yLab = "share of total dietary energy (percent)")
ggiraph(code = print(p), zoom_max = 1, selection_type = "single")
})
# adequacy AMDR table server side ------
output$AMDRTableP1 <- DT::renderDataTable({
dt <- copy(data.AMDR())
oldnames <- c("carbohydrate_g.kcalpercent", "fat_g.kcalpercent", "protein_g.kcalpercent")
newnames <- c("carbohydrate", "protein", "fat")
data.table::setnames(dt, old = oldnames, new = newnames)
dt <- pivotWideToWideYear(dt)
oldnames <- c("region_code.IMPACT159", "nutrient_foodGroup")
newnames <- c("Country Code", "Nutrient")
data.table::setnames(dt, old = oldnames, new = newnames)
colsToConvert <- c("2010", "2030", "2050")
dt[, (colsToConvert) := lapply(.SD, sprintf, fmt="%#.2f"), .SDcols = colsToConvert]
dt[, scenario := factor(scenario, levels = scenarioNames)]
dt <- datatable(dt, rownames = FALSE, options = list(pageLength = 20, dom = 'iftp' ,
columnDefs = list(list(className = 'dt-right', targets = 3:5)) # targets start at column 0
))
})
output$downloadData.AMDR <- downloadHandler(
filename = function() {paste("AMDR_", input$AMDRCountryName, "_", Sys.Date(), '.csv', sep = '') },
content = function(file) {write.csv(data.AMDR(), file)}
)
# adequacy nutrient balance table server side ------
output$nutbalTableP1 <- DT::renderDataTable({
dt <- data.nutBalScore()
data.table::setnames(dt, old = "region_code.IMPACT159", new = "country code")
data.table::setnames(dt, old = names(dt), new = capwords(names(dt)))
colsToConvert <- c("2010", "2030", "2050")
dt[, (colsToConvert) := lapply(.SD, sprintf, fmt="%#.2f"), .SDcols = colsToConvert]
dt <- datatable(dt, rownames = FALSE, options = list(pageLength = 20, dom = 'iftp' ,
columnDefs = list(list(className = 'dt-right', targets = 2:4)) # targets start at column 0
))
})
output$downloadData.nutbal <- downloadHandler(
filename = function() {paste("nutbal_", input$nutbalCountryName, "_", Sys.Date(), '.csv', sep = '') },
content = function(file) {write.csv(data.nutBalScore(), file)}
)
# adequacy MRV table server side ------
output$MRVTableP1 <- DT::renderDataTable({
dt <- copy(data.MRV())
dt[,value := round(value, 2)]
formula.wide <- paste("scenario + region_code.IMPACT159 + nutrient ~ year")
dt <- data.table::dcast(
data = dt,
formula = formula.wide,
value.var = "value")
data.table::setnames(dt, old = "region_code.IMPACT159", new = "country code")
dt[, nutrient := capwords(cleanupNutrientNames(nutrient))]
colsToConvert <- c("2010", "2030", "2050")
dt[, (colsToConvert) := lapply(.SD, sprintf, fmt="%#.2f"), .SDcols = colsToConvert]
dt[, scenario := factor(scenario, levels = scenarioNames)]
dt <- datatable(dt, rownames = FALSE, options = list(pageLength = 20, dom = 'iftp' ,
columnDefs = list(list(className = 'dt-right', targets = 3:5)) # targets start at column 0
))
})
output$downloadData.MRV <- downloadHandler(
filename = function() {paste("MRV", input$MRVCountryName, "_", Sys.Date(), '.csv', sep = '') },
content = function(file) {write.csv(data.MRV(), file)}
)
# nonstaple share diversity metrics -----
output$nonStapleEnergyShareTable <- DT::renderDataTable({
dt <- copy(data.nonStaple.share())
formula.wide <- paste("scenario + region_code.IMPACT159 ~ year")
dt <- data.table::dcast(
data = dt,
formula = formula.wide,
value.var = "value")
colsToRound <- names(dt)[!names(dt) %in% c("scenario", "region_code.IMPACT159", "year")]
dt[,(colsToRound) := round(.SD,2), .SDcols = colsToRound]
data.table::setnames(dt, old = "region_code.IMPACT159", new = "country code")
data.table::setnames(dt, old = names(dt), new = capwords(names(dt)))
colsToConvert <- c("2010", "2030", "2050")
dt[, (colsToConvert) := lapply(.SD, sprintf, fmt="%#.2f"), .SDcols = colsToConvert]
dt <- datatable(dt, rownames = FALSE, options = list(pageLength = 20, dom = 'iftp' ,
columnDefs = list(list(className = 'dt-right', targets = 2:4)) # targets start at column 0
))
})
output$downloadData.nonStapleShare <- downloadHandler(
filename = function() {paste("nonStapleShare_", input$nonstapleEnergyShareCountryName, "_", Sys.Date(), '.csv', sep = '') },
content = function(file) {write.csv(data.nonStaple.share(), file)}
)
# Rao's QE metric -----
output$RaosQETable <- DT::renderDataTable({
dt <- copy(data.RaosQE())
formula.wide <- paste("year + region_code.IMPACT159 ~ scenario")
colsToRound <- names(dt)[!names(dt) %in% c("scenario", "region_code.IMPACT159", "year")]
dt[,(colsToRound) := round(.SD,2), .SDcols = colsToRound]
data.table::setnames(dt, old = "region_code.IMPACT159", new = "country code")
data.table::setnames(dt, old = names(dt), new = capwords(names(dt)))
colsToConvert <- c("2010", "2030", "2050")
dt[, (colsToConvert) := lapply(.SD, sprintf, fmt="%#.2f"), .SDcols = colsToConvert]
dt <- datatable(dt, rownames = FALSE, options = list(pageLength = 20, dom = 'iftp' ,
columnDefs = list(list(className = 'dt-right', targets = 2:4)) # targets start at column 0
))
})
output$downloadData.RaoQE <- downloadHandler(
filename = function() {paste("RaosQE_", input$input$RaosQECountryName, "_", Sys.Date(), '.csv', sep = '') },
content = function(file) {write.csv(data.RaosQE(), file)}
)
# Shannon diversityTable -----
output$diversityTable <- DT::renderDataTable({
dt <- copy(data.ShannonDiv())
colsToRound <- names(dt)[!names(dt) %in% c("scenario", "region_code.IMPACT159", "year", "Variable")]
dt[,(colsToRound) := round(.SD,2), .SDcols = colsToRound]
data.table::setnames(dt, old = "region_code.IMPACT159", new = "country code")
oldNames <- names(dt)
newNames <- gsub("_", " \n", oldNames)
setnames(dt, old = oldNames, new = newNames)
data.table::setnames(dt, old = names(dt), new = capwords(names(dt)))
colsToConvert <- c("2010", "2030", "2050")
dt[, (colsToConvert) := lapply(.SD, sprintf, fmt="%#.2f"), .SDcols = colsToConvert]
dt <- datatable(dt, rownames = FALSE, options = list(pageLength = 20, dom = 'iftp' ,
columnDefs = list(list(className = 'dt-right', targets = 3:5)) # targets start at column 0
))
})
output$downloadData.ShannonDiversity <- downloadHandler(
filename = function() {paste("Shannon_", input$diversityCountryName, "_", Sys.Date(), '.csv', sep = '') },
content = function(file) {write.csv(data.ShannonDiv(), file)}
)
# nutrient avail, FG horizontal graphs -----
output$NutAvailFGbarGraphP1 <- renderPlot({
dt <- copy(data.nutAvailFG())
displayColumnName <- "food_group_code" # all these food groups are included in each bar chart
facetColumnName <- "nutrient" # one spider graph per facetColumnName
p <- facetGraphOutput(inData = dt, facetColumnName, displayColumnName, codeNames.foodGroups, foodGroupNamesNoWrap)
p
}, height = "auto")
output$plot.NutAvailFGbarGraphP1 <- renderUI({
if (input$nutrientGroup == "vitamins") plotHeight = "800px"
if (input$nutrientGroup == "macronutrients") plotHeight = "500px"
if (input$nutrientGroup == "minerals") plotHeight = "500px"
plotOutput("NutAvailFGbarGraphP1", width = "100%", height = plotHeight)
})
# nutrient diversity FG Table -----
output$NutAvailFGTable <- DT::renderDataTable({
dt <- copy(data.nutAvailFG())
displayColumnName <- "food_group_code" # all these food groups are included in each spidergraph
facetColumnName <- "nutrient" # one bar graph per facetColumnName
formula.wide <- sprintf("scenario + region_code.IMPACT159 + %s + %s ~ year", facetColumnName, displayColumnName)
dt <- data.table::dcast(data = dt, formula = formula.wide, value.var = "value")
data.table::setnames(dt, old = "region_code.IMPACT159", new = "country code")
names.new <- cleanupNutrientNames(names(dt))
if (facetColumnName %in% "nutrient") dt[, nutrient := capwords(cleanupNutrientNames(nutrient))]
data.table::setnames(dt, old = names(dt), new = capwords(names.new))
colsToConvert <- c("2010", "2030", "2050")
dt[, (colsToConvert) := lapply(.SD, sprintf, fmt="%#.2f"), .SDcols = colsToConvert]
dt <- DT::datatable(dt, rownames = FALSE, options = list(pageLength = 25, dom = 'iftp',
columnDefs = list(list(className = 'dt-right', targets = 4:6)) # targets start at column 0
))
})
output$downloaddata.nutAvailFG <- downloadHandler(
filename = function() {paste("nutDiv_", "_", input$FGcountryName, Sys.Date(), '.csv', sep = '') },
content = function(file) {write.csv(data.nutAvailFG(), file)}
)
#view and download data ------
output$table <- DT::renderDataTable({
dt <- datasetInput()
currentDT <- datasetsToLoad.complete[match(input$dataset.full, datasetsToLoad.desc.complete)]
valueDTNames <- paste0(c( "dt.foodAvail_foodGroup", "dt.nutrients_kcals",
"reqRatio_sum_RDA_macro", "reqRatio_sum_RDA_vits", "reqRatio_sum_RDA_minrls",
"dt.nutBalScore", "dt.MRVRatios", "dt.KcalShare_nonstaple", "dt.RAOqe"), ".var")
setnames(dt, old = "region_code.IMPACT159", new = "Country code")
if (!currentDT %in% valueDTNames) {
dt <- DT::datatable(dt, rownames = FALSE, options = list(pageLength = 25))
}else{
dt <- DT::datatable(dt, rownames = FALSE, options = list(pageLength = 25)) %>% formatRound('value', 3)
}
})
output$table <- DT::renderDataTable({
dt <- datasetInput()
currentDT <- datasetsToLoad.complete[match(input$dataset.full, datasetsToLoad.desc.complete)]
valueDTNames <- paste0(c( "dt.foodAvail_foodGroup", "dt.nutrients_kcals",
"reqRatio_sum_RDA_macro", "reqRatio_sum_RDA_vits", "reqRatio_sum_RDA_minrls",
"dt.nutBalScore", "dt.MRVRatios", "dt.KcalShare_nonstaple", "dt.RAOqe"), ".var")
setnames(dt, old = "region_code.IMPACT159", new = "Country code")
if (!currentDT %in% valueDTNames) {
dt <- DT::datatable(dt, rownames = FALSE, options = list(pageLength = 25))
}else{
dt <- DT::datatable(dt, rownames = FALSE, options = list(pageLength = 25)) %>% formatRound('value', 3)
}
})
output$downloadData.full <- downloadHandler(
filename = function() { paste(input$dataset.full, "_", Sys.Date(), '.gz', sep = '') },
content = function(file) {
write.csv(datasetInput(), file = gzfile(file))}
)
# metadataTable ------
output$metadataTable <- DT::renderDataTable({
dt <- getNewestVersion("filesCreated", fileloc("mData"))
dt <- DT::datatable(dt, rownames = FALSE, options = list(pageLength = 25))
})
# scriptInfoTable ------
output$metadataTable <- DT::renderDataTable({
dt <- getNewestVersion("scriptInfo", fileloc("mData"))
dt <- DT::datatable(dt, rownames = FALSE, options = list(pageLength = 25))
})
# IMPACTmetadataTable ------
output$IMPACTmetadataTable <- DT::renderDataTable({
# dt <- getNewestVersion("dt.IMPACTgdxParams", fileloc("mData"))
dt <- DT::datatable(dt, rownames = FALSE, options = list(pageLength = 25))
})
# IMPACTfoodgroupLookupTable ------
output$IMPACTfoodgroupTable <- DT::renderDataTable({
data.table::setnames(dt.foodGroupsInfo, old = names(dt.foodGroupsInfo), new = gsub("_", " ", names(dt.foodGroupsInfo)))
dt <- dt.foodGroupsInfo[,1:5]
dt <- DT::datatable(dt, rownames = FALSE, options = list(pageLength = 25))
dt
})
# nutrient lookup -----
output$nutrientLookup <- DT::renderDataTable({
dt <- getNewestVersion("dt.nutrients.var", fileloc("mData"))
# dt[, ft_acds_tot_trans_g := as.numeric(ft_acds_tot_trans_g)] #dt.nutrients.var comes in as chr because one entry is "ph (Aug 10, 2018); fixed Aug 12, 2018
colsNotNumeric <- c("IMPACT_code", "region_code.IMPACT159", "food_group_code", "staple_code")
colsToRound3 <- names(dt)[!names(dt) %in% colsNotNumeric]
colsToRound0 <- c("magnesium_mg", "phosphorus_mg", "ethanol_g", "caffeine_mg", "cholesterol_mg",
"ethanol_g_cr", "calcium_mg_cr", "iron_mg_cr", "magnesium_mg_cr", "phosphorus_mg_cr",
"potassium_g_cr", "zinc_mg_cr", "vit_a_rae_µg_cr", "vit_c_mg_cr", "thiamin_mg_cr",
"riboflavin_mg_cr", "niacin_mg_cr", "vit_b6_mg_cr", "vit_b12_µg_cr", "folate_µg_cr",
"vit_e_mg_cr")
dt[, (colsToRound3) := round(.SD, 3), .SDcols = colsToRound3]
dt[, (colsToRound0) := round(.SD, 0), .SDcols = colsToRound0]
dt <- DT::datatable(dt, rownames = FALSE, options = list(pageLength = 25))
dt
})
output$downloadData.nutrients.adj <- downloadHandler(
filename = function() {paste("dt.nutrients.adj_", Sys.Date(), '.csv', sep = '') },
content = function(file) {write.csv(dt.nutrients.adj, file)}
)
# file documentation -----
output$fileDocumentation <- DT::renderDataTable({
dt <- getNewestVersion("resultFileLookup", fileloc("mData"))
# dt <- getNewestVersion("dt.metadataTot", fileloc("mData"))
dt <- DT::datatable(dt, rownames = FALSE, options = list(pageLength = 25))
dt
})
output$info <- renderText({
xy_str <- function(e) {
if(is.null(e)) return("NULL\n")
paste0("x=", round(e$x, 1), " y=", round(e$y, 1), "\n")
}
xy_range_str <- function(e) {
if(is.null(e)) return("NULL\n")
paste0("xmin=", round(e$xmin, 1), " xmax=", round(e$xmax, 1),
" ymin=", round(e$ymin, 1), " ymax=", round(e$ymax, 1))
}
paste0(
"click: ", xy_str(input$plot_click),
"dblclick: ", xy_str(input$plot_dblclick),
"hover: ", xy_str(input$plot_hover),
"brush: ", xy_range_str(input$plot_brush)
)
})
session$onSessionEnded(stopApp)
}
# Run the application -----
shinyApp(ui = ui, server = server)
GeraldCNelson/nutmod documentation built on May 8, 2023, 8:04 a.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
#' Shiny app for the nutrient modelling results
#' title: "Shiny app for the nutrient modelling results"
#' @keywords shiny app
#' @name app.R
#' @author Gerald C. Nelson, \\email{nelson.gerald.c@@gmail.com}
#' @description
#' This script contains the shiny app for the nutrient modeling website
#Copyright (C) 2015-2018 Gerald C,Nelson, except where noted
# This program is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE, See the
# GNU General Public License for more details at http://www.gnu.org/licenses/.
# To make sure data and script files are up to date, first run copyFilestoNutrientModeling.R
# This is a Shiny web application. You can run the application by clicking
# the 'Run App' button in RStudio
source("global.R") # load all the background functions and packages
source("globaldata.R")
source("modules.R")
#note install packages feature in global.R is commented out
source("initializationValues.R")
# Define UI -----
ui <- fluidPage(
theme = shinytheme("lumen"),
title = "Nutrient modeling",
# router_ui(),
useShinyjs(debug = TRUE),
div(
id = "loading_page",
includeHTML("www/introText.html")
),
hidden( # used to make the tabs not appear until the data sets are finished loading
div(id = "mainTabsetPanel",
tabsetPanel(
# Introduction tab panel -----
tabPanel(title = "Introduction",
sidebarLayout(
sidebarPanel( width = 3,
includeHTML("www/countryChoice.html"),
# button_UI("first"),
# button_selectize("first"),
country_choice_mod_ui("countryName"),
selectizeInput(inputId = "userCountryName", label = "Choose country", choices = countryNames, selected = NULL),
selectizeInput(inputId = "userScenarioName", label = "Choose scenario", choices = scenarioNames, selected = initialScenarioName)),
mainPanel(includeHTML("www/introText.html")))),
# Affordability tab panel ------
tabPanel(title = "Affordability",
sidebarLayout(
sidebarPanel(width = 3,
selectizeInput(inputId = "affordabilityCountryName", label = "Choose country", choices = countryNames,
options = list(placeholder = "Select country")),
downloadButton("downloadData.afford", "Download")),
mainPanel(titlePanel("Food expenditure, per capita income and affordability"),
includeHTML("www/affordabilityText.html"),
DT::dataTableOutput("affordabilityTable"),
includeHTML("www/tableNote_affordability.html")))),
# food availability tab panel ------
tabPanel(title = "Food Availability",
verticalLayout(
titlePanel("Average daily food availability by food group"),
includeHTML("www/availabilityText.html"),
selectizeInput(inputId = "availabilityCountryName", label = "Choose country",
choices = countryNames,
options = list(placeholder = "Select country")),
ggiraphOutput("availabilitySpiderGraphP1", height = "700px"),
DT::dataTableOutput("availabilityTableP1"),
downloadButton("downloadData.avail", "Download")
)),
# nutrient availability by food group tab panel ------
tabPanel(title = "Nutrient availability",
sidebarLayout(
sidebarPanel(width = 3,
selectizeInput(inputId = "FGcountryName", label = "Choose country", choices = countryNames),
selectizeInput(inputId = "nutrientGroup", label = "Choose a nutrient group", choices = c("vitamins", "minerals", "macronutrients")),
downloadButton("downloadData.nutAvailFG", "Download")),
mainPanel(titlePanel("Nutrient availability"),
includeHTML("www/foodGroupSpiderGraphText.html"),
div(radioButtons("FGscenarioName", "Choose scenario (See glossary for details):",
list("SSP2_NoCC", "SSP2_HGEM", "SSP1_NoCC", "SSP3_NoCC"), inline = TRUE), style = "display:center-align"),
uiOutput("plot.NutAvailFGbarGraphP1"),
DT::dataTableOutput("NutAvailFGTable"),
includeHTML("www/nutrientDescription.html")))),
#nutrient adequacy tab panel -----
tabPanel(title = "Nutrient Adequacy",
verticalLayout(
titlePanel("Nutrient adequacy and kilocalorie availability"),
includeHTML("www/adequacyText.html"),
selectizeInput(inputId = "adequacyCountryName", label = "Choose country", choices = countryNames),
column(width = 12, ggiraphOutput("adequacySpiderGraphtot", height = "700px")),
fluidRow(
column(width = 2, radioButtons("adequacyScenarioName", "Choose scenario",
list("SSP2_NoCC", "SSP2_HGEM", "SSP1_NoCC", "SSP3_NoCC"), inline = TRUE)),
column(width = 5, plotOutput("energyQuantityBarPlot", height = "200px")),
column(width = 5, plotOutput("energyShareBarPlot", height = "200px"))),
fluidRow(
column(width = 12, DT::dataTableOutput("adequacyTableTot"))),
fluidRow(
column(width = 12, DT::dataTableOutput("energyQuantityTable"))),
fluidRow(
column(width = 12, DT::dataTableOutput("energyShareTable"))),
fluidRow(
column(width = 2, downloadButton("downloadData.adequacy.macro", "Macro")),
column(width = 2, downloadButton("downloadData.adequacy.vits", "Vitamins")),
column(width = 2, downloadButton("downloadData.adequacy.minrls", "Minerals")),
column(width = 2, downloadButton("downloadData.energyRat", "Energy share")),
column(width = 2, downloadButton("downloadData.energyQ", "Kcals"))
)
)),
# Nutrient quality tab panel ------
tabPanel(title = "Nutrient Quality",
tabsetPanel(
# AMDR tab panel -----
tabPanel(title = "Acceptable Macronutrient Distribution Range (AMDR)",
sidebarLayout(
sidebarPanel(width = 3,
selectizeInput(inputId = "AMDRCountryName", label = "Choose country", choices = countryNames),
downloadButton("downloadData.AMDR", "Download")),
mainPanel(titlePanel("Acceptable Macronutrient Distribution Range (AMDR)"),
includeHTML("www/AMDRText.html"),
fluidRow(column(width = 12, ggiraphOutput("AMDRbarGraphP1"))),
fluidRow(column(width = 12, DT::dataTableOutput("AMDRTableP1"))),
includeHTML("www/tableNote_AMDR.html")))),
# nutrient balance tab panel -----
tabPanel(title = "Nutrient Balance Score",
sidebarLayout(
sidebarPanel(width = 3,
selectizeInput(inputId = "nutbalCountryName", label = "Choose country", choices = countryNames),
downloadButton("downloadData.nutbal", "Download")),
mainPanel(titlePanel("Nutrient Balance Score"),
includeHTML("www/nutbalGraphText.html"),
DT::dataTableOutput("nutbalTableP1")))),
# MRV tab panel -----
tabPanel(title = "Maximum Recommended Intake",
sidebarLayout(
sidebarPanel(width = 3,
selectizeInput(inputId = "MRVCountryName", label = "Choose country", choices = countryNames),
downloadButton("downloadData.MRV", "Download")),
mainPanel(titlePanel("Maximum Recommended Intake (MRV) ratios"),
includeHTML("www/MRVText.html"),
DT::dataTableOutput("MRVTableP1")))))), # added style='width: 1000px; height: 1000px' to try to reduce LR margins
# Diversity tab panel, with tabset ------
tabPanel("Dietary diversity",
tabsetPanel(
# Shannon diversity tab panel ------
tabPanel(title = "Shannon diversity index",
sidebarLayout(
sidebarPanel(width = 3,
selectizeInput(inputId = "diversityCountryName", label = "Choose country", choices = countryNames),
downloadButton("downloadData.ShannonDiversity", "Download")),
mainPanel(titlePanel("Shannon diversity index"),
includeHTML("www/shannonDiversityText.html"),
DT::dataTableOutput("diversityTable")))),
# nonstaple energy share tab panel ------
tabPanel(title = "Nonstaple share of dietary energy",
sidebarLayout(
sidebarPanel(width = 3,
selectizeInput(inputId = "nonstapleEnergyShareCountryName", label = "Choose country", choices = countryNames),
downloadButton("downloadData.nonStapleShare", "Download")),
mainPanel(
titlePanel("Nonstaple share of dietary energy"),
includeHTML("www/nonStapleShareGraphText.html"),
DT::dataTableOutput("nonStapleEnergyShareTable"),
includeHTML("www/tableNote_nonstapleShare.html")))),
# Rao's QE tab panel ------
tabPanel(title = "Rao's quadratic entropy metric",
sidebarLayout(
sidebarPanel(width = 3,
selectizeInput(inputId = "RaosQECountryName", label = "Choose country", choices = countryNames),
downloadButton("downloadData.RaoQE", "Download")),
mainPanel(
titlePanel("Rao's quadratic entropy metric"),
includeHTML("www/RaosQEGraphText.html"),
DT::dataTableOutput("RaosQETable")))))),
# glossary tab panel ------
tabPanel(title = "Glossary",
verticalLayout(
titlePanel("Glossary"),
includeHTML("www/glossaryText.html"))),
# data and developer information tabs with tabset -----
tabPanel(
"Developer Info",
tabsetPanel(
# data review and download tab panel ------
tabPanel(title = "Data",
sidebarLayout(
sidebarPanel(width = 3,
selectizeInput("dataset.full", "Choose a dataset:",
choices = datasetsToLoad.desc.complete),
downloadButton('downloadData.full', 'Download'),
includeHTML("www/downloadFullText.html")
),
mainPanel(
titlePanel("Data download"),
DT::dataTableOutput('table')))),
# filesCreated tab panel -----
tabPanel(
title = "Files",
verticalLayout(
titlePanel("Information on file content for developers"),
fluidRow(column(width = 12, div(DT::dataTableOutput("filesCreatedTable"), style = "font-size:80%", family = fontFamily))))),
# IMPACT metadata tab panel -----
tabPanel(title = "Region definitions",
verticalLayout(
titlePanel("Region names and codes"),
fluidRow(column(width = 12, div(DT::dataTableOutput("IMPACTmetadataTable"), style = "font-size:80%", family = fontFamily))))),
# Foodgroup lookup panel -----
tabPanel(title = "Food group lookup table",
verticalLayout(
titlePanel("Food group lookup table"),
fluidRow(column(width = 12, div(DT::dataTableOutput("IMPACTfoodgroupTable"), style = "font-size:80%", family = fontFamily))))),
# nutrient lookup -----
tabPanel(title = "Nutrient lookup table",
verticalLayout(
titlePanel("Nutrient lookup table"),
includeHTML("www/nutrientLookupText.html"),
fluidRow(column(width = 12, div(DT::dataTableOutput("nutrientLookup"), style = "font-size:80%", family = fontFamily))),
downloadButton("downloadData.nutrients.adj", "Download")
)),
# File documentation -----
tabPanel(title = "File documentation",
verticalLayout(
titlePanel("File documentation"),
fluidRow(column(width = 12, div(DT::dataTableOutput("fileDocumentation"), style = "font-size:80%", family = fontFamily))))))),
# Acknowledgements -----
tabPanel(title = "Acknowledgements",
verticalLayout(
includeHTML("www/acknowledgementsText.html"))),
tabPanel(title = "For further information",
verticalLayout(
includeHTML("www/furtherInformation.html")))
)
)
)
)
server <- function(input, output, session) {
# router(input, output)
GlobalData = callModule(GlobalDataModule, "globals")
# load_data(dataSetsToLoad) # load most of the data. Big files can be loaded elsewhere
reqRatio_sum_RDA <- data.table::rbindlist(list(reqRatio_sum_RDA_macro.var, reqRatio_sum_RDA_vits.var, reqRatio_sum_RDA_minrls.var))
# button_UI("first")
countryName <- callModule(country_choice_mod_server, "plot1_vars")
keepListCol <- c("scenario", "region_code.IMPACT159", "year", "pcGDPX0", "budget.PCX0", "incShare.PCX0")
dt.budgetShare[, setdiff(names(dt.budgetShare), keepListCol) := NULL]
dt.budgetShare[, scenario := gsub("-", "_", scenario)]
dt.budgetShare[, scenario := gsub("_REF", "", scenario)] # added for final version of paper Nov 3, 2018
colsToRound <- c("pcGDPX0", "budget.PCX0", "incShare.PCX0")
dt.budgetShare[, (colsToRound) := round(.SD, 2), .SDcols = colsToRound]
new.names <- c("Per Capita GDP", "Food expenditures", "Share of income")
data.table::setnames(dt.budgetShare, old = colsToRound, new = new.names)
dt.budgetShare[, year := gsub("X", "", year)]
dt.budgetShare.long <- data.table::melt(
data = dt.budgetShare,
id.vars = c("scenario", "region_code.IMPACT159", "year"),
measure.vars = new.names,
variable.name = "Variable",
value.name = "value",
variable.factor = FALSE
)
dt.budgetShare.long <- unique(dt.budgetShare.long)
formula.budgetShare <- paste("scenario + region_code.IMPACT159 + Variable ~ year")
dt.budgetShare.wide <- data.table::dcast(
dt.budgetShare.long,
formula = formula.budgetShare,
value.var = "value")
# foodAfford reactive -----
data.afford <- reactive({
countryName <- input$affordabilityCountryName
dt <- copy(dt.budgetShare.wide)
countryCode <- countryCodeLookup(countryName, fileloc("mData"))
dt <- dt[region_code.IMPACT159 %in% countryCode, ]
setnames(dt, old = "region_code.IMPACT159", new = "Country code")
dt[, scenario := factor(scenario, levels = scenarioNames)]
#dt[, scenario := gsub("", "", scenario)]
dt
})
# country name choice observer -----
# observe({
# countryName <- input$userCountryName
# # Can also set the label and select items
# updateSelectizeInput(session, "affordabilityCountryName", selected = countryName)
# updateSelectizeInput(session, "availabilityCountryName", selected = countryName)
# updateSelectizeInput(session, "adequacyCountryName", selected = countryName)
# updateSelectizeInput(session, "nutbalCountryName", selected = countryName)
# updateSelectizeInput(session, "AMDRCountryName", selected = countryName)
# updateSelectizeInput(session, "diversityCountryName", selected = countryName)
# updateSelectizeInput(session, "nonstapleEnergyShareCountryName", selected = countryName)
# updateSelectizeInput(session, "MRVCountryName", selected = countryName)
# updateSelectizeInput(session, "RaosQECountryName", selected = countryName)
# updateSelectizeInput(session, "FGcountryName", selected = countryName)
#
# # scenario choice observer -----
# scenarioName <- input$userScenarioName
# # Can also set the label and select items
# updateSelectizeInput(session, "availabilityScenarioName", selected = scenarioName)
# updateSelectizeInput(session, "adequacyScenarioName", selected = scenarioName)
# updateSelectizeInput(session, "FGscenarioName", selected = scenarioName)
# })
observe({
countryName <- input$userCountryName
# Can also set the label and select items
updateSelectizeInput(session, "affordabilityCountryName", selected = countryName)
updateSelectizeInput(session, "availabilityCountryName", selected = countryName)
updateSelectizeInput(session, "adequacyCountryName", selected = countryName)
updateSelectizeInput(session, "nutbalCountryName", selected = countryName)
updateSelectizeInput(session, "AMDRCountryName", selected = countryName)
updateSelectizeInput(session, "diversityCountryName", selected = countryName)
updateSelectizeInput(session, "nonstapleEnergyShareCountryName", selected = countryName)
updateSelectizeInput(session, "MRVCountryName", selected = countryName)
updateSelectizeInput(session, "RaosQECountryName", selected = countryName)
updateSelectizeInput(session, "FGcountryName", selected = countryName)
# scenario choice observer -----
scenarioName <- input$userScenarioName
# Can also set the label and select items
updateSelectizeInput(session, "availabilityScenarioName", selected = scenarioName)
updateSelectizeInput(session, "adequacyScenarioName", selected = scenarioName)
updateSelectizeInput(session, "FGscenarioName", selected = scenarioName)
})
# food availability reactive -----
data.foodAvail <- reactive({
countryName <- input$availabilityCountryName
scenarioName <- input$availabilityScenarioName
dt <- copy(dt.foodAvail_foodGroup.var)
spiderData <- spiderGraphData3(countryName, dt, displayColumnName = "food_group_code")
})
# food adequacy reactive -----
data.adequacy.tot <- reactive({
countryName <- input$adequacyCountryName
# scenarioName <- input$adequacyScenarioName
reqType <- reqRatio_sum_RDA
# reqType <- reqType[scenario %in% scenarioNames]
dt <- copy(reqType)
spiderData <- spiderGraphData2(countryName, dt, displayColumnName = "nutrient")
})
# food adequacy.macro reactive -----
data.adequacy.macro <- reactive({
countryName <- input$adequacyCountryName
scenarioName <- input$adequacyScenarioName
reqType <- reqRatio_sum_RDA_macro.var
dt <- copy(reqType)
spiderData <- spiderGraphData(countryName, scenarioName, dt, displayColumnName = "nutrient")
})
# food adequacy.vits reactive -----
data.adequacy.vits <- reactive({
countryName <- input$adequacyCountryName
scenarioName <- input$adequacyScenarioName
reqType <- reqRatio_sum_RDA_vits.var
dt <- copy(reqType)
spiderData <- spiderGraphData(countryName, scenarioName, dt, displayColumnName = "nutrient")
})
# food adequacy.minrls reactive -----
data.adequacy.minrls <- reactive({
countryName <- input$adequacyCountryName
scenarioName <- input$adequacyScenarioName
reqType <- reqRatio_sum_RDA_minrls.var
dt <- copy(reqType)
spiderData <- spiderGraphData(countryName, scenarioName, dt, displayColumnName = "nutrient")
})
# energy.quantity reactive -----
data.energy.quantity <- reactive({
countryName <- input$adequacyCountryName
scenarioName <- input$adequacyScenarioName
countryCode <- countryCodeLookup(countryName, fileloc("mData"))
keepListRow <- c("kcalsPerDay_other", "kcalsPerDay_carbohydrate",
"kcalsPerDay_fat", "kcalsPerDay_protein")
dt <- copy(dt.nutrients_kcals.var)
dt <- dt[nutrient %in% keepListRow,]
dt[, value := round(value, 1)][, nutrient := gsub("kcalsPerDay_", "", nutrient)]
spiderData <- graphData(countryName, scenarioName, dt, displayColumnName = "nutrient")
})
# energy.share reactive -----
data.energy.share <- reactive({
countryName <- input$adequacyCountryName
scenarioName <- input$adequacyScenarioName
countryCode <- countryCodeLookup(countryName, fileloc("mData"))
keepListRow <- c("kcalsPerDay_other_share", "kcalsPerDay_carbohydrate_share",
"kcalsPerDay_fat_share", "kcalsPerDay_protein_share")
dt <- copy(dt.nutrients_kcals.var)
dt <- dt[scenario %in% scenarioName & nutrient %in% keepListRow,]
dt[, value := round(value, 1)][, nutrient := gsub("kcalsPerDay_", "", nutrient)][, nutrient := gsub("_share", "", nutrient)]
spiderData <- graphData(countryName, scenarioName, dt, displayColumnName = "nutrient")
})
# nonStaple.share reactive -----
data.nonStaple.share <- reactive({
countryName <- input$nonstapleEnergyShareCountryName
countryCode <- countryCodeLookup(countryName, fileloc("mData"))
dt <- dt.KcalShare_nonstaple.var[region_code.IMPACT159 == countryCode,]
dt[, value := round(value, 2)]
#dt[, scenario := gsub("", "", scenario)]
dt[, year := gsub("X", "", year)]
dt
})
# MRV reactive -----
data.MRV <- reactive({
countryName <- input$MRVCountryName
countryCode <- countryCodeLookup(countryName, fileloc("mData"))
dt <- copy(dt.MRVRatios.var)
dt <- dt[region_code.IMPACT159 %in% countryCode ,]
# setnames(dt, old = "region_code.IMPACT159", new = "Country code")
dt[, value := round(value, 2)]
dt[, year := gsub("X", "", year)]
dt
})
# AMDR reactive -----
data.AMDR <- reactive({
countryName <- input$AMDRCountryName
barData <- barGraphData(countryName, inData = food_agg_AMDR_hi.var)
barData[, scenario := gsub("", "", scenario)][, year := gsub("X", "", year)]
})
# nutAvail reactive -----
data.nutAvailFG <- reactive({
countryName <- input$FGcountryName
scenarioName <- input$FGscenarioName
reqName <- input$nutrientGroup
if (!exists("dt.nutrients_sum_FG.var")) {
withProgress(message = 'Loading data', {
dt.nutrients_sum_FG.var <- getNewestVersion("dt.nutrients_sum_FG.var", fileloc("mData"))
dt.nutrients_sum_FG.var <- (dt.nutrients_sum_FG.var[year %in% years])
dt.nutrients_sum_FG.var <<- dt.nutrients_sum_FG.var[scenario %in% scenarioNames] # <<- should make it available all the time. Nov 11, 2016
incProgress(1)}
)
dt.nutrients_sum_FG.var
}
if (reqName %in% "macronutrients") nutrientGroup <- c("carbohydrate_g", "protein_g", "totalfiber_g", "fat_g")
if (reqName %in% "minerals") nutrientGroup <- c("calcium_mg", "iron_mg", "magnesium_mg", "phosphorus_mg", "potassium_g", "zinc_mg")
if (reqName %in% "vitamins") nutrientGroup <- c("folate_µg", "niacin_mg", "riboflavin_mg", "thiamin_mg", "vit_a_rae_µg", "vit_b6_mg",
"vit_b12_µg", "vit_c_mg", "vit_d_µg", "vit_e_mg", "vit_k_µg")
inData <- copy(dt.nutrients_sum_FG.var)
inData[, year := gsub("X", "", year)]
inData <- inData[nutrient %in% nutrientGroup]
displayColumnName <- "food_group_code" # all these food groups are included in each spidergraph
facetColumnName <- "nutrient" # one spider graph per facetColumnName
spiderData <- facetGraphData(countryName, scenarioName, inData, facetColumnName, displayColumnName)
})
# nutBalScore reactive -----
data.nutBalScore <- reactive({
countryName <- input$nutbalCountryName
countryCode <- countryCodeLookup(countryName, fileloc("mData"))
dt <- copy(dt.nutBalScore.var)
dt[, year := gsub("X", "", year)]
dt <- dt[region_code.IMPACT159 == countryCode,]
dt[, value := round(value, 2)]
formula.wide <- paste("scenario + region_code.IMPACT159 ~ year")
spiderData <- data.table::dcast(
data = dt,
formula = formula.wide,
value.var = "value")
})
# Shannon reactive -----
data.ShannonDiv <- reactive({
countryName <- input$diversityCountryName
countryCode <- countryCodeLookup(countryName, fileloc("mData"))
dt <- copy(dt.shannonDiversity.var)
keepListCol <- c("scenario","region_code.IMPACT159", "year", "SD", "SDnorm")
dt <- dt[, keepListCol, with = FALSE]
dt <- dt[region_code.IMPACT159 == countryCode,][, year := gsub("X", "", year)]
colsToRound <- c("SD", "SDnorm")
dt[, (colsToRound) := round(.SD, 2), .SDcols = colsToRound]
idVars <- c("scenario", "region_code.IMPACT159", "year")
measureVars <- names(dt)[!names(dt) %in% idVars]
dt.long <- data.table::melt(
data = dt,
id.vars = idVars,
measure.vars = measureVars,
variable.name = "Variable",
value.name = "value",
variable.factor = FALSE)
formula.wide <- paste("scenario + region_code.IMPACT159 + Variable ~ year")
dt.wide <- data.table::dcast(
data = dt.long,
formula = formula.wide,
value.var = "value")
dt.wide[, scenario := factor(scenario, levels = scenarioNames)]
dt.wide[, scenario := gsub("", "", scenario)]
})
# RaosQE reactive -----
data.RaosQE <- reactive({
countryName <- input$RaosQECountryName
countryCode <- countryCodeLookup(countryName, fileloc("mData"))
dt <- copy(dt.RAOqe.var)
dt <- dt[region_code.IMPACT159 == countryCode,]
dt[, value := round(value, 2)]
dt[, year := gsub("X", "", year)]
formula.wide <- paste("scenario + region_code.IMPACT159 ~ year")
spiderData <- data.table::dcast(
data = dt,
formula = formula.wide,
value.var = "value")
})
# full data set download reactive -----
datasetInput <- reactive({
get(datasetsToLoad.complete[match(input$dataset.full, datasetsToLoad.desc.complete)])
})
# affordabilityTable -----
output$affordabilityTable <- DT::renderDataTable({
dt <- copy(data.afford())
colsToConvert <- c("2010", "2030", "2050")
dt[, (colsToConvert) := lapply(.SD, sprintf, fmt="%#.2f"), .SDcols = colsToConvert]
dt[, scenario := factor(scenario, levels = scenarioNames)]
dt <- datatable(dt, rownames = FALSE, options = list(pageLength = 20, dom = 'iftp' ,
columnDefs = list(list(className = 'dt-right', targets = 3:5)) # targets start at column 0
))
})
output$downloadData.afford <- downloadHandler(
filename = function() {paste("afford_", "_", input$affordabilityCountryName, Sys.Date(), '.csv', sep = '') },
content = function(file) {write.csv(data.afford(), file)}
)
# availability graph server side -----
output$availabilitySpiderGraphP1 <- renderggiraph({
dt <- copy(data.foodAvail()) # this became a dataframe in the old ggplot2 code. I think I have fixed this. Dec 3, 2018
# scenarioName <- unique(dt$scenario)
data.table::setnames(dt, old = codeNames.foodGroups, new = foodGroupNamesWrap)
p <- spiderGraphOutput(spiderData = dt, nrow = 2)
# ggiraph(code = print(p), zoom_max = 1, selection_type = "single")
})
# availability table server side -----
output$availabilityTableP1 <- DT::renderDataTable({
dt <- as.data.table(copy(data.foodAvail()))
dt <- pivotWideToWideYear(dt)
nutrient <- "food group"
setnames(dt, old = "nutrient_foodGroup", new = nutrient) # new depends on whether dt is for food groups or nutrients
colsToRound <- names(dt)[!names(dt) %in% c("scenario", "region_code.IMPACT159", "year", nutrient)]
dt[,(colsToRound) := round(.SD,2), .SDcols = colsToRound]
data.table::setnames(dt, old = "region_code.IMPACT159", new = "country code")
data.table::setnames(dt, old = names(dt), new = capwords(names(dt)))
colsToConvert <- c("2010", "2030", "2050")
dt[, (colsToConvert) := lapply(.SD, sprintf, fmt="%#.2f"), .SDcols = colsToConvert]
dt <- datatable(dt, rownames = FALSE, options = list(pageLength = 20, dom = 'iftp' ,
columnDefs = list(list(className = 'dt-right', targets = 3:5)) # targets start at column 0
))
})
output$downloadData.avail <- downloadHandler(
filename = function() {paste("foodavail_", "_", input$availabilityCountryName, Sys.Date(), '.csv', sep = '') },
content = function(file) {write.csv(data.foodAvail(), file)}
)
# adequacy graphs server side -----
output$adequacySpiderGraphtot <- renderggiraph({
dt <- as.data.table(copy(data.adequacy.tot()))
# order of nutrients in the spider graph
newOrder <- c("scenario", "region_code.IMPACT159", "nutrientType", "year",
"carbohydrate_g", "protein_g", "totalfiber_g",
"calcium_mg", "iron_mg", "magnesium_mg", "phosphorus_mg", "potassium_g", "zinc_mg",
"folate_µg", "riboflavin_mg", "thiamin_mg",
"vit_a_rae_µg", "vit_b12_µg", "vit_b6_mg", "vit_c_mg", "vit_d_µg", "vit_e_mg", "vit_k_µg")
setcolorder(dt, neworder = newOrder)
scenarioName <- input$adequacyScenarioName
data.table::setnames(dt, old = codeNames.tot, new = nutNamesNoUnitsWrap)
p <- spiderGraphOutput(spiderData = dt, nrow = 2)
# print(p)
})
output$adequacySpiderGraphP1 <- renderPlot({
dt <- as.data.table(copy(data.adequacy.macro()))
scenarioName <- unique(dt$scenario)
data.table::setnames(dt, old = codeNames.macro, new = nutNamesNoUnitsWrap.macro)
p <- spiderGraphOutput(spiderData = dt, scenarioName)
print(p)
})
output$adequacySpiderGraphP2 <- renderPlot({
dt <- as.data.table(copy(data.adequacy.vits()))
scenarioName <- unique(dt$scenario)
data.table::setnames(dt, old = codeNames.vits, new = nutNamesNoUnitsWrap.vits)
p <- spiderGraphOutput(spiderData = dt, scenarioName)
print(p)
})
output$adequacySpiderGraphP3 <- renderPlot({
dt <- as.data.table(copy(data.adequacy.minrls()))
scenarioName <- unique(dt$scenario)
#dt[, scenario := gsub("", "", scenario)]
# data.table::setnames(dt, old = names(dt), new = capwords(names(dt)))
data.table::setnames(dt, old = codeNames.minrls, new = nutNamesNoUnitsWrap.minrls)
p <- spiderGraphOutput(dt, scenarioName)
print(p)
})
# adequacy tables server side -----
output$adequacyTableP1 <- DT::renderDataTable({
dt <- as.data.table(copy(data.adequacy.macro()))
dt <- pivotWideToWideYear(dt)
nutrient <- "nutrient"
data.table::setnames(dt, old = "nutrient_foodGroup", new = nutrient) # new depends on whether dt is for food groups or nutrients
data.table::setnames(dt, old = "region_code.IMPACT159", new = "country code")
data.table::setnames(dt, old = names(dt), new = capwords(names(dt)))
colsToConvert <- c("2010", "2030", "2050")
dt[, (colsToConvert) := lapply(.SD, sprintf, fmt="%#.2f"), .SDcols = colsToConvert]
dt <- datatable(dt, rownames = FALSE, options = list(pageLength = 20, dom = 'iftp' ,
columnDefs = list(list(className = 'dt-right', targets = 3:5)) # targets start at column 0
))
})
output$adequacyTableTot <- DT::renderDataTable({
dt <- as.data.table(copy(data.adequacy.tot()))
newOrder <- c("scenario", "region_code.IMPACT159", "nutrientType", "year",
"carbohydrate_g", "protein_g", "totalfiber_g",
"calcium_mg", "iron_mg", "magnesium_mg", "phosphorus_mg", "potassium_g", "zinc_mg",
"folate_µg", "riboflavin_mg", "thiamin_mg",
"vit_a_rae_µg", "vit_b12_µg", "vit_b6_mg", "vit_c_mg", "vit_d_µg", "vit_e_mg", "vit_k_µg")
setcolorder(dt, neworder = newOrder)
dt <- pivotWideToWideYear(dt)
nutrient <- "nutrient"
data.table::setnames(dt, old = "nutrient_foodGroup", new = nutrient) # new depends on whether dt is for food groups or nutrients
data.table::setnames(dt, old = "region_code.IMPACT159", new = "country code")
data.table::setnames(dt, old = names(dt), new = capwords(names(dt)))
colsToConvert <- c("2010", "2030", "2050")
dt[, (colsToConvert) := lapply(.SD, sprintf, fmt="%#.2f"), .SDcols = colsToConvert]
dt <- datatable(dt, rownames = FALSE, options = list(pageLength = 20, dom = 'iftp' ,
columnDefs = list(list(className = 'dt-right', targets = 3:5)) # targets start at column 0
))
})
output$downloadData.adequacy.macro <- downloadHandler(
filename = function() {paste("adeq_macro_", input$adequacyCountryName, "_", Sys.Date(), '.csv', sep = '') },
content = function(file) {write.csv(data.adequacy.macro(), file)}
)
output$adequacyTableP2 <- DT::renderDataTable({
dt <- as.data.table(copy(data.adequacy.vits()))
dt <- pivotWideToWideYear(dt)
nutrient <- "nutrient"
data.table::setnames(dt, old = "nutrient_foodGroup", new = nutrient) # new depends on whether dt is for food groups or nutrients
data.table::setnames(dt, old = "region_code.IMPACT159", new = "country code")
data.table::setnames(dt, old = names(dt), new = capwords(names(dt)))
colsToConvert <- c("2010", "2030", "2050")
dt[, (colsToConvert) := lapply(.SD, sprintf, fmt="%#.2f"), .SDcols = colsToConvert]
dt <- datatable(dt, rownames = FALSE, options = list(pageLength = 20, dom = 'iftp' ,
columnDefs = list(list(className = 'dt-right', targets = 3:5)) # targets start at column 0
))
})
output$downloadData.adequacy.vits <- downloadHandler(
filename = function() {paste("adeq_vits_", input$adequacyCountryName, "_", Sys.Date(), '.csv', sep = '') },
content = function(file) {write.csv(data.adequacy.vits(), file)}
)
output$adequacyTableP3 <- DT::renderDataTable({
dt <- copy(data.adequacy.minrls())
dt <- pivotWideToWideYear(dt)
nutrient <- "nutrient"
data.table::setnames(dt, old = "nutrient_foodGroup", new = nutrient) # new depends on whether dt is for food groups or nutrients
data.table::setnames(dt, old = "region_code.IMPACT159", new = "country code")
data.table::setnames(dt, old = names(dt), new = capwords(names(dt)))
colsToConvert <- c("2010", "2030", "2050")
dt[, (colsToConvert) := lapply(.SD, sprintf, fmt="%#.2f"), .SDcols = colsToConvert]
dt <- datatable(dt, rownames = FALSE, options = list(pageLength = 20, dom = 'iftp' ,
columnDefs = list(list(className = 'dt-right', targets = 3:5)) # targets start at column 0
))
})
output$downloadData.adequacy.minrls <- downloadHandler(
filename = function() {paste("adeq_minrls_", input$adequacyCountryName, "_", Sys.Date(), '.csv', sep = '') },
content = function(file) {write.csv(data.adequacy.minrls(), file)}
)
# energy ratio bar chart -----
output$energyShareBarPlot <- renderPlot({
dt <- copy(data.energy.share())
scenarioName <- unique(dt$scenario)
countryCode <- unique(dt$region_code.IMPACT159)
countryName <- countryNameLookup(countryCode)
titleText <- paste("Share of total kilocalories by macronutrient\n", "Country: ", countryName, "Scenario: ", scenarioName)
yLab <- "(percent)"
p <- ggplot(dt, aes(x = year, y = value, tooltip = value, fill = nutrient, order = c("region_name") )) +
geom_bar_interactive(stat = "identity") +
theme(axis.title.y = element_text(family = fontFamily, face = "plain"))
p <- p + theme(plot.title = element_text(hjust = 0.5, size = 10, family = fontFamily,
face = "plain")) + ggtitle(titleText)
p <- p + theme(axis.text = element_text(size = 10, family = fontFamily, face = "plain"))
p <- p + theme(legend.text = element_text(size = 10, family = fontFamily, face = "plain")) +
labs(y = yLab, x = NULL)
print(p)
})
# energy quantity bar chart -----
output$energyQuantityBarPlot <- renderPlot({
dt <- copy(data.energy.quantity())
scenarioName <- unique(dt$scenario)
countryCode <- unique(dt$region_code.IMPACT159)
countryName <- countryNameLookup(countryCode)
# colors_in <- c( "gray", "green", "blue", "red", "yellow" )
titleText <- paste("Average daily kilocalory availability\n", countryName,", Scenario:", scenarioName)
yLab <- "(kcals)"
p <- ggplot(dt, aes(x = year, y = value, tooltip = value, fill = nutrient, order = c("region_name") )) +
geom_bar_interactive(stat = "identity") +
theme(axis.title.y = element_text(family = fontFamily, face = "plain"))
p <- p + theme(plot.title = element_text(hjust = 0.5, size = 10, family = fontFamily,
face = "plain")) + ggtitle(titleText)
p <- p + theme(axis.text = element_text(size = 10, family = fontFamily, face = "plain"))
p <- p + theme(legend.text = element_text(size = 10, family = fontFamily, face = "plain")) +
labs(y = yLab, x = NULL)
print(p)
})
# energy share table -----
output$energyShareTable <- DT::renderDataTable({
dt.long <- copy(data.energy.share())
formula.wide <- paste("scenario + region_code.IMPACT159 + nutrient ~ year")
dt <- data.table::dcast(
data = dt.long,
formula = formula.wide,
value.var = "value")
nutrient <- "share of total energy"
data.table::setnames(dt, old = "nutrient", new = nutrient) # new depends on whether dt is for food groups or nutrients
data.table::setnames(dt, old = "region_code.IMPACT159", new = "country code")
data.table::setnames(dt, old = names(dt), new = capwords(names(dt)))
colsToConvert <- c("2010", "2030", "2050")
dt[, (colsToConvert) := lapply(.SD, sprintf, fmt="%#.2f"), .SDcols = colsToConvert]
dt <- datatable(dt, rownames = FALSE, options = list(pageLength = 20, dom = 'iftp' ,
columnDefs = list(list(className = 'dt-right', targets = 3:5)) # targets start at column 0
))
})
output$downloadData.energyRat <- downloadHandler(
filename = function() {paste("energyRatio", input$adequacyCountryName, "_", Sys.Date(), '.csv', sep = '') },
content = function(file) {write.csv(data.energy.share(), file)}
)
# energy quantity table -----
output$energyQuantityTable <- DT::renderDataTable({
dt.long <- copy(data.energy.quantity())
formula.wide <- paste("scenario + region_code.IMPACT159 + nutrient ~ year")
dt <- data.table::dcast(
data = dt.long,
formula = formula.wide,
value.var = "value")
nutrient <- "Kilocalories"
data.table::setnames(dt, old = "nutrient", new = nutrient) # new depends on whether dt is for food groups or nutrients
data.table::setnames(dt, old = "region_code.IMPACT159", new = "country code")
data.table::setnames(dt, old = names(dt), new = capwords(names(dt)))
colsToConvert <- c("2010", "2030", "2050")
dt[, (colsToConvert) := lapply(.SD, sprintf, fmt="%#.2f"), .SDcols = colsToConvert]
dt <- datatable(dt, rownames = FALSE, options = list(pageLength = 20, dom = 'iftp' ,
columnDefs = list(list(className = 'dt-right', targets = 3:5)) # targets start at column 0
))
})
output$downloadData.energyQ <- downloadHandler(
filename = function() {paste("energyQ", input$adequacyCountryName, "_", Sys.Date(), '.csv', sep = '') },
content = function(file) {write.csv(data.energy.quantity(), file)}
)
# adequacy AMDR graph server side ------
output$AMDRbarGraphP1 <- renderggiraph({
dt <- copy(data.AMDR())
p <- plotByRegionBarAMDRinShiny(barData = dt, yLab = "share of total dietary energy (percent)")
ggiraph(code = print(p), zoom_max = 1, selection_type = "single")
})
# adequacy AMDR table server side ------
output$AMDRTableP1 <- DT::renderDataTable({
dt <- copy(data.AMDR())
oldnames <- c("carbohydrate_g.kcalpercent", "fat_g.kcalpercent", "protein_g.kcalpercent")
newnames <- c("carbohydrate", "protein", "fat")
data.table::setnames(dt, old = oldnames, new = newnames)
dt <- pivotWideToWideYear(dt)
oldnames <- c("region_code.IMPACT159", "nutrient_foodGroup")
newnames <- c("Country Code", "Nutrient")
data.table::setnames(dt, old = oldnames, new = newnames)
colsToConvert <- c("2010", "2030", "2050")
dt[, (colsToConvert) := lapply(.SD, sprintf, fmt="%#.2f"), .SDcols = colsToConvert]
dt[, scenario := factor(scenario, levels = scenarioNames)]
dt <- datatable(dt, rownames = FALSE, options = list(pageLength = 20, dom = 'iftp' ,
columnDefs = list(list(className = 'dt-right', targets = 3:5)) # targets start at column 0
))
})
output$downloadData.AMDR <- downloadHandler(
filename = function() {paste("AMDR_", input$AMDRCountryName, "_", Sys.Date(), '.csv', sep = '') },
content = function(file) {write.csv(data.AMDR(), file)}
)
# adequacy nutrient balance table server side ------
output$nutbalTableP1 <- DT::renderDataTable({
dt <- data.nutBalScore()
data.table::setnames(dt, old = "region_code.IMPACT159", new = "country code")
data.table::setnames(dt, old = names(dt), new = capwords(names(dt)))
colsToConvert <- c("2010", "2030", "2050")
dt[, (colsToConvert) := lapply(.SD, sprintf, fmt="%#.2f"), .SDcols = colsToConvert]
dt <- datatable(dt, rownames = FALSE, options = list(pageLength = 20, dom = 'iftp' ,
columnDefs = list(list(className = 'dt-right', targets = 2:4)) # targets start at column 0
))
})
output$downloadData.nutbal <- downloadHandler(
filename = function() {paste("nutbal_", input$nutbalCountryName, "_", Sys.Date(), '.csv', sep = '') },
content = function(file) {write.csv(data.nutBalScore(), file)}
)
# adequacy MRV table server side ------
output$MRVTableP1 <- DT::renderDataTable({
dt <- copy(data.MRV())
dt[,value := round(value, 2)]
formula.wide <- paste("scenario + region_code.IMPACT159 + nutrient ~ year")
dt <- data.table::dcast(
data = dt,
formula = formula.wide,
value.var = "value")
data.table::setnames(dt, old = "region_code.IMPACT159", new = "country code")
dt[, nutrient := capwords(cleanupNutrientNames(nutrient))]
colsToConvert <- c("2010", "2030", "2050")
dt[, (colsToConvert) := lapply(.SD, sprintf, fmt="%#.2f"), .SDcols = colsToConvert]
dt[, scenario := factor(scenario, levels = scenarioNames)]
dt <- datatable(dt, rownames = FALSE, options = list(pageLength = 20, dom = 'iftp' ,
columnDefs = list(list(className = 'dt-right', targets = 3:5)) # targets start at column 0
))
})
output$downloadData.MRV <- downloadHandler(
filename = function() {paste("MRV", input$MRVCountryName, "_", Sys.Date(), '.csv', sep = '') },
content = function(file) {write.csv(data.MRV(), file)}
)
# nonstaple share diversity metrics -----
output$nonStapleEnergyShareTable <- DT::renderDataTable({
dt <- copy(data.nonStaple.share())
formula.wide <- paste("scenario + region_code.IMPACT159 ~ year")
dt <- data.table::dcast(
data = dt,
formula = formula.wide,
value.var = "value")
colsToRound <- names(dt)[!names(dt) %in% c("scenario", "region_code.IMPACT159", "year")]
dt[,(colsToRound) := round(.SD,2), .SDcols = colsToRound]
data.table::setnames(dt, old = "region_code.IMPACT159", new = "country code")
data.table::setnames(dt, old = names(dt), new = capwords(names(dt)))
colsToConvert <- c("2010", "2030", "2050")
dt[, (colsToConvert) := lapply(.SD, sprintf, fmt="%#.2f"), .SDcols = colsToConvert]
dt <- datatable(dt, rownames = FALSE, options = list(pageLength = 20, dom = 'iftp' ,
columnDefs = list(list(className = 'dt-right', targets = 2:4)) # targets start at column 0
))
})
output$downloadData.nonStapleShare <- downloadHandler(
filename = function() {paste("nonStapleShare_", input$nonstapleEnergyShareCountryName, "_", Sys.Date(), '.csv', sep = '') },
content = function(file) {write.csv(data.nonStaple.share(), file)}
)
# Rao's QE metric -----
output$RaosQETable <- DT::renderDataTable({
dt <- copy(data.RaosQE())
formula.wide <- paste("year + region_code.IMPACT159 ~ scenario")
colsToRound <- names(dt)[!names(dt) %in% c("scenario", "region_code.IMPACT159", "year")]
dt[,(colsToRound) := round(.SD,2), .SDcols = colsToRound]
data.table::setnames(dt, old = "region_code.IMPACT159", new = "country code")
data.table::setnames(dt, old = names(dt), new = capwords(names(dt)))
colsToConvert <- c("2010", "2030", "2050")
dt[, (colsToConvert) := lapply(.SD, sprintf, fmt="%#.2f"), .SDcols = colsToConvert]
dt <- datatable(dt, rownames = FALSE, options = list(pageLength = 20, dom = 'iftp' ,
columnDefs = list(list(className = 'dt-right', targets = 2:4)) # targets start at column 0
))
})
output$downloadData.RaoQE <- downloadHandler(
filename = function() {paste("RaosQE_", input$input$RaosQECountryName, "_", Sys.Date(), '.csv', sep = '') },
content = function(file) {write.csv(data.RaosQE(), file)}
)
# Shannon diversityTable -----
output$diversityTable <- DT::renderDataTable({
dt <- copy(data.ShannonDiv())
colsToRound <- names(dt)[!names(dt) %in% c("scenario", "region_code.IMPACT159", "year", "Variable")]
dt[,(colsToRound) := round(.SD,2), .SDcols = colsToRound]
data.table::setnames(dt, old = "region_code.IMPACT159", new = "country code")
oldNames <- names(dt)
newNames <- gsub("_", " \n", oldNames)
setnames(dt, old = oldNames, new = newNames)
data.table::setnames(dt, old = names(dt), new = capwords(names(dt)))
colsToConvert <- c("2010", "2030", "2050")
dt[, (colsToConvert) := lapply(.SD, sprintf, fmt="%#.2f"), .SDcols = colsToConvert]
dt <- datatable(dt, rownames = FALSE, options = list(pageLength = 20, dom = 'iftp' ,
columnDefs = list(list(className = 'dt-right', targets = 3:5)) # targets start at column 0
))
})
output$downloadData.ShannonDiversity <- downloadHandler(
filename = function() {paste("Shannon_", input$diversityCountryName, "_", Sys.Date(), '.csv', sep = '') },
content = function(file) {write.csv(data.ShannonDiv(), file)}
)
# nutrient avail, FG horizontal graphs -----
output$NutAvailFGbarGraphP1 <- renderPlot({
dt <- copy(data.nutAvailFG())
displayColumnName <- "food_group_code" # all these food groups are included in each bar chart
facetColumnName <- "nutrient" # one spider graph per facetColumnName
p <- facetGraphOutput(inData = dt, facetColumnName, displayColumnName, codeNames.foodGroups, foodGroupNamesNoWrap)
p
}, height = "auto")
output$plot.NutAvailFGbarGraphP1 <- renderUI({
if (input$nutrientGroup == "vitamins") plotHeight = "800px"
if (input$nutrientGroup == "macronutrients") plotHeight = "500px"
if (input$nutrientGroup == "minerals") plotHeight = "500px"
plotOutput("NutAvailFGbarGraphP1", width = "100%", height = plotHeight)
})
# nutrient diversity FG Table -----
output$NutAvailFGTable <- DT::renderDataTable({
dt <- copy(data.nutAvailFG())
displayColumnName <- "food_group_code" # all these food groups are included in each spidergraph
facetColumnName <- "nutrient" # one bar graph per facetColumnName
formula.wide <- sprintf("scenario + region_code.IMPACT159 + %s + %s ~ year", facetColumnName, displayColumnName)
dt <- data.table::dcast(data = dt, formula = formula.wide, value.var = "value")
data.table::setnames(dt, old = "region_code.IMPACT159", new = "country code")
names.new <- cleanupNutrientNames(names(dt))
if (facetColumnName %in% "nutrient") dt[, nutrient := capwords(cleanupNutrientNames(nutrient))]
data.table::setnames(dt, old = names(dt), new = capwords(names.new))
colsToConvert <- c("2010", "2030", "2050")
dt[, (colsToConvert) := lapply(.SD, sprintf, fmt="%#.2f"), .SDcols = colsToConvert]
dt <- DT::datatable(dt, rownames = FALSE, options = list(pageLength = 25, dom = 'iftp',
columnDefs = list(list(className = 'dt-right', targets = 4:6)) # targets start at column 0
))
})
output$downloaddata.nutAvailFG <- downloadHandler(
filename = function() {paste("nutDiv_", "_", input$FGcountryName, Sys.Date(), '.csv', sep = '') },
content = function(file) {write.csv(data.nutAvailFG(), file)}
)
#view and download data ------
output$table <- DT::renderDataTable({
dt <- datasetInput()
currentDT <- datasetsToLoad.complete[match(input$dataset.full, datasetsToLoad.desc.complete)]
valueDTNames <- paste0(c( "dt.foodAvail_foodGroup", "dt.nutrients_kcals",
"reqRatio_sum_RDA_macro", "reqRatio_sum_RDA_vits", "reqRatio_sum_RDA_minrls",
"dt.nutBalScore", "dt.MRVRatios", "dt.KcalShare_nonstaple", "dt.RAOqe"), ".var")
setnames(dt, old = "region_code.IMPACT159", new = "Country code")
if (!currentDT %in% valueDTNames) {
dt <- DT::datatable(dt, rownames = FALSE, options = list(pageLength = 25))
}else{
dt <- DT::datatable(dt, rownames = FALSE, options = list(pageLength = 25)) %>% formatRound('value', 3)
}
})
output$table <- DT::renderDataTable({
dt <- datasetInput()
currentDT <- datasetsToLoad.complete[match(input$dataset.full, datasetsToLoad.desc.complete)]
valueDTNames <- paste0(c( "dt.foodAvail_foodGroup", "dt.nutrients_kcals",
"reqRatio_sum_RDA_macro", "reqRatio_sum_RDA_vits", "reqRatio_sum_RDA_minrls",
"dt.nutBalScore", "dt.MRVRatios", "dt.KcalShare_nonstaple", "dt.RAOqe"), ".var")
setnames(dt, old = "region_code.IMPACT159", new = "Country code")
if (!currentDT %in% valueDTNames) {
dt <- DT::datatable(dt, rownames = FALSE, options = list(pageLength = 25))
}else{
dt <- DT::datatable(dt, rownames = FALSE, options = list(pageLength = 25)) %>% formatRound('value', 3)
}
})
output$downloadData.full <- downloadHandler(
filename = function() { paste(input$dataset.full, "_", Sys.Date(), '.gz', sep = '') },
content = function(file) {
write.csv(datasetInput(), file = gzfile(file))}
)
# metadataTable ------
output$metadataTable <- DT::renderDataTable({
dt <- getNewestVersion("filesCreated", fileloc("mData"))
dt <- DT::datatable(dt, rownames = FALSE, options = list(pageLength = 25))
})
# scriptInfoTable ------
output$metadataTable <- DT::renderDataTable({
dt <- getNewestVersion("scriptInfo", fileloc("mData"))
dt <- DT::datatable(dt, rownames = FALSE, options = list(pageLength = 25))
})
# IMPACTmetadataTable ------
output$IMPACTmetadataTable <- DT::renderDataTable({
# dt <- getNewestVersion("dt.IMPACTgdxParams", fileloc("mData"))
dt <- DT::datatable(dt, rownames = FALSE, options = list(pageLength = 25))
})
# IMPACTfoodgroupLookupTable ------
output$IMPACTfoodgroupTable <- DT::renderDataTable({
data.table::setnames(dt.foodGroupsInfo, old = names(dt.foodGroupsInfo), new = gsub("_", " ", names(dt.foodGroupsInfo)))
dt <- dt.foodGroupsInfo[,1:5]
dt <- DT::datatable(dt, rownames = FALSE, options = list(pageLength = 25))
dt
})
# nutrient lookup -----
output$nutrientLookup <- DT::renderDataTable({
dt <- getNewestVersion("dt.nutrients.var", fileloc("mData"))
# dt[, ft_acds_tot_trans_g := as.numeric(ft_acds_tot_trans_g)] #dt.nutrients.var comes in as chr because one entry is "ph (Aug 10, 2018); fixed Aug 12, 2018
colsNotNumeric <- c("IMPACT_code", "region_code.IMPACT159", "food_group_code", "staple_code")
colsToRound3 <- names(dt)[!names(dt) %in% colsNotNumeric]
colsToRound0 <- c("magnesium_mg", "phosphorus_mg", "ethanol_g", "caffeine_mg", "cholesterol_mg",
"ethanol_g_cr", "calcium_mg_cr", "iron_mg_cr", "magnesium_mg_cr", "phosphorus_mg_cr",
"potassium_g_cr", "zinc_mg_cr", "vit_a_rae_µg_cr", "vit_c_mg_cr", "thiamin_mg_cr",
"riboflavin_mg_cr", "niacin_mg_cr", "vit_b6_mg_cr", "vit_b12_µg_cr", "folate_µg_cr",
"vit_e_mg_cr")
dt[, (colsToRound3) := round(.SD, 3), .SDcols = colsToRound3]
dt[, (colsToRound0) := round(.SD, 0), .SDcols = colsToRound0]
dt <- DT::datatable(dt, rownames = FALSE, options = list(pageLength = 25))
dt
})
output$downloadData.nutrients.adj <- downloadHandler(
filename = function() {paste("dt.nutrients.adj_", Sys.Date(), '.csv', sep = '') },
content = function(file) {write.csv(dt.nutrients.adj, file)}
)
# file documentation -----
output$fileDocumentation <- DT::renderDataTable({
dt <- getNewestVersion("resultFileLookup", fileloc("mData"))
# dt <- getNewestVersion("dt.metadataTot", fileloc("mData"))
dt <- DT::datatable(dt, rownames = FALSE, options = list(pageLength = 25))
dt
})
output$info <- renderText({
xy_str <- function(e) {
if(is.null(e)) return("NULL\n")
paste0("x=", round(e$x, 1), " y=", round(e$y, 1), "\n")
}
xy_range_str <- function(e) {
if(is.null(e)) return("NULL\n")
paste0("xmin=", round(e$xmin, 1), " xmax=", round(e$xmax, 1),
" ymin=", round(e$ymin, 1), " ymax=", round(e$ymax, 1))
}
paste0(
"click: ", xy_str(input$plot_click),
"dblclick: ", xy_str(input$plot_dblclick),
"hover: ", xy_str(input$plot_hover),
"brush: ", xy_range_str(input$plot_brush)
)
})
session$onSessionEnded(stopApp)
}
# Run the application -----
shinyApp(ui = ui, server = server)
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.