shiny/External_web/DataTables/server.R
In SWS-Methodology/faoswsLoss: Package to perform the computation of food loss FAO food balance sheets
#
# This is the server logic of a Shiny web application. You can run the
# application by clicking 'Run App' above.
#
# Find out more about building applications with Shiny here:
#
# http://shiny.rstudio.com/
#
library(shiny)
library(ggplot2)
library(plyr)
library(dplyr)
library(DT)
library(magrittr)
library(data.table)
library(plotly)
#load("~/faoswsLossa/shiny/Soup2Nuts/data_InternalFAO_jan.RData")
# token <- readRDS("token.rds")
# # Then pass the token to each drop_ function
# drop_acc(dtoken = token)
# drop_download("data_InternalFAO_jan.RData" , path = "shiny", overwrite = TRUE)
load("data_InternalFAO_marc26.RData")
InputData_Out[fsc_location == "Havest", "fsc_location" ] <- "Harvest"
InputData_Out[fsc_location == "Trader", "fsc_location" ] <- "Traders"
InputData_Out[fsc_location == "Farm", "fsc_location" ] <- "Producer"
InputData_Out[fsc_location == "SWS_Total", "fsc_location" ] <- "Total Supply Chain Estimate"
InputData_Out[fsc_location == "WholeSupplyChain", "fsc_location" ] <- "Total Supply Chain Estimate"
InputData_Out[tag_datacollection == "FBS/APQ", "tag_datacollection" ] <- "Food Balance Sheet/Ag. Production Questionnaire"
InputData_Out[tag_datacollection == "LitReview", "tag_datacollection" ] <- "Secondary Sources cited in Documents"
InputData_Out[tag_datacollection == "SWS", "tag_datacollection" ] <- "FAO Sources"
InputData_Out[tag_datacollection == "NationalStatsYearbook", "tag_datacollection" ] <- "National Statistics Yearbook"
InputData_Out[tag_datacollection == "NonProtected", "tag_datacollection" ] <- "FAO Sources"
InputData_Out[tag_datacollection == "NP", "tag_datacollection" ] <- "Secondary Sources cited in Documents"
InputData_Out[tag_datacollection == "", "tag_datacollection" ] <- "-"
InputData_Out[tag_datacollection == "NationalAcctSys", "tag_datacollection" ] <- "National Acctounts"
InputData_Out[tag_datacollection == "Crop-Cutting", "tag_datacollection" ] <- "Crop Cutting Field Experiment"
InputData_Out[reference == "SWS", "reference"] <- "FAO Sources"
InputData_Out[grep("WRAP",reference), "reference"] <- "WRAP, 2011"
shinyServer(function(input, output, session) {
##### Aggregation Options ####
observe({
if(input$aggregation == "WORLD") {
Agg_choices <- c("All")
updateSelectInput(session, "Agg_options",choices=Agg_choices, selected ="All")
}
if(input$aggregation == "m49_code") {
Agg_choices <- c("All")
updateSelectInput(session, "Agg_options", choices=Agg_choices, selected ="All")
}
if(!input$aggregation %in% c("sdgregion_code", "gfli_basket","m49_code")){
aggregationNameC = sub("code", "region", input$aggregation )
Agg_choices <- c("All",unique(CountryGroup[[aggregationNameC]]))
Agg_choices <- Agg_choices[! is.na(Agg_choices)]
updateSelectInput(session, "Agg_options", choices=Agg_choices, selected ="All")
}
if(length(grep("sdg+", input$aggregation ))>0){
Agg_choices <- c("All",unique(CountryGroup[["sdg_regions"]]))
updateSelectInput(session, "Agg_options", choices=Agg_choices, selected ="All")
}
if(input$aggregation == "gfli_basket") {
Agg_choices <- c("All",unique(na.omit(gfli_basket[,gfli_basket])))
updateSelectInput(session, "Agg_options", choices=Agg_choices, selected ="All")
}
})
observe({
if (input$aggregation == "WORLD") {
ctry_choices <- c("All")
updateSelectInput(session, "Country", choices=ctry_choices, selected ="All")
}
if (input$aggregation == "gfli_basket") {
ctry_choices <- c("All",unlist(na.omit(unique(gfli_basket[gfli_basket %in% input$Agg_options,measureditemcpc]))))
updateSelectInput(session, "Country", choices=ctry_choices, selected ="All")
}
if (!input$aggregation %in% c("sdgregion_code", "gfli_basket")) {
if(input$Agg_options == 'All'){
ctry_choices <- c("All",c(unique(CountryGroup[geographicaream49 %in% Base_Prod$geographicaream49,"country",with=F])))
updateSelectInput(session, "Country", choices=ctry_choices, selected = "All")
}else{
aggregationNameB = sub("code", "region", input$aggregation )
ctry_choices <- c("All",c(unique(CountryGroup[(CountryGroup[[aggregationNameB]] %in% input$Agg_options)&(geographicaream49 %in% Base_Prod$geographicaream49),"country",with=F])))
updateSelectInput(session, "Country", choices=ctry_choices, selected = "All")
}
}
if (input$aggregation %in% "sdgregion_code"){
if(input$Agg_options == 'All'){
ctry_choices <- c("All",c(unique(CountryGroup[geographicaream49 %in% Base_Prod$geographicaream49,"country",with=F])))
}else{
ctry_choices <- c("All",c(unique(CountryGroup[(CountryGroup[['sdg_regions']] %in% input$Agg_options),"country",with=F])))
}
updateSelectInput(session, "Country", choices=ctry_choices, selected = "All")
}
if (input$aggregation == "m49_code") {
ctry_choices <- c("All",unlist(CountryGroup[["m49_region"]]))
updateSelectInput(session, "Country", choices=ctry_choices, selected ="Italy")
}
# else{
# aggregationNameB = sub("code", "region", input$aggregation )
# ctry_choices <- c("All",unique(CountryGroup[CountryGroup[[aggregationNameB]] ==input$Agg_options,"country",with=F]))
# updateSelectInput(session, "Country", choices=ctry_choices, selected ="All")
# }
#
})
observe({
cpcs <- FAOCrops[measureditemcpc %in% unlist(ConvFactor1$measureditemcpc),]
if(input$BasketItems != "All"){
cpcs <- cpcs[measureditemcpc %in% unlist(gfli_basket[gfli_basket%in% input$BasketItems, "measureditemcpc", with=F])]
}
if(input$checkbox_basket ==TRUE){
cpcs <- cpcs[measureditemcpc %in% unlist(crops()),]
}
cpcs <- sort(unlist(cpcs[['crop']]))
cpcs <- c("All",cpcs)
updateSelectInput(session, "itemcpc", choices=cpcs, selected ="All")
})
# observe({
# if (input$aggregation == "m49_code") {
# mod_choices <- c("SDG-Food Loss Percentage", "Model Estimates", "Input Data")
# updateSelectInput(session, "Model_Level", choices=mod_choices, selected ="SDG-Food Loss Percentage")
# }else{
# mod_choices <- c("SDG-Food Loss Percentage")
# mod_choices <- c("SDG-Food Loss Percentage", "Input Data")
# updateSelectInput(session, "Model_Level", choices=mod_choices, selected ="SDG-Food Loss Percentage")
# }
# })
countries <- reactive({
if (input$aggregation == "WORLD") {
ctry_choices <- c(unlist(CountryGroup[["m49_region"]]))
}
if (input$aggregation == "gfli_basket") {
ctry_choices <- c(unlist(na.omit(unique(gfli_basket[gfli_basket %in% input$Agg_options,measureditemcpc]))))
}
if (!input$aggregation %in% c("sdgregion_code", "gfli_basket")) {
if(input$Agg_options == 'All'){
ctry_choices <- c(unique(CountryGroup[geographicaream49 %in% Base_Prod$geographicaream49,"country",with=F]))
}else{
aggregationNameB = sub("code", "region", input$aggregation )
ctry_choices <- c(unique(CountryGroup[(CountryGroup[[aggregationNameB]] %in% input$Agg_options)&(geographicaream49 %in% Base_Prod$geographicaream49),"country",with=F]))
}
}
if (input$aggregation %in% "sdgregion_code"){
if(input$Agg_options == 'All'){
ctry_choices <- c(unique(CountryGroup[geographicaream49 %in% Base_Prod$geographicaream49,"country",with=F]))
}else{
ctry_choices <- c(unique(CountryGroup[(CountryGroup[['sdg_regions']] %in% input$Agg_options),"country",with=F]))
}
}
if (input$aggregation == "m49_code") {
ctry_choices <- input$Country
}
# else{
# aggregationNameB = sub("code", "region", input$aggregation )
# ctry_choices <- c("All",unique(CountryGroup[CountryGroup[[aggregationNameB]] ==input$Agg_options,"country",with=F]))
# updateSelectInput(session, "Country", choices=ctry_choices, selected ="All")
# }
#
ctry_choices
})
crops <- reactive({
Comm_grp <- production[geographicaream49 %in% unlist(CountryGroup[country %in% unlist(countries()),"m49_code", with=F]),'measureditemcpc',with=F]
if(input$BasketItems != "All"){
Comm_grp <- Comm_grp %>% filter(measureditemcpc %in% unlist(
gfli_basket[gfli_basket%in% input$BasketItems, "measureditemcpc", with=F]))
}
if(input$checkbox_basket ==TRUE){
Comm_grp <- Comm_grp %>% filter(measureditemcpc %in% unlist(
Basket()[(geographicaream49 %in% unlist(CountryGroup[country %in% unlist(countries()),"geographicaream49",with=F])),"measureditemcpc",with=F]))
}
if(!"All" %in% input$itemcpc){
Comm_grp <- Comm_grp %>% filter(measureditemcpc %in% unlist(
FAOCrops[crop %in% unlist(input$itemcpc[input$itemcpc != "All"]), "measureditemcpc", with=F]
))
}
#
#
# else{
# Comm_grp <- FAOCrops[["cpc"]]
# }
unique(unlist(Comm_grp))
})
# #### SDG ###
WeightKeys <- reactive({
if(input$WeightsChoice == "International Dollar Prices (2015)"){
Weights_keys <- c("measureditemcpc")
}
if(input$WeightsChoice == "Calories"){
Weights_keys <- c("geographicaream49","measureditemcpc")
}
Weights_keys
})
basketKeys <- reactive({
if(input$BasketChoice == "Production Value- Top 10 by country (Default SDG)"){
basketKey <- c('geographicaream49', "measureditemcpc")
}
if(input$BasketChoice == "Production Value- Top 10 by World"){
basketKey <- ( "measureditemcpc")
}
# if(input$BasketChoice == 'Top 10 Loss Commodities - by country'){
# basketKeys <- c('geographicaream49', "measureditemcpc")
# }
# if(input$BasketChoice == 'Caloric Value- Top 10 by World' & input$WeightsChoice == "calories"){
# basketKeys <- c('geographicaream49', "measureditemcpc")
# }
#
basketKey
})
#
# #---end of Aggregation Options ---#
# ###### SDG data #####
Weights <- reactive({
if(input$WeightsChoice == "International Dollar Prices (2015)"){
pvail <- unique(intPrice$measureditemcpc)
intPriceSelected <-
intPrice %>%
select(measureditemcpc,timepointyears ,crop, value) %>%
filter(timepointyears == as.numeric(BaseYear[2])-1)
intPriceSelected$itemname <- tolower(intPriceSelected$crop)
weights <- intPriceSelected[, c("itemname","measureditemcpc","value"),with=F]
weights <- as.data.table(weights)
weights[, weightname := input$WeightsChoice ]
#distinct(intPriceSelected,measuredItemCPC)
}
if(input$WeightsChoice == "Quantities"){
pvail <- unique(intPrice$measureditemcpc)
intPriceSelected <-
intPrice %>%
select(measureditemcpc,timepointyears ,crop, value) %>%
filter(timepointyears == as.numeric(BaseYear[2])-1)
intPriceSelected$itemname <- tolower(intPriceSelected$crop)
intPriceSelected$value <- 1
weights <- intPriceSelected[, c("itemname","measureditemcpc","value"),with=F]
weights <- as.data.table(weights)
weights[, weightname := input$WeightsChoice ]
#distinct(intPriceSelected,measuredItemCPC)
}
if(input$WeightsChoice == "Calories"){
Globalkcal1 <- nutrient_table %>% filter(measuredelement == 1001 &timepointyearssp==0)
weights <- Globalkcal1[, c("geographicaream49","measureditemcpc","value"),with=F]
weights$value <-weights$value*1/1000
weights <- weights[!duplicated(weights)]
weights <- as.data.table(weights)
weights[, weightname := input$WeightsChoice ]
}
weights
})
Basket <- reactive({
if(input$BasketChoice == 'Production Value- Top 10 by country (Default SDG)'){
Top10perctry <- DataForIndex() %>%
filter(timepointyears == as.numeric(BaseYear[2])-1) %>%
arrange(geographicaream49, -p0q0)
Top10_VP <- DataForIndex() %>%
filter(timepointyears == as.numeric(BaseYear[2])-1) %>%
group_by(geographicaream49) %>%
dplyr:: summarise(All_p0q0 = sum(p0q0, na.rm = TRUE))
basket <- Top10perctry[ ,head(.SD, 2), by= c('geographicaream49','gfli_basket')]
basket <- basket %>% filter(!is.na(gfli_basket))
basket <- as.data.table(merge(basket,Top10_VP, by =c("geographicaream49"), all.x=TRUE))
basket[,Percent_prod := p0q0/All_p0q0]
}
if(input$BasketChoice == 'Production Value- Top 10 by World'){
Top10Global<- DataForIndex() %>%
filter(timepointyears == as.numeric(BaseYear[2])-1) %>%
group_by(measureditemcpc,gfli_basket) %>%
dplyr:: summarise(All_p0q0 = sum(p0q0, na.rm = TRUE)) %>%
arrange(-All_p0q0)
Top10_VP <- DataForIndex() %>%
filter(timepointyears == as.numeric(BaseYear[2])-1) %>%
group_by(geographicaream49) %>%
dplyr:: summarise(All_p0q0 = sum(p0q0, na.rm = TRUE))
ItemsBasket <- Top10Global[ ,head(.SD, 2), by= c('gfli_basket')]
basket <- DataForIndex() %>% filter((timepointyears == as.numeric(BaseYear[2])-1) & (measureditemcpc %in% unlist(ItemsBasket[!is.na(gfli_basket),measureditemcpc])))
basket <- as.data.table(merge(basket,Top10_VP, by =c("geographicaream49"), all.x=TRUE))
basket[,Percent_prod := p0q0/All_p0q0]
}
if(input$BasketChoice == 'Top 10 Loss Commodities - by country'){
Top10perctry <- DataForIndex() %>%
filter(timepointyears == as.numeric(BaseYear[2])-1) %>%
arrange(geographicaream49, -value_measuredelement_5126)
Top10_VP <- DataForIndex() %>%
filter(timepointyears == as.numeric(BaseYear[2])-1) %>%
group_by(geographicaream49) %>%
dplyr:: summarise(All_p0q0 = sum(p0q0, na.rm = TRUE))
basket <- Top10perctry[ ,head(.SD, 2), by= c('geographicaream49','gfli_basket')]
basket[geographicaream49 == 100,]
basket <- basket %>% filter(!is.na(gfli_basket))
basket <- as.data.table(merge(basket,Top10_VP, by =c("geographicaream49"), all.x=TRUE))
basket[,Percent_prod := p0q0/All_p0q0]
}
if(input$BasketChoice == 'Caloric Value- Top 10 by World' & input$WeightsChoice == "calories"){
Top10perctry <- DataForIndex() %>%
filter(timepointyears == as.numeric(BaseYear[2])-1) %>%
arrange(-p0q0)
basket <- Top10perctry[ ,head(.SD, 2), by= c('geographicaream49','gfli_basket')]
basket <- basket %>% filter(!is.na(gfli_basket))
basket <- as.data.table(merge(basket,Top10_VP, by =c("geographicaream49"), all.x=TRUE))
basket[,Percent_prod := p0q0/All_p0q0]
}
basket[,basketname := input$BasketChoice ]
basket <-basket[,unique(c("basketname", "country", basketKeys(), "gfli_basket", "value","weightname","p0q0",names(CountryGroup)[seq(2,length(names(CountryGroup)), by=2)][-1])),with=FALSE]
basket
})
FilterBasket <- reactive({
})
DataForIndex <- reactive({
Base_Prod1 <- join(Base_Prod,Weights(), by= WeightKeys(),type= 'left')
Base_Prod1$p0q0 =0
Base_Prod1[, p0q0 := qty_avey1y2*value,]
Base_Prod1 <-Base_Prod1 %>% filter(!is.na(p0q0))
DataForIndex <- merge(Losses[,c(keys_lower,"value_measuredelement_5126"),with=F] , Base_Prod1, by =c("measureditemcpc","geographicaream49"),all.x=T)
DataForIndex$l0ptqt =0
DataForIndex[,l0ptqt:=value_measuredelement_5126*p0q0,with=T]
DataForIndex <- merge(DataForIndex ,gfli_basket , by = c('measureditemcpc'), all.x = T)
DataForIndex <- merge(DataForIndex,CountryGroup, by = c('geographicaream49'), all.x = T)
DataForIndex <- DataForIndex[!is.na(gfli_basket),]
#DataForIndexD <- duplicated(DataForIndex)
})
Top10Global <- reactive({
Top10Global<- DataForIndex() %>%
filter(timepointyears == as.numeric(BaseYear[2])-1) %>%
group_by(measureditemcpc,gfli_basket) %>%
dplyr:: summarise(All_p0q0 = sum(p0q0, na.rm = TRUE)) %>%
arrange(-All_p0q0)
Top10Global<-as.data.table(Top10Global)
})
#
# FLIndex <- reactive({
# FLIndex <- GFLI_SDG_fun(BaseYear,keys_lower,input$aggregation,Basket(),basketKeys(),DataForIndex())
# #FLIndex[,c("Sum_p0qt","Sum_p0q0"):=NULL]
# names(FLIndex)[names(FLIndex) == "Sum_p0qt"] <- "Sum_value_p0qt"
# FLIndex
# })
# #--- End SDG data ----#
##################Data setting############################
### ---- SDG Data Set ----- #####
# dataR <- reactive({
#
# if((input$aggregation == "m49_code") ) {
# if("All" %in% input$Country ){
# FLIndex()[timepointyears %in% seq(input$Year[1],input$Year[2], by=1),]%>%
# arrange(-timepointyears)
# }else{
# FLIndex()%>% filter((timepointyears %in% seq(input$Year[1],input$Year[2], by=1)) &
# (region_code %in% unlist(CountryGroup[country %in% unlist(countries()),"m49_code", with=F])))%>%
# arrange(-timepointyears)
# }
# }
# else if((input$aggregation != "WORLD") & (input$Agg_options != "All")){
# FLIndex()[(timepointyears %in% seq(input$Year[1],input$Year[2], by=1)) &
# (unlist(FLIndex()[, "region_name", with=F]) %in% unlist(input$Agg_options))
# ,]%>%
# arrange(-timepointyears)
# }
# else{
# FLIndex()[timepointyears %in% seq(input$Year[1],input$Year[2], by=1),]%>%
# arrange(-timepointyears)
# }
#
#
# })
##### ---- Model Estimate Dataset ---- ####
# dataR_loss <- reactive({
# if((input$aggregation == "m49_code") ) {
# if("All" %in% input$Country ){
# Losses_Out%>% filter((timepointyears %in% seq(input$Year[1],input$Year[2], by=1))
# )%>% arrange(geographicaream49,-timepointyears)
# }
# if((!"All" %in% input$Country)){
# Losses_Out%>% filter((timepointyears %in% seq(input$Year[1],input$Year[2], by=1)) &
# (geographicaream49 %in% unlist(CountryGroup[country %in% unlist(countries()),"m49_code", with=F])) &
# (measureditemcpc %in% crops())
# )%>%
# arrange(-timepointyears)
# }
# }
# })
dataR_maggs <- reactive({
if("All" %in% input$Country ){
M_aggregates%>% filter((timepointyears %in% seq(input$Year[1],input$Year[2], by=1))
)%>% arrange(geographicaream49,-timepointyears)
}
if((!"All" %in% input$Country)){
M_aggregates%>% filter((timepointyears %in% seq(input$Year[1],input$Year[2], by=1)) &
(geographicaream49 %in% unlist(CountryGroup[country %in% unlist(input$Country),"m49_code", with=F])) &
(measureditemcpc %in% crops())
)%>%
arrange(-timepointyears)
}
})
##### ---- Input Dataset ---- ####
dataR_Input <- reactive({
#if((input$aggregation == "m49_code") ) {
IO <- InputData_Out%>% filter((timepointyears %in% seq(input$Year[1],input$Year[2], by=1)) )%>%
arrange(geographicaream49,-timepointyears)
if("WORLD" %in% input$aggregation){
IO <- IO %>% filter((measureditemcpc %in% crops()))
}
if(!"WORLD" %in% input$aggregation){
IO <- IO %>% filter((geographicaream49 %in% unlist(CountryGroup[country %in% unlist(countries()),"m49_code", with=F]) ) &
(measureditemcpc %in% crops()))
}
if((!"All" %in% input$Country)){
IO <- IO %>% filter((geographicaream49 %in% unlist(CountryGroup[country %in% unlist(input$Country),"m49_code", with=F])) &
(measureditemcpc %in% crops())
)%>%
arrange(-timepointyears)
}
if((!"All" %in% input$BasketItems)){
IO <- IO %>% filter( (gfli_basket %in% input$BasketItems[!input$BasketItems %in% "All"]))
}
if((!"All" %in% input$Stage)){
IO <- IO %>% filter( (fsc_location1 %in% input$Stage[!input$Stage %in% "All"]))
}
if((!"All" %in% input$DataCollect)){
IO <- IO %>% filter( (tag_datacollection %in% input$DataCollect[!input$DataCollect %in% "All"]))
}
IO
#}
})
dataR_Markov <- reactive({
#if((input$aggregation == "m49_code") ) {
if("All" %in% input$Country ){
IO_M <- M_aggregates%>% filter((timepointyears %in% seq(input$Year[1],input$Year[2], by=1))
)%>% arrange(geographicaream49,-timepointyears)
}
if((!"All" %in% input$Country)){
IO_M <- M_aggregates%>% filter((timepointyears %in% seq(input$Year[1],input$Year[2], by=1)) &
(geographicaream49 %in% unlist(CountryGroup[country %in% unlist(input$Country),"m49_code", with=F])) &
(measureditemcpc %in% crops())
)%>%
arrange(-timepointyears)
}
if((!"All" %in% input$Stage)){
IO_M <- IO_M %>% filter( (fsc_location1 %in% input$Stage[!input$Stage %in% "All"]))
}
if((!"All" %in% input$DataCollect)){
IO_M <- IO_M %>% filter( (tag_datacollection %in% input$DataCollect[!input$DataCollect %in% "All"]))
}
IO_M
#}
})
##### ---- Plots ---- ####
flags <-list(
list(target = "I;e", value = list(marker =list(color = 'orange'))),
list(target = "T;-", value = list(marker =list(color = 'blue'))),
list(target = "E;f", value = list(marker =list(color = 'blue'))),
list(target = "M;-", value = list(marker =list(color = 'red'))),
list(target = ";-", value = list(marker =list(color = 'blue'))),
list(target = ";q", value = list(marker =list(color = 'blue'))),
list(target = "T;p", value = list(marker =list(color = 'blue'))),
list(target = ";p", value = list(marker =list(color = 'blue')))
)
colorlist = c("Crimson","LightSeaGreen","SteelBlue",
"MediumOrchid","OrangeRed","DarkGreen" ,
"Tan","RosyBrown","SandyBrown",
"Goldenrod","DarkGoldenrod",
"Peru","Chocolate","SaddleBrown",
"Sienna","Brown","Maroon")
l1 <- unique(InputData_Out$fsc_location1)
l2 <- unique(InputData_Out$tag_datacollection)
tags <- list()
for( nn in 1:length(l2)){
tags[[nn]] <- list(target = l2[nn], value = list(marker =list(color =colorlist[nn])))
}
plotly_Input = function(){
#### Plots the SDG at different aggregations ###
trace_names = unique(dataR()[["region_name"]])
trace1 = dataR()[region_name %in% trace_names[1],]
p <-plot_ly(y=trace1$FLP, x= trace1$timepointyears , type="scatter", mode="markers+lines",name = trace_names[1] )
if(length(trace_names)>1){
for (nm in 2:length(trace_names)){
trace2 = dataR()[region_name %in% trace_names[nm],]
p <-p%>% add_trace(y=trace2$FLP, x= trace2$timepointyears , type="scatter", mode="markers+lines",name = trace_names[nm] )
}}
p
}
# plotly_Input2 = function(){
# #### Plots the loss estimates for different aggregations
# trace_namesa = unique(dataR_loss()[["geographicaream49"]])
# trace_namesb = unique(dataR_loss()[["measureditemcpc"]]) #crops()
#
# trace1 = dataR_loss() %>% filter((geographicaream49 %in% trace_namesa[1]) & (measureditemcpc %in% trace_namesb[1]))
# crop_name = unlist(FAOCrops[cpc == trace_namesb[1],"crop",with=F])
# ctry_name = unlist(CountryGroup[geographicaream49 == trace_namesa[1], "country",with=F ])
# hovertext = unlist(dataR_loss()[geographicaream49 %in% trace_namesa[1] & measureditemcpc %in% trace_namesb[1],"flagcombo",with=F])
#
# p <-plot_ly(y=trace1$value_measuredelement_5126, x= trace1$timepointyears ,text=hovertext, showlegend = TRUE, type="scatter", mode="lines", name = paste(ctry_name,crop_name,sep=" - "))
# if(input$checkboxflags){
# p <- p %>% add_trace(y=trace1$value_measuredelement_5126, x= trace1$timepointyears,text=hovertext, showlegend =FALSE, type="scatter", mode="markers", text = trace1$flagcombo,
# transforms =list(
# list(
# type = 'groupby',
# groups = trace1$flagcombo,
# styles = flags
# )),
# name = paste(ctry_name,crop_name,sep=" - ") )
# }
#
# ##### Challenges here for crop commodity combos less than 1 <>
# # if((length(trace_namesa)>1) ){
# # ## Multiple countries ###
# # for (nm in 1:length(trace_namesa)){
# # for (nmt in 2:length(trace_namesb)){
# # trace2 = dataR_loss() %>% filter((geographicaream49 %in% trace_namesa[nm]) & (measureditemcpc %in% trace_namesb[nmt]))
# # crop_name = unlist(FAOCrops[cpc %in% trace_namesb[nmt],"crop",with=F])
# # ctry_name = unlist(CountryGroup[geographicaream49 %in% trace_namesa[nm], "country",with=F ])
# # hovertext = unlist(dataR_loss()[geographicaream49 %in% trace_namesa[nm] & measureditemcpc %in% trace_namesb[nmt],"flagcombo",with=F])
# # if(length(trace2)>1){
# # p <-p%>% add_trace(y=trace2$value_measuredelement_5126, x= trace2$timepointyears , showlegend = TRUE, type="scatter", mode="lines",text=hovertext,name = paste(ctry_name,crop_name,sep=" - "))
# # }else{
# # p <-p
# # }
# # if(input$checkboxflags){
# # p <- p %>% add_trace(y=trace2$value_measuredelement_5126, x= trace2$timepointyears,text=hovertext, showlegend = FALSE, type="scatter", mode="markers", text = trace2$flagcombo,
# # transforms =list(
# # list(
# # type = 'groupby',
# # groups = trace2$flagcombo,
# # styles = flags
# # )),
# # name = paste(ctry_name,crop_name,sep=" - ") )
# # }
# # }}
# # }else{
# # for (nmt in 2:length(trace_namesb)){
# # trace2 = dataR_loss()[geographicaream49 %in% trace_namesa[1] & measureditemcpc %in% trace_namesb[nmt],]
# # crop_name = unlist(FAOCrops[cpc == trace_namesb[nmt],"crop",with=F])
# # ctry_name = unlist(CountryGroup[geographicaream49 == trace_namesa[1], "country",with=F ])
# # hovertext = unlist(dataR_loss()[geographicaream49 %in% trace_namesa[1] & measureditemcpc %in% trace_namesb[nmt],"flagcombo",with=F])
# #
# #
# # p <-p%>% add_trace(y=trace2$value_measuredelement_5126, x= trace2$timepointyears , showlegend = TRUE , type="scatter", mode="markers+lines",text=hovertext,name = paste(ctry_name,crop_name,sep=" - "))
# # if(input$checkboxflags){
# # p <- p %>% add_trace(y=trace2$value_measuredelement_5126, x= trace2$timepointyears, type="scatter", showlegend = FALSE, mode="markers",
# # transforms =list(
# # list(
# # type = 'groupby',
# # groups = trace2$flagcombo,
# # styles = flags
# # )),
# # name = paste(ctry_name,crop_name,sep=" - ") )
# # }
# #
# # }
# # }
# # # if(input$checkbox_input){
# # if(nrow(InputData_Out)>0){
# # trace3 <- dataR_Input()
# # p <- p %>% add_trace(y= trace3$loss_per_clean/100, x= trace3$timepointyears, type="scatter", showlegend = FALSE, mode="markers",
# # text = ~paste('Crop: ', trace3$crop,
# # '</br> Location: ', trace3$fsc_location1,
# # '</br> Method of Data Collection: ', trace3$method_datacollection,
# # '</br> Data Tag: ', trace3$tag_datacollection,
# # '</br> Reference: ', trace3$ reference
# # ),
# # transforms =list(
# # list(
# # type = 'groupby',
# # groups = trace3$tag_datacollection,
# # styles = tags
# # )),
# # name = paste(ctry_name,crop_name,sep=" - ") )
# #
# # }
# # }
# #
# p
# }
plotly_Input3 = function(){
#### Plots the loss estimates for different aggregations
if(nrow(InputData_Out)>0){
trace3 <- dataR_Input()
p <-plot_ly(trace3 )
p <- p %>% add_trace(y= trace3$loss_per_clean, x= trace3$timepointyears, type="scatter", showlegend = TRUE, mode="markers",
text = ~paste('Crop: ', trace3$crop,
'</br> Country: ', trace3$country,
'</br> Location: ', trace3$fsc_location1,
'</br> Method of Data Collection: ', trace3$method_datacollection,
'</br> Data Tag: ', trace3$tag_datacollection,
'</br> Reference: ', trace3$reference,
'</br> Link: ', trace3$url
),
transforms =list(
list(
type = 'groupby',
groups = trace3$tag_datacollection,
styles = tags
)),
legendgroup = trace3$tag_datacollection)
}
# if(input$checkboxflags){
# trace4 <- dataR_loss()
# p <- p %>% add_trace(y= trace4$value_measuredelement_5126, x= trace4$timepointyears, type="scatter", showlegend = T, mode="markers",
# text = ~paste('Crop: ', trace4$crop,
# '</br> Country: ', trace4$country,
# '</br> Flag: ', trace4$flagcombo
#
# ),
# transforms =list(
# list(
# type = 'groupby',
# groups = trace4$flagcombo,
# styles = flags
# )))
# }
p
}
################ Heat Map #######################
DataAgg2 = function(){
if("WORLD" %in% input$aggregation){
hm <- dataR_Input()%>%
group_by_(.dots = list("gfli_basket", "measureditemcpc","country")) %>%
dplyr:: summarise(Number_Obs = n()) %>%
arrange( gfli_basket)
}
if(!"WORLD" %in% input$aggregation){
hm <- dataR_Input() %>%
group_by_(.dots = list("gfli_basket",input$aggregation, "measureditemcpc","country")) %>%
dplyr:: summarise(Number_Obs = n()) %>%
arrange(gfli_basket)
}
countT <- as.data.table(hm)
countT <- merge(countT,FAOCrops[,c("measureditemcpc", "crop"),with=F], by= c("measureditemcpc"), all.x= T)
countT
}
output$plot_ly_heat <- renderPlotly({
trace5 <- DataAgg2()
p <-plot_ly(trace5, y=~country, x= ~crop, z= ~Number_Obs, type="heatmap",
text = ~paste('</br> Crop: ', trace5$crop,
'</br> Country: ', trace5$country,
'</br> Number of Obs: ', trace5$Number_Obs
),
hoverinfo = 'text'
)
p%>%layout(
xaxis = list(
title = "Geographic Area",
titlefont = f,
dtick = 1
),
yaxis = list(
title = "Commodity",
tickformat = ".2%",
titlefont = f
),
margin = list(l =80, r = 50, t = 20, b = 100),
annotations = list(text = lab(),
font = list(size = 12),
showarrow = FALSE,
align='right',
xref = 'paper', x = -Amarg+.3,
yref = 'paper', y = Bmarg-.1),
autosize = TRUE,
legend = list(orientation = 'l'),
height = 800
)
})
################ Box Plot #######################
output$plot_ly_box <- renderPlotly({
#### Plots the loss estimates for different aggregations
if(nrow(InputData_Out)>0){
listorder <- c("Pre-Harvest","Harvest" ,"Producer","Grading","Storage","Transport","Traders","Processing","Packaging","Distribution",
"Wholesale","Retail","Resturants","Consumer","Export" )
trace4 <- dataR_Input() %>% filter(fsc_location1 %in% listorder)
trace4 <- trace4[order(factor(trace4$fsc_location1,levels=listorder)),]
trace4a <- trace4 %>% filter(fsc_location1 %in% listorder[1])
p <-plot_ly(y = trace4a$loss_per_clean, color = trace4a$fsc_location1, type = "box",
marker = list(color = colorlist[1]),
line = list(color = colorlist[1]))
for (nm in 2:length(listorder)){
trace5 = trace4 %>% filter(fsc_location1 %in% listorder[nm])
p <- p %>% add_trace(y = trace5$loss_per_clean, color = trace5$fsc_location1, type = "box",
marker = list(color = colorlist[nm]),
line = list(color = colorlist[nm])
)
}
p %>%layout(
xaxis = list(
title = "Value Chain Stage",
titlefont = f,
dtick = 1
),
yaxis = list(
title = "Loss %",
tickformat = ".2%",
titlefont = f
),
margin = list(l =80, r = 50, t = 20, b = 100),
annotations = list(text = lab(),
font = list(size = 12),
showarrow = FALSE,
align='right',
xref = 'paper', x = Amarg,
yref = 'paper', y = Bmarg),
autosize = TRUE,
legend = list(orientation = "h",
xanchor = "center", # use center of legend as anchor
x = 0.5),
height = 800
)
p
}
})
#---- end Graphs ------- ##
lab <- reactive({
paste("Source: FAO",
paste("Date: ",as.character(Sys.time()),sep=""),
paste("Aggregation: ",input$aggregation,sep=""),
paste("Aggregation Option: ",input$Agg_options,sep=""),
paste("Country : ",input$Country,sep=""),
paste("Commodity Aggregation: ",input$BasketItems,sep="")
,sep="\n")
})
MetaDataOut <- reactive({
meta <- as.data.table(rbind("Source: FAO",
paste("Date: ",as.character(Sys.time()),sep=""),
paste("Weight: ",input$WeightsChoice,sep=""),
paste("Aggregation: ",input$aggregation,sep=""),
paste("Aggregation Option: ",input$Agg_options,sep=""),
paste("Country : ",input$Country,sep=""),
paste("Commodity Aggregation: ",input$BasketItems,sep="")
))
meta
})
Amarg = .98
Bmarg = -.3
plotsF <- function() {renderPlotly({
if(input$Model_Level == "SDG-Food Loss Percentage"){
plotly_Input()%>%layout(
xaxis = list(
title = "Years",
titlefont = f,
range = c(seq(input$Year[1],input$Year[2], by=1)),
dtick = 1
),
yaxis = list(
title = paste0(c(rep(" ", 20),
"Percentage",
rep(" ", 20),
rep("\n ", 3)),
collapse = ""),
tickformat = ".2%",
titlefont = f,
range = c(input$min_ax, input$max_ax)
),
margin = list(l =80, r = 50, t = 20, b = 100),
annotations = list(text = lab(),
font = list(size = 12),
showarrow = FALSE,
align='right',
xref = 'paper', x = Amarg,
yref = 'paper', y = Bmarg),
autosize = TRUE,
legend = list(orientation = 'l')
)
}
# else if(input$Model_Level == "Model Estimates"){
# plotly_Input2()%>%layout(
# xaxis = list(
# title = "Years",
# titlefont = f,
# range = c(seq(input$Year[1],input$Year[2], by=1)),
# dtick = 1
#
# ),
# yaxis = list(
# title = paste0(c(rep(" ", 20),
# "Percentage",
# rep(" ", 20),
# rep("\n ", 3)),
# collapse = ""),
# tickformat = ".2%",
# titlefont = f
# ),
# margin = list(l =80, r = 50, t = 20, b = 80),
# annotations = list(text = lab(),
# font = list(size = 12),
# showarrow = FALSE,
#
# align='right',
# xref = 'paper', x=Amarg,
# yref = 'paper', y = Bmarg),
# autosize = TRUE,
# legend = list(orientation = 'l')
# )
# }
else if(input$Model_Level == "Input Data"){
plotly_Input3()%>%layout(
xaxis = list(
title = "Years",
titlefont = f,
range = c(seq(input$Year[1],input$Year[2], by=1)),
dtick = 1
),
yaxis = list(
title = paste0(c(rep(" ", 20),
"Percentage",
rep(" ", 20),
rep("\n ", 3)),
collapse = ""),
#tickformat = ".2%",
titlefont = f
),
margin = list(l =80, r = 50, t = 20, b = 200),
annotations = list(text = lab(),
font = list(size = 12),
showarrow = FALSE,
align='right',
xref = 'paper', x = Amarg,
yref = 'paper', y = Bmarg),
autosize = TRUE,
legend = list(legend = list(x = 100, y = 0.5)),
height = 800
)
}
else{
plot_ly(y=0, x=0)
}
})
}
output$plot_ly <-({
plotsF()
})
##########Other Tabs#################
WeightAgg = function() {
Wt = merge(Weights(),gfli_basket[,c("measureditemcpc" , "gfli_basket"),with=F], by = ("measureditemcpc"), all.x =T, all.y=F)
if(input$BasketItems != 'All'){
Wt %>% filter(gfli_basket %in% input$BasketItems)
}else{Wt}
}
BasketAgg = function() {
if((input$Country != 'All')){
Basket()%>% filter((geographicaream49 %in% as.numeric(unlist(CountryGroup[country %in% input$Country,"geographicaream49",with=F]))))
}
else if(input$BasketItems != 'All'){
Basket()%>% filter(gfli_basket %in% input$BasketItems)
}
else if((input$Country != 'All') & (input$BasketItems != 'All')){
Basket()%>% filter((gfli_basket %in% input$BasketItems) & (geographicaream49 %in% as.numeric(unlist(CountryGroup[country %in% input$Country,"geographicaream49",with=F]))))
}
else{Basket()}
}
IndexAgg = function(){
dataR()
}
DataAgg = function(){
countT <- dataR_maggs() %>%
group_by_(.dots = list("measureditemcpc")) %>%
dplyr:: summarise(Number_Obs = n())
countT <- as.data.table(countT)
countT
}
DataINOutput <- function()({
a <- dataR_Input()
# setnames(a, old = c("geographicaream49","isocode","country","region","measureditemcpc","crop","timepointyears","loss_per_clean","percentage_loss_of_quantity",
# "loss_quantity","loss_qualitiative","loss_monetary",
# "activity","fsc_location","periodofstorage","treatment","causeofloss","samplesize",
# "units","method_datacollection","tag_datacollection","reference","url"),
# new = c("geographicaream49","isocode","Country","Region","measureditemcpc","Crop","Year","loss_per_clean","Range of Quantity Loss (%)",
# "Loss (quantity, tons)","Loss (Qualitative, tons)","Loss (Monetary, LCU)",
# "Activity","Stage","period of storage","treatment","Causes of loss","Sample Size",
# "Sampling Units","Method of Data Collection","Data Collection Tag","Reference","Url"))
#
# a[ ,c("geographicaream49","Country","Region","measureditemcpc","Crop","Year","Stage","Average Quantity Loss (%)",
# "Loss (quantity, tons)","Loss (Qualitative, tons)","Loss (Monetary, LCU)","Causes of loss","Activity",
# "period of storage","treatment","Sampling Units","Method of Data Collection","Data Collection Tag","Reference","Url"),with=FALSE]
#
a[, c("geographicaream49","country","region","measureditemcpc","crop","timepointyears","loss_per_clean","percentage_loss_of_quantity",
"loss_quantity","loss_qualitiative","loss_monetary",
"activity","fsc_location1","periodofstorage","treatment","causeofloss","samplesize",
"units","method_datacollection","tag_datacollection","reference","url"),with=F]
})
output$DataTab = DT::renderDataTable({
DataINOutput()
})
output$WeightsOut = DT::renderDataTable({
WeightAgg()
})
output$BasketsOut = DT::renderDataTable({
BasketAgg()
})
output$IndexOut = DT::renderDataTable({
IndexAgg()
})
output$Maggregrates = DT::renderDataTable({
DataAgg()
})
##############Downloadables ###################
output$Data.csv <- downloadHandler(
filename = function(){
paste("Data", ".csv", sep = "")
},
content = function(file) {
write.csv(DataINOutput(), file, row.names = FALSE, na = "")
}
)
# output$SDG12_3_Plot.jpeg <- downloadHandler(
# filename = function(){paste("FAO_SDG123_Plot_", ".jpeg", sep = "")},
# content = function(file) {
# ggsave(file, plot = plotsF(), dpi = 300, units = "mm", device = "jpeg")
# }
# )
# output$FLP.xlsx <- downloadHandler(
# filename = function(){
# paste("FLP", ".xlsx", sep = "")
# },
# content = function(file) {
# # write.xlsx2(FLIndex(), file, sheetName = input$aggregation,
# # col.names = TRUE, row.names = FALSE, append = TRUE)
# write.xlsx2(MetaDataOut(), file, sheetName = "Meta Data",
# col.names = F, row.names = FALSE, append = TRUE)
#
# }
# )
############Check Data ####################
obsB <- observe({
listorder <- c("Pre-Harvest","Harvest" ,"Producer","Grading","Storage","Transport","Traders","Processing","Packaging","Distribution",
"Wholesale","Retail","Resturants","Consumer","Export" )
trace4 <- dataR_Input() %>% filter(fsc_location1 %in% listorder)
# print(Basket()[(geographicaream49 %in% unlist(CountryGroup[country %in% unlist(countries()),"geographicaream49",with=F])),"measureditemcpc",with=F])
# # print(input$Agg_options)
# #print(FLIndex())
# print( countries())
print(trace4 %>% filter(fsc_location1 %in% listorder[2])
)
})
})
SWS-Methodology/faoswsLoss documentation built on Dec. 31, 2019, 12:02 p.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.
#
# This is the server logic of a Shiny web application. You can run the
# application by clicking 'Run App' above.
#
# Find out more about building applications with Shiny here:
#
# http://shiny.rstudio.com/
#
library(shiny)
library(ggplot2)
library(plyr)
library(dplyr)
library(DT)
library(magrittr)
library(data.table)
library(plotly)
#load("~/faoswsLossa/shiny/Soup2Nuts/data_InternalFAO_jan.RData")
# token <- readRDS("token.rds")
# # Then pass the token to each drop_ function
# drop_acc(dtoken = token)
# drop_download("data_InternalFAO_jan.RData" , path = "shiny", overwrite = TRUE)
load("data_InternalFAO_marc26.RData")
InputData_Out[fsc_location == "Havest", "fsc_location" ] <- "Harvest"
InputData_Out[fsc_location == "Trader", "fsc_location" ] <- "Traders"
InputData_Out[fsc_location == "Farm", "fsc_location" ] <- "Producer"
InputData_Out[fsc_location == "SWS_Total", "fsc_location" ] <- "Total Supply Chain Estimate"
InputData_Out[fsc_location == "WholeSupplyChain", "fsc_location" ] <- "Total Supply Chain Estimate"
InputData_Out[tag_datacollection == "FBS/APQ", "tag_datacollection" ] <- "Food Balance Sheet/Ag. Production Questionnaire"
InputData_Out[tag_datacollection == "LitReview", "tag_datacollection" ] <- "Secondary Sources cited in Documents"
InputData_Out[tag_datacollection == "SWS", "tag_datacollection" ] <- "FAO Sources"
InputData_Out[tag_datacollection == "NationalStatsYearbook", "tag_datacollection" ] <- "National Statistics Yearbook"
InputData_Out[tag_datacollection == "NonProtected", "tag_datacollection" ] <- "FAO Sources"
InputData_Out[tag_datacollection == "NP", "tag_datacollection" ] <- "Secondary Sources cited in Documents"
InputData_Out[tag_datacollection == "", "tag_datacollection" ] <- "-"
InputData_Out[tag_datacollection == "NationalAcctSys", "tag_datacollection" ] <- "National Acctounts"
InputData_Out[tag_datacollection == "Crop-Cutting", "tag_datacollection" ] <- "Crop Cutting Field Experiment"
InputData_Out[reference == "SWS", "reference"] <- "FAO Sources"
InputData_Out[grep("WRAP",reference), "reference"] <- "WRAP, 2011"
shinyServer(function(input, output, session) {
##### Aggregation Options ####
observe({
if(input$aggregation == "WORLD") {
Agg_choices <- c("All")
updateSelectInput(session, "Agg_options",choices=Agg_choices, selected ="All")
}
if(input$aggregation == "m49_code") {
Agg_choices <- c("All")
updateSelectInput(session, "Agg_options", choices=Agg_choices, selected ="All")
}
if(!input$aggregation %in% c("sdgregion_code", "gfli_basket","m49_code")){
aggregationNameC = sub("code", "region", input$aggregation )
Agg_choices <- c("All",unique(CountryGroup[[aggregationNameC]]))
Agg_choices <- Agg_choices[! is.na(Agg_choices)]
updateSelectInput(session, "Agg_options", choices=Agg_choices, selected ="All")
}
if(length(grep("sdg+", input$aggregation ))>0){
Agg_choices <- c("All",unique(CountryGroup[["sdg_regions"]]))
updateSelectInput(session, "Agg_options", choices=Agg_choices, selected ="All")
}
if(input$aggregation == "gfli_basket") {
Agg_choices <- c("All",unique(na.omit(gfli_basket[,gfli_basket])))
updateSelectInput(session, "Agg_options", choices=Agg_choices, selected ="All")
}
})
observe({
if (input$aggregation == "WORLD") {
ctry_choices <- c("All")
updateSelectInput(session, "Country", choices=ctry_choices, selected ="All")
}
if (input$aggregation == "gfli_basket") {
ctry_choices <- c("All",unlist(na.omit(unique(gfli_basket[gfli_basket %in% input$Agg_options,measureditemcpc]))))
updateSelectInput(session, "Country", choices=ctry_choices, selected ="All")
}
if (!input$aggregation %in% c("sdgregion_code", "gfli_basket")) {
if(input$Agg_options == 'All'){
ctry_choices <- c("All",c(unique(CountryGroup[geographicaream49 %in% Base_Prod$geographicaream49,"country",with=F])))
updateSelectInput(session, "Country", choices=ctry_choices, selected = "All")
}else{
aggregationNameB = sub("code", "region", input$aggregation )
ctry_choices <- c("All",c(unique(CountryGroup[(CountryGroup[[aggregationNameB]] %in% input$Agg_options)&(geographicaream49 %in% Base_Prod$geographicaream49),"country",with=F])))
updateSelectInput(session, "Country", choices=ctry_choices, selected = "All")
}
}
if (input$aggregation %in% "sdgregion_code"){
if(input$Agg_options == 'All'){
ctry_choices <- c("All",c(unique(CountryGroup[geographicaream49 %in% Base_Prod$geographicaream49,"country",with=F])))
}else{
ctry_choices <- c("All",c(unique(CountryGroup[(CountryGroup[['sdg_regions']] %in% input$Agg_options),"country",with=F])))
}
updateSelectInput(session, "Country", choices=ctry_choices, selected = "All")
}
if (input$aggregation == "m49_code") {
ctry_choices <- c("All",unlist(CountryGroup[["m49_region"]]))
updateSelectInput(session, "Country", choices=ctry_choices, selected ="Italy")
}
# else{
# aggregationNameB = sub("code", "region", input$aggregation )
# ctry_choices <- c("All",unique(CountryGroup[CountryGroup[[aggregationNameB]] ==input$Agg_options,"country",with=F]))
# updateSelectInput(session, "Country", choices=ctry_choices, selected ="All")
# }
#
})
observe({
cpcs <- FAOCrops[measureditemcpc %in% unlist(ConvFactor1$measureditemcpc),]
if(input$BasketItems != "All"){
cpcs <- cpcs[measureditemcpc %in% unlist(gfli_basket[gfli_basket%in% input$BasketItems, "measureditemcpc", with=F])]
}
if(input$checkbox_basket ==TRUE){
cpcs <- cpcs[measureditemcpc %in% unlist(crops()),]
}
cpcs <- sort(unlist(cpcs[['crop']]))
cpcs <- c("All",cpcs)
updateSelectInput(session, "itemcpc", choices=cpcs, selected ="All")
})
# observe({
# if (input$aggregation == "m49_code") {
# mod_choices <- c("SDG-Food Loss Percentage", "Model Estimates", "Input Data")
# updateSelectInput(session, "Model_Level", choices=mod_choices, selected ="SDG-Food Loss Percentage")
# }else{
# mod_choices <- c("SDG-Food Loss Percentage")
# mod_choices <- c("SDG-Food Loss Percentage", "Input Data")
# updateSelectInput(session, "Model_Level", choices=mod_choices, selected ="SDG-Food Loss Percentage")
# }
# })
countries <- reactive({
if (input$aggregation == "WORLD") {
ctry_choices <- c(unlist(CountryGroup[["m49_region"]]))
}
if (input$aggregation == "gfli_basket") {
ctry_choices <- c(unlist(na.omit(unique(gfli_basket[gfli_basket %in% input$Agg_options,measureditemcpc]))))
}
if (!input$aggregation %in% c("sdgregion_code", "gfli_basket")) {
if(input$Agg_options == 'All'){
ctry_choices <- c(unique(CountryGroup[geographicaream49 %in% Base_Prod$geographicaream49,"country",with=F]))
}else{
aggregationNameB = sub("code", "region", input$aggregation )
ctry_choices <- c(unique(CountryGroup[(CountryGroup[[aggregationNameB]] %in% input$Agg_options)&(geographicaream49 %in% Base_Prod$geographicaream49),"country",with=F]))
}
}
if (input$aggregation %in% "sdgregion_code"){
if(input$Agg_options == 'All'){
ctry_choices <- c(unique(CountryGroup[geographicaream49 %in% Base_Prod$geographicaream49,"country",with=F]))
}else{
ctry_choices <- c(unique(CountryGroup[(CountryGroup[['sdg_regions']] %in% input$Agg_options),"country",with=F]))
}
}
if (input$aggregation == "m49_code") {
ctry_choices <- input$Country
}
# else{
# aggregationNameB = sub("code", "region", input$aggregation )
# ctry_choices <- c("All",unique(CountryGroup[CountryGroup[[aggregationNameB]] ==input$Agg_options,"country",with=F]))
# updateSelectInput(session, "Country", choices=ctry_choices, selected ="All")
# }
#
ctry_choices
})
crops <- reactive({
Comm_grp <- production[geographicaream49 %in% unlist(CountryGroup[country %in% unlist(countries()),"m49_code", with=F]),'measureditemcpc',with=F]
if(input$BasketItems != "All"){
Comm_grp <- Comm_grp %>% filter(measureditemcpc %in% unlist(
gfli_basket[gfli_basket%in% input$BasketItems, "measureditemcpc", with=F]))
}
if(input$checkbox_basket ==TRUE){
Comm_grp <- Comm_grp %>% filter(measureditemcpc %in% unlist(
Basket()[(geographicaream49 %in% unlist(CountryGroup[country %in% unlist(countries()),"geographicaream49",with=F])),"measureditemcpc",with=F]))
}
if(!"All" %in% input$itemcpc){
Comm_grp <- Comm_grp %>% filter(measureditemcpc %in% unlist(
FAOCrops[crop %in% unlist(input$itemcpc[input$itemcpc != "All"]), "measureditemcpc", with=F]
))
}
#
#
# else{
# Comm_grp <- FAOCrops[["cpc"]]
# }
unique(unlist(Comm_grp))
})
# #### SDG ###
WeightKeys <- reactive({
if(input$WeightsChoice == "International Dollar Prices (2015)"){
Weights_keys <- c("measureditemcpc")
}
if(input$WeightsChoice == "Calories"){
Weights_keys <- c("geographicaream49","measureditemcpc")
}
Weights_keys
})
basketKeys <- reactive({
if(input$BasketChoice == "Production Value- Top 10 by country (Default SDG)"){
basketKey <- c('geographicaream49', "measureditemcpc")
}
if(input$BasketChoice == "Production Value- Top 10 by World"){
basketKey <- ( "measureditemcpc")
}
# if(input$BasketChoice == 'Top 10 Loss Commodities - by country'){
# basketKeys <- c('geographicaream49', "measureditemcpc")
# }
# if(input$BasketChoice == 'Caloric Value- Top 10 by World' & input$WeightsChoice == "calories"){
# basketKeys <- c('geographicaream49', "measureditemcpc")
# }
#
basketKey
})
#
# #---end of Aggregation Options ---#
# ###### SDG data #####
Weights <- reactive({
if(input$WeightsChoice == "International Dollar Prices (2015)"){
pvail <- unique(intPrice$measureditemcpc)
intPriceSelected <-
intPrice %>%
select(measureditemcpc,timepointyears ,crop, value) %>%
filter(timepointyears == as.numeric(BaseYear[2])-1)
intPriceSelected$itemname <- tolower(intPriceSelected$crop)
weights <- intPriceSelected[, c("itemname","measureditemcpc","value"),with=F]
weights <- as.data.table(weights)
weights[, weightname := input$WeightsChoice ]
#distinct(intPriceSelected,measuredItemCPC)
}
if(input$WeightsChoice == "Quantities"){
pvail <- unique(intPrice$measureditemcpc)
intPriceSelected <-
intPrice %>%
select(measureditemcpc,timepointyears ,crop, value) %>%
filter(timepointyears == as.numeric(BaseYear[2])-1)
intPriceSelected$itemname <- tolower(intPriceSelected$crop)
intPriceSelected$value <- 1
weights <- intPriceSelected[, c("itemname","measureditemcpc","value"),with=F]
weights <- as.data.table(weights)
weights[, weightname := input$WeightsChoice ]
#distinct(intPriceSelected,measuredItemCPC)
}
if(input$WeightsChoice == "Calories"){
Globalkcal1 <- nutrient_table %>% filter(measuredelement == 1001 &timepointyearssp==0)
weights <- Globalkcal1[, c("geographicaream49","measureditemcpc","value"),with=F]
weights$value <-weights$value*1/1000
weights <- weights[!duplicated(weights)]
weights <- as.data.table(weights)
weights[, weightname := input$WeightsChoice ]
}
weights
})
Basket <- reactive({
if(input$BasketChoice == 'Production Value- Top 10 by country (Default SDG)'){
Top10perctry <- DataForIndex() %>%
filter(timepointyears == as.numeric(BaseYear[2])-1) %>%
arrange(geographicaream49, -p0q0)
Top10_VP <- DataForIndex() %>%
filter(timepointyears == as.numeric(BaseYear[2])-1) %>%
group_by(geographicaream49) %>%
dplyr:: summarise(All_p0q0 = sum(p0q0, na.rm = TRUE))
basket <- Top10perctry[ ,head(.SD, 2), by= c('geographicaream49','gfli_basket')]
basket <- basket %>% filter(!is.na(gfli_basket))
basket <- as.data.table(merge(basket,Top10_VP, by =c("geographicaream49"), all.x=TRUE))
basket[,Percent_prod := p0q0/All_p0q0]
}
if(input$BasketChoice == 'Production Value- Top 10 by World'){
Top10Global<- DataForIndex() %>%
filter(timepointyears == as.numeric(BaseYear[2])-1) %>%
group_by(measureditemcpc,gfli_basket) %>%
dplyr:: summarise(All_p0q0 = sum(p0q0, na.rm = TRUE)) %>%
arrange(-All_p0q0)
Top10_VP <- DataForIndex() %>%
filter(timepointyears == as.numeric(BaseYear[2])-1) %>%
group_by(geographicaream49) %>%
dplyr:: summarise(All_p0q0 = sum(p0q0, na.rm = TRUE))
ItemsBasket <- Top10Global[ ,head(.SD, 2), by= c('gfli_basket')]
basket <- DataForIndex() %>% filter((timepointyears == as.numeric(BaseYear[2])-1) & (measureditemcpc %in% unlist(ItemsBasket[!is.na(gfli_basket),measureditemcpc])))
basket <- as.data.table(merge(basket,Top10_VP, by =c("geographicaream49"), all.x=TRUE))
basket[,Percent_prod := p0q0/All_p0q0]
}
if(input$BasketChoice == 'Top 10 Loss Commodities - by country'){
Top10perctry <- DataForIndex() %>%
filter(timepointyears == as.numeric(BaseYear[2])-1) %>%
arrange(geographicaream49, -value_measuredelement_5126)
Top10_VP <- DataForIndex() %>%
filter(timepointyears == as.numeric(BaseYear[2])-1) %>%
group_by(geographicaream49) %>%
dplyr:: summarise(All_p0q0 = sum(p0q0, na.rm = TRUE))
basket <- Top10perctry[ ,head(.SD, 2), by= c('geographicaream49','gfli_basket')]
basket[geographicaream49 == 100,]
basket <- basket %>% filter(!is.na(gfli_basket))
basket <- as.data.table(merge(basket,Top10_VP, by =c("geographicaream49"), all.x=TRUE))
basket[,Percent_prod := p0q0/All_p0q0]
}
if(input$BasketChoice == 'Caloric Value- Top 10 by World' & input$WeightsChoice == "calories"){
Top10perctry <- DataForIndex() %>%
filter(timepointyears == as.numeric(BaseYear[2])-1) %>%
arrange(-p0q0)
basket <- Top10perctry[ ,head(.SD, 2), by= c('geographicaream49','gfli_basket')]
basket <- basket %>% filter(!is.na(gfli_basket))
basket <- as.data.table(merge(basket,Top10_VP, by =c("geographicaream49"), all.x=TRUE))
basket[,Percent_prod := p0q0/All_p0q0]
}
basket[,basketname := input$BasketChoice ]
basket <-basket[,unique(c("basketname", "country", basketKeys(), "gfli_basket", "value","weightname","p0q0",names(CountryGroup)[seq(2,length(names(CountryGroup)), by=2)][-1])),with=FALSE]
basket
})
FilterBasket <- reactive({
})
DataForIndex <- reactive({
Base_Prod1 <- join(Base_Prod,Weights(), by= WeightKeys(),type= 'left')
Base_Prod1$p0q0 =0
Base_Prod1[, p0q0 := qty_avey1y2*value,]
Base_Prod1 <-Base_Prod1 %>% filter(!is.na(p0q0))
DataForIndex <- merge(Losses[,c(keys_lower,"value_measuredelement_5126"),with=F] , Base_Prod1, by =c("measureditemcpc","geographicaream49"),all.x=T)
DataForIndex$l0ptqt =0
DataForIndex[,l0ptqt:=value_measuredelement_5126*p0q0,with=T]
DataForIndex <- merge(DataForIndex ,gfli_basket , by = c('measureditemcpc'), all.x = T)
DataForIndex <- merge(DataForIndex,CountryGroup, by = c('geographicaream49'), all.x = T)
DataForIndex <- DataForIndex[!is.na(gfli_basket),]
#DataForIndexD <- duplicated(DataForIndex)
})
Top10Global <- reactive({
Top10Global<- DataForIndex() %>%
filter(timepointyears == as.numeric(BaseYear[2])-1) %>%
group_by(measureditemcpc,gfli_basket) %>%
dplyr:: summarise(All_p0q0 = sum(p0q0, na.rm = TRUE)) %>%
arrange(-All_p0q0)
Top10Global<-as.data.table(Top10Global)
})
#
# FLIndex <- reactive({
# FLIndex <- GFLI_SDG_fun(BaseYear,keys_lower,input$aggregation,Basket(),basketKeys(),DataForIndex())
# #FLIndex[,c("Sum_p0qt","Sum_p0q0"):=NULL]
# names(FLIndex)[names(FLIndex) == "Sum_p0qt"] <- "Sum_value_p0qt"
# FLIndex
# })
# #--- End SDG data ----#
##################Data setting############################
### ---- SDG Data Set ----- #####
# dataR <- reactive({
#
# if((input$aggregation == "m49_code") ) {
# if("All" %in% input$Country ){
# FLIndex()[timepointyears %in% seq(input$Year[1],input$Year[2], by=1),]%>%
# arrange(-timepointyears)
# }else{
# FLIndex()%>% filter((timepointyears %in% seq(input$Year[1],input$Year[2], by=1)) &
# (region_code %in% unlist(CountryGroup[country %in% unlist(countries()),"m49_code", with=F])))%>%
# arrange(-timepointyears)
# }
# }
# else if((input$aggregation != "WORLD") & (input$Agg_options != "All")){
# FLIndex()[(timepointyears %in% seq(input$Year[1],input$Year[2], by=1)) &
# (unlist(FLIndex()[, "region_name", with=F]) %in% unlist(input$Agg_options))
# ,]%>%
# arrange(-timepointyears)
# }
# else{
# FLIndex()[timepointyears %in% seq(input$Year[1],input$Year[2], by=1),]%>%
# arrange(-timepointyears)
# }
#
#
# })
##### ---- Model Estimate Dataset ---- ####
# dataR_loss <- reactive({
# if((input$aggregation == "m49_code") ) {
# if("All" %in% input$Country ){
# Losses_Out%>% filter((timepointyears %in% seq(input$Year[1],input$Year[2], by=1))
# )%>% arrange(geographicaream49,-timepointyears)
# }
# if((!"All" %in% input$Country)){
# Losses_Out%>% filter((timepointyears %in% seq(input$Year[1],input$Year[2], by=1)) &
# (geographicaream49 %in% unlist(CountryGroup[country %in% unlist(countries()),"m49_code", with=F])) &
# (measureditemcpc %in% crops())
# )%>%
# arrange(-timepointyears)
# }
# }
# })
dataR_maggs <- reactive({
if("All" %in% input$Country ){
M_aggregates%>% filter((timepointyears %in% seq(input$Year[1],input$Year[2], by=1))
)%>% arrange(geographicaream49,-timepointyears)
}
if((!"All" %in% input$Country)){
M_aggregates%>% filter((timepointyears %in% seq(input$Year[1],input$Year[2], by=1)) &
(geographicaream49 %in% unlist(CountryGroup[country %in% unlist(input$Country),"m49_code", with=F])) &
(measureditemcpc %in% crops())
)%>%
arrange(-timepointyears)
}
})
##### ---- Input Dataset ---- ####
dataR_Input <- reactive({
#if((input$aggregation == "m49_code") ) {
IO <- InputData_Out%>% filter((timepointyears %in% seq(input$Year[1],input$Year[2], by=1)) )%>%
arrange(geographicaream49,-timepointyears)
if("WORLD" %in% input$aggregation){
IO <- IO %>% filter((measureditemcpc %in% crops()))
}
if(!"WORLD" %in% input$aggregation){
IO <- IO %>% filter((geographicaream49 %in% unlist(CountryGroup[country %in% unlist(countries()),"m49_code", with=F]) ) &
(measureditemcpc %in% crops()))
}
if((!"All" %in% input$Country)){
IO <- IO %>% filter((geographicaream49 %in% unlist(CountryGroup[country %in% unlist(input$Country),"m49_code", with=F])) &
(measureditemcpc %in% crops())
)%>%
arrange(-timepointyears)
}
if((!"All" %in% input$BasketItems)){
IO <- IO %>% filter( (gfli_basket %in% input$BasketItems[!input$BasketItems %in% "All"]))
}
if((!"All" %in% input$Stage)){
IO <- IO %>% filter( (fsc_location1 %in% input$Stage[!input$Stage %in% "All"]))
}
if((!"All" %in% input$DataCollect)){
IO <- IO %>% filter( (tag_datacollection %in% input$DataCollect[!input$DataCollect %in% "All"]))
}
IO
#}
})
dataR_Markov <- reactive({
#if((input$aggregation == "m49_code") ) {
if("All" %in% input$Country ){
IO_M <- M_aggregates%>% filter((timepointyears %in% seq(input$Year[1],input$Year[2], by=1))
)%>% arrange(geographicaream49,-timepointyears)
}
if((!"All" %in% input$Country)){
IO_M <- M_aggregates%>% filter((timepointyears %in% seq(input$Year[1],input$Year[2], by=1)) &
(geographicaream49 %in% unlist(CountryGroup[country %in% unlist(input$Country),"m49_code", with=F])) &
(measureditemcpc %in% crops())
)%>%
arrange(-timepointyears)
}
if((!"All" %in% input$Stage)){
IO_M <- IO_M %>% filter( (fsc_location1 %in% input$Stage[!input$Stage %in% "All"]))
}
if((!"All" %in% input$DataCollect)){
IO_M <- IO_M %>% filter( (tag_datacollection %in% input$DataCollect[!input$DataCollect %in% "All"]))
}
IO_M
#}
})
##### ---- Plots ---- ####
flags <-list(
list(target = "I;e", value = list(marker =list(color = 'orange'))),
list(target = "T;-", value = list(marker =list(color = 'blue'))),
list(target = "E;f", value = list(marker =list(color = 'blue'))),
list(target = "M;-", value = list(marker =list(color = 'red'))),
list(target = ";-", value = list(marker =list(color = 'blue'))),
list(target = ";q", value = list(marker =list(color = 'blue'))),
list(target = "T;p", value = list(marker =list(color = 'blue'))),
list(target = ";p", value = list(marker =list(color = 'blue')))
)
colorlist = c("Crimson","LightSeaGreen","SteelBlue",
"MediumOrchid","OrangeRed","DarkGreen" ,
"Tan","RosyBrown","SandyBrown",
"Goldenrod","DarkGoldenrod",
"Peru","Chocolate","SaddleBrown",
"Sienna","Brown","Maroon")
l1 <- unique(InputData_Out$fsc_location1)
l2 <- unique(InputData_Out$tag_datacollection)
tags <- list()
for( nn in 1:length(l2)){
tags[[nn]] <- list(target = l2[nn], value = list(marker =list(color =colorlist[nn])))
}
plotly_Input = function(){
#### Plots the SDG at different aggregations ###
trace_names = unique(dataR()[["region_name"]])
trace1 = dataR()[region_name %in% trace_names[1],]
p <-plot_ly(y=trace1$FLP, x= trace1$timepointyears , type="scatter", mode="markers+lines",name = trace_names[1] )
if(length(trace_names)>1){
for (nm in 2:length(trace_names)){
trace2 = dataR()[region_name %in% trace_names[nm],]
p <-p%>% add_trace(y=trace2$FLP, x= trace2$timepointyears , type="scatter", mode="markers+lines",name = trace_names[nm] )
}}
p
}
# plotly_Input2 = function(){
# #### Plots the loss estimates for different aggregations
# trace_namesa = unique(dataR_loss()[["geographicaream49"]])
# trace_namesb = unique(dataR_loss()[["measureditemcpc"]]) #crops()
#
# trace1 = dataR_loss() %>% filter((geographicaream49 %in% trace_namesa[1]) & (measureditemcpc %in% trace_namesb[1]))
# crop_name = unlist(FAOCrops[cpc == trace_namesb[1],"crop",with=F])
# ctry_name = unlist(CountryGroup[geographicaream49 == trace_namesa[1], "country",with=F ])
# hovertext = unlist(dataR_loss()[geographicaream49 %in% trace_namesa[1] & measureditemcpc %in% trace_namesb[1],"flagcombo",with=F])
#
# p <-plot_ly(y=trace1$value_measuredelement_5126, x= trace1$timepointyears ,text=hovertext, showlegend = TRUE, type="scatter", mode="lines", name = paste(ctry_name,crop_name,sep=" - "))
# if(input$checkboxflags){
# p <- p %>% add_trace(y=trace1$value_measuredelement_5126, x= trace1$timepointyears,text=hovertext, showlegend =FALSE, type="scatter", mode="markers", text = trace1$flagcombo,
# transforms =list(
# list(
# type = 'groupby',
# groups = trace1$flagcombo,
# styles = flags
# )),
# name = paste(ctry_name,crop_name,sep=" - ") )
# }
#
# ##### Challenges here for crop commodity combos less than 1 <>
# # if((length(trace_namesa)>1) ){
# # ## Multiple countries ###
# # for (nm in 1:length(trace_namesa)){
# # for (nmt in 2:length(trace_namesb)){
# # trace2 = dataR_loss() %>% filter((geographicaream49 %in% trace_namesa[nm]) & (measureditemcpc %in% trace_namesb[nmt]))
# # crop_name = unlist(FAOCrops[cpc %in% trace_namesb[nmt],"crop",with=F])
# # ctry_name = unlist(CountryGroup[geographicaream49 %in% trace_namesa[nm], "country",with=F ])
# # hovertext = unlist(dataR_loss()[geographicaream49 %in% trace_namesa[nm] & measureditemcpc %in% trace_namesb[nmt],"flagcombo",with=F])
# # if(length(trace2)>1){
# # p <-p%>% add_trace(y=trace2$value_measuredelement_5126, x= trace2$timepointyears , showlegend = TRUE, type="scatter", mode="lines",text=hovertext,name = paste(ctry_name,crop_name,sep=" - "))
# # }else{
# # p <-p
# # }
# # if(input$checkboxflags){
# # p <- p %>% add_trace(y=trace2$value_measuredelement_5126, x= trace2$timepointyears,text=hovertext, showlegend = FALSE, type="scatter", mode="markers", text = trace2$flagcombo,
# # transforms =list(
# # list(
# # type = 'groupby',
# # groups = trace2$flagcombo,
# # styles = flags
# # )),
# # name = paste(ctry_name,crop_name,sep=" - ") )
# # }
# # }}
# # }else{
# # for (nmt in 2:length(trace_namesb)){
# # trace2 = dataR_loss()[geographicaream49 %in% trace_namesa[1] & measureditemcpc %in% trace_namesb[nmt],]
# # crop_name = unlist(FAOCrops[cpc == trace_namesb[nmt],"crop",with=F])
# # ctry_name = unlist(CountryGroup[geographicaream49 == trace_namesa[1], "country",with=F ])
# # hovertext = unlist(dataR_loss()[geographicaream49 %in% trace_namesa[1] & measureditemcpc %in% trace_namesb[nmt],"flagcombo",with=F])
# #
# #
# # p <-p%>% add_trace(y=trace2$value_measuredelement_5126, x= trace2$timepointyears , showlegend = TRUE , type="scatter", mode="markers+lines",text=hovertext,name = paste(ctry_name,crop_name,sep=" - "))
# # if(input$checkboxflags){
# # p <- p %>% add_trace(y=trace2$value_measuredelement_5126, x= trace2$timepointyears, type="scatter", showlegend = FALSE, mode="markers",
# # transforms =list(
# # list(
# # type = 'groupby',
# # groups = trace2$flagcombo,
# # styles = flags
# # )),
# # name = paste(ctry_name,crop_name,sep=" - ") )
# # }
# #
# # }
# # }
# # # if(input$checkbox_input){
# # if(nrow(InputData_Out)>0){
# # trace3 <- dataR_Input()
# # p <- p %>% add_trace(y= trace3$loss_per_clean/100, x= trace3$timepointyears, type="scatter", showlegend = FALSE, mode="markers",
# # text = ~paste('Crop: ', trace3$crop,
# # '</br> Location: ', trace3$fsc_location1,
# # '</br> Method of Data Collection: ', trace3$method_datacollection,
# # '</br> Data Tag: ', trace3$tag_datacollection,
# # '</br> Reference: ', trace3$ reference
# # ),
# # transforms =list(
# # list(
# # type = 'groupby',
# # groups = trace3$tag_datacollection,
# # styles = tags
# # )),
# # name = paste(ctry_name,crop_name,sep=" - ") )
# #
# # }
# # }
# #
# p
# }
plotly_Input3 = function(){
#### Plots the loss estimates for different aggregations
if(nrow(InputData_Out)>0){
trace3 <- dataR_Input()
p <-plot_ly(trace3 )
p <- p %>% add_trace(y= trace3$loss_per_clean, x= trace3$timepointyears, type="scatter", showlegend = TRUE, mode="markers",
text = ~paste('Crop: ', trace3$crop,
'</br> Country: ', trace3$country,
'</br> Location: ', trace3$fsc_location1,
'</br> Method of Data Collection: ', trace3$method_datacollection,
'</br> Data Tag: ', trace3$tag_datacollection,
'</br> Reference: ', trace3$reference,
'</br> Link: ', trace3$url
),
transforms =list(
list(
type = 'groupby',
groups = trace3$tag_datacollection,
styles = tags
)),
legendgroup = trace3$tag_datacollection)
}
# if(input$checkboxflags){
# trace4 <- dataR_loss()
# p <- p %>% add_trace(y= trace4$value_measuredelement_5126, x= trace4$timepointyears, type="scatter", showlegend = T, mode="markers",
# text = ~paste('Crop: ', trace4$crop,
# '</br> Country: ', trace4$country,
# '</br> Flag: ', trace4$flagcombo
#
# ),
# transforms =list(
# list(
# type = 'groupby',
# groups = trace4$flagcombo,
# styles = flags
# )))
# }
p
}
################ Heat Map #######################
DataAgg2 = function(){
if("WORLD" %in% input$aggregation){
hm <- dataR_Input()%>%
group_by_(.dots = list("gfli_basket", "measureditemcpc","country")) %>%
dplyr:: summarise(Number_Obs = n()) %>%
arrange( gfli_basket)
}
if(!"WORLD" %in% input$aggregation){
hm <- dataR_Input() %>%
group_by_(.dots = list("gfli_basket",input$aggregation, "measureditemcpc","country")) %>%
dplyr:: summarise(Number_Obs = n()) %>%
arrange(gfli_basket)
}
countT <- as.data.table(hm)
countT <- merge(countT,FAOCrops[,c("measureditemcpc", "crop"),with=F], by= c("measureditemcpc"), all.x= T)
countT
}
output$plot_ly_heat <- renderPlotly({
trace5 <- DataAgg2()
p <-plot_ly(trace5, y=~country, x= ~crop, z= ~Number_Obs, type="heatmap",
text = ~paste('</br> Crop: ', trace5$crop,
'</br> Country: ', trace5$country,
'</br> Number of Obs: ', trace5$Number_Obs
),
hoverinfo = 'text'
)
p%>%layout(
xaxis = list(
title = "Geographic Area",
titlefont = f,
dtick = 1
),
yaxis = list(
title = "Commodity",
tickformat = ".2%",
titlefont = f
),
margin = list(l =80, r = 50, t = 20, b = 100),
annotations = list(text = lab(),
font = list(size = 12),
showarrow = FALSE,
align='right',
xref = 'paper', x = -Amarg+.3,
yref = 'paper', y = Bmarg-.1),
autosize = TRUE,
legend = list(orientation = 'l'),
height = 800
)
})
################ Box Plot #######################
output$plot_ly_box <- renderPlotly({
#### Plots the loss estimates for different aggregations
if(nrow(InputData_Out)>0){
listorder <- c("Pre-Harvest","Harvest" ,"Producer","Grading","Storage","Transport","Traders","Processing","Packaging","Distribution",
"Wholesale","Retail","Resturants","Consumer","Export" )
trace4 <- dataR_Input() %>% filter(fsc_location1 %in% listorder)
trace4 <- trace4[order(factor(trace4$fsc_location1,levels=listorder)),]
trace4a <- trace4 %>% filter(fsc_location1 %in% listorder[1])
p <-plot_ly(y = trace4a$loss_per_clean, color = trace4a$fsc_location1, type = "box",
marker = list(color = colorlist[1]),
line = list(color = colorlist[1]))
for (nm in 2:length(listorder)){
trace5 = trace4 %>% filter(fsc_location1 %in% listorder[nm])
p <- p %>% add_trace(y = trace5$loss_per_clean, color = trace5$fsc_location1, type = "box",
marker = list(color = colorlist[nm]),
line = list(color = colorlist[nm])
)
}
p %>%layout(
xaxis = list(
title = "Value Chain Stage",
titlefont = f,
dtick = 1
),
yaxis = list(
title = "Loss %",
tickformat = ".2%",
titlefont = f
),
margin = list(l =80, r = 50, t = 20, b = 100),
annotations = list(text = lab(),
font = list(size = 12),
showarrow = FALSE,
align='right',
xref = 'paper', x = Amarg,
yref = 'paper', y = Bmarg),
autosize = TRUE,
legend = list(orientation = "h",
xanchor = "center", # use center of legend as anchor
x = 0.5),
height = 800
)
p
}
})
#---- end Graphs ------- ##
lab <- reactive({
paste("Source: FAO",
paste("Date: ",as.character(Sys.time()),sep=""),
paste("Aggregation: ",input$aggregation,sep=""),
paste("Aggregation Option: ",input$Agg_options,sep=""),
paste("Country : ",input$Country,sep=""),
paste("Commodity Aggregation: ",input$BasketItems,sep="")
,sep="\n")
})
MetaDataOut <- reactive({
meta <- as.data.table(rbind("Source: FAO",
paste("Date: ",as.character(Sys.time()),sep=""),
paste("Weight: ",input$WeightsChoice,sep=""),
paste("Aggregation: ",input$aggregation,sep=""),
paste("Aggregation Option: ",input$Agg_options,sep=""),
paste("Country : ",input$Country,sep=""),
paste("Commodity Aggregation: ",input$BasketItems,sep="")
))
meta
})
Amarg = .98
Bmarg = -.3
plotsF <- function() {renderPlotly({
if(input$Model_Level == "SDG-Food Loss Percentage"){
plotly_Input()%>%layout(
xaxis = list(
title = "Years",
titlefont = f,
range = c(seq(input$Year[1],input$Year[2], by=1)),
dtick = 1
),
yaxis = list(
title = paste0(c(rep(" ", 20),
"Percentage",
rep(" ", 20),
rep("\n ", 3)),
collapse = ""),
tickformat = ".2%",
titlefont = f,
range = c(input$min_ax, input$max_ax)
),
margin = list(l =80, r = 50, t = 20, b = 100),
annotations = list(text = lab(),
font = list(size = 12),
showarrow = FALSE,
align='right',
xref = 'paper', x = Amarg,
yref = 'paper', y = Bmarg),
autosize = TRUE,
legend = list(orientation = 'l')
)
}
# else if(input$Model_Level == "Model Estimates"){
# plotly_Input2()%>%layout(
# xaxis = list(
# title = "Years",
# titlefont = f,
# range = c(seq(input$Year[1],input$Year[2], by=1)),
# dtick = 1
#
# ),
# yaxis = list(
# title = paste0(c(rep(" ", 20),
# "Percentage",
# rep(" ", 20),
# rep("\n ", 3)),
# collapse = ""),
# tickformat = ".2%",
# titlefont = f
# ),
# margin = list(l =80, r = 50, t = 20, b = 80),
# annotations = list(text = lab(),
# font = list(size = 12),
# showarrow = FALSE,
#
# align='right',
# xref = 'paper', x=Amarg,
# yref = 'paper', y = Bmarg),
# autosize = TRUE,
# legend = list(orientation = 'l')
# )
# }
else if(input$Model_Level == "Input Data"){
plotly_Input3()%>%layout(
xaxis = list(
title = "Years",
titlefont = f,
range = c(seq(input$Year[1],input$Year[2], by=1)),
dtick = 1
),
yaxis = list(
title = paste0(c(rep(" ", 20),
"Percentage",
rep(" ", 20),
rep("\n ", 3)),
collapse = ""),
#tickformat = ".2%",
titlefont = f
),
margin = list(l =80, r = 50, t = 20, b = 200),
annotations = list(text = lab(),
font = list(size = 12),
showarrow = FALSE,
align='right',
xref = 'paper', x = Amarg,
yref = 'paper', y = Bmarg),
autosize = TRUE,
legend = list(legend = list(x = 100, y = 0.5)),
height = 800
)
}
else{
plot_ly(y=0, x=0)
}
})
}
output$plot_ly <-({
plotsF()
})
##########Other Tabs#################
WeightAgg = function() {
Wt = merge(Weights(),gfli_basket[,c("measureditemcpc" , "gfli_basket"),with=F], by = ("measureditemcpc"), all.x =T, all.y=F)
if(input$BasketItems != 'All'){
Wt %>% filter(gfli_basket %in% input$BasketItems)
}else{Wt}
}
BasketAgg = function() {
if((input$Country != 'All')){
Basket()%>% filter((geographicaream49 %in% as.numeric(unlist(CountryGroup[country %in% input$Country,"geographicaream49",with=F]))))
}
else if(input$BasketItems != 'All'){
Basket()%>% filter(gfli_basket %in% input$BasketItems)
}
else if((input$Country != 'All') & (input$BasketItems != 'All')){
Basket()%>% filter((gfli_basket %in% input$BasketItems) & (geographicaream49 %in% as.numeric(unlist(CountryGroup[country %in% input$Country,"geographicaream49",with=F]))))
}
else{Basket()}
}
IndexAgg = function(){
dataR()
}
DataAgg = function(){
countT <- dataR_maggs() %>%
group_by_(.dots = list("measureditemcpc")) %>%
dplyr:: summarise(Number_Obs = n())
countT <- as.data.table(countT)
countT
}
DataINOutput <- function()({
a <- dataR_Input()
# setnames(a, old = c("geographicaream49","isocode","country","region","measureditemcpc","crop","timepointyears","loss_per_clean","percentage_loss_of_quantity",
# "loss_quantity","loss_qualitiative","loss_monetary",
# "activity","fsc_location","periodofstorage","treatment","causeofloss","samplesize",
# "units","method_datacollection","tag_datacollection","reference","url"),
# new = c("geographicaream49","isocode","Country","Region","measureditemcpc","Crop","Year","loss_per_clean","Range of Quantity Loss (%)",
# "Loss (quantity, tons)","Loss (Qualitative, tons)","Loss (Monetary, LCU)",
# "Activity","Stage","period of storage","treatment","Causes of loss","Sample Size",
# "Sampling Units","Method of Data Collection","Data Collection Tag","Reference","Url"))
#
# a[ ,c("geographicaream49","Country","Region","measureditemcpc","Crop","Year","Stage","Average Quantity Loss (%)",
# "Loss (quantity, tons)","Loss (Qualitative, tons)","Loss (Monetary, LCU)","Causes of loss","Activity",
# "period of storage","treatment","Sampling Units","Method of Data Collection","Data Collection Tag","Reference","Url"),with=FALSE]
#
a[, c("geographicaream49","country","region","measureditemcpc","crop","timepointyears","loss_per_clean","percentage_loss_of_quantity",
"loss_quantity","loss_qualitiative","loss_monetary",
"activity","fsc_location1","periodofstorage","treatment","causeofloss","samplesize",
"units","method_datacollection","tag_datacollection","reference","url"),with=F]
})
output$DataTab = DT::renderDataTable({
DataINOutput()
})
output$WeightsOut = DT::renderDataTable({
WeightAgg()
})
output$BasketsOut = DT::renderDataTable({
BasketAgg()
})
output$IndexOut = DT::renderDataTable({
IndexAgg()
})
output$Maggregrates = DT::renderDataTable({
DataAgg()
})
##############Downloadables ###################
output$Data.csv <- downloadHandler(
filename = function(){
paste("Data", ".csv", sep = "")
},
content = function(file) {
write.csv(DataINOutput(), file, row.names = FALSE, na = "")
}
)
# output$SDG12_3_Plot.jpeg <- downloadHandler(
# filename = function(){paste("FAO_SDG123_Plot_", ".jpeg", sep = "")},
# content = function(file) {
# ggsave(file, plot = plotsF(), dpi = 300, units = "mm", device = "jpeg")
# }
# )
# output$FLP.xlsx <- downloadHandler(
# filename = function(){
# paste("FLP", ".xlsx", sep = "")
# },
# content = function(file) {
# # write.xlsx2(FLIndex(), file, sheetName = input$aggregation,
# # col.names = TRUE, row.names = FALSE, append = TRUE)
# write.xlsx2(MetaDataOut(), file, sheetName = "Meta Data",
# col.names = F, row.names = FALSE, append = TRUE)
#
# }
# )
############Check Data ####################
obsB <- observe({
listorder <- c("Pre-Harvest","Harvest" ,"Producer","Grading","Storage","Transport","Traders","Processing","Packaging","Distribution",
"Wholesale","Retail","Resturants","Consumer","Export" )
trace4 <- dataR_Input() %>% filter(fsc_location1 %in% listorder)
# print(Basket()[(geographicaream49 %in% unlist(CountryGroup[country %in% unlist(countries()),"geographicaream49",with=F])),"measureditemcpc",with=F])
# # print(input$Agg_options)
# #print(FLIndex())
# print( countries())
print(trace4 %>% filter(fsc_location1 %in% listorder[2])
)
})
})
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.