Reporting tool
Here we are going to create an interactive reporting tool with R and R-shiny
This coding example is a bit more complex than the previous one and is written in R language. Start by 3 main .R files. Extensive and detailed documentation about R-shiny apps can be found here.
ui.R
server.R
global.R
Initially the user interface (ui.R) file is created, where all the functions related to the graphics of the interface are placed. Then we build the server component, which is actually the part all the work behind the scenes. There the functions that create API calls to the answr platform are placed and their response is passed on to generate the plots for visualization. Lastly, the global.R is created, which contains all the libraries to be used by the app.
ui.R
# Choices for drop-downs
templates <- c(
"Climate Statistics (Free)" = "climatestatistics",
"Advanced Climate Statistics (Free)" = "advancedclimatestatistics",
"Natural Disaster (Premium)" = "naturaldisaster"
)
navbarPage("Answr Dashboard API Visualizations", id="nav",
tabPanel("Configuration",
div(class="outer",
tags$head(
# Include our custom CSS
includeCSS("styles.css"),
includeScript("gomap.js")
),
# If not using custom CSS, set height of leafletOutput to a number instead of percent
leafletOutput("map", width="100%", height="100%"),
# Shiny versions prior to 0.11 should use class = "modal" instead.
absolutePanel(id = "controls", class = "panel panel-default", fixed = TRUE,
draggable = TRUE, top = 60, left = "auto", right = 20, bottom = "auto",
width = 330, height = "auto",
h2("Configuration"),
textInput("email", "Email", value = "", width = NULL, placeholder = NULL),
passwordInput("password", "Password", value = "", width = NULL, placeholder = NULL),
selectInput("reporttype", "Report Type", templates),
actionButton("execute", "Create the Report")
),
tags$div(id="cite",
'answr.space'
)
)
),
tabPanel("Generated Report",
titlePanel(textOutput("template")),
plotlyOutput("graph1"),
plotlyOutput("graph2"),
plotlyOutput("graph3")
# sidebarLayout(
# sidebarPanel(
# ),
# mainPanel(
# plotlyOutput("a_con_dry_days"),
# plotlyOutput("a_con_frost_days"),
# plotlyOutput("a_con_wet_days")
# )
#
# )
)
)
server.R
library(RColorBrewer)
library(scales)
library(lattice)
library(dplyr)
login_answr <- function(email, password) {
#Generate the auth token
headers_login = c(
`accept` = 'application/json',
`Content-Type` = 'application/json'
)
data_login = paste0('{\n "email": "',email,'",\n "password": "',password,'"\n}')
login <- httr::POST(url = 'https://api.answr.space/api:auth/auth/login', httr::add_headers(.headers=headers_login), body = data_login)
login <- content(login,"parsed")
}
template_climate_statistics <- function(lat, lon, login) {
#Make the API requests to the data layers for the Climate Statistics template
headers = c(
`accept` = 'application/json',
`Authorization` = paste0('Bearer ',login$authToken)
)
params = list(
`Input_point` = paste0('{"type":"point","data":{"lng":',lon,',"lat":',lat,'}}')
)
a_mean_temp <- httr::GET(url = 'https://api.answr.space/api:climate-variables/a-mean-temp', httr::add_headers(.headers=headers), query = params)
a_mean_temp <- unlist(content(a_mean_temp,"parsed"))
a_prec_flux <- httr::GET(url = 'https://api.answr.space/api:climate-variables/a-prec-flux', httr::add_headers(.headers=headers), query = params)
a_prec_flux <- unlist(content(a_prec_flux,"parsed"))
a_wind_speed <- httr::GET(url = 'https://api.answr.space/api:climate-variables/a-wind-speed', httr::add_headers(.headers=headers), query = params)
a_wind_speed <- unlist(content(a_wind_speed,"parsed"))
#Gather all outputs
list(a_mean_temp, a_prec_flux, a_wind_speed)
}
template_advanced_climate_statistics <- function(lat, lon, login) {
#Make the API requests to the data layers for the Climate Statistics template
headers = c(
`accept` = 'application/json',
`Authorization` = paste0('Bearer ',login$authToken)
)
params = list(
`Input_point` = paste0('{"type":"point","data":{"lng":',lon,',"lat":',lat,'}}')
)
a_con_dry_days <- httr::GET(url = 'https://api.answr.space/api:climate-variables/a-con-dry_days', httr::add_headers(.headers=headers), query = params)
a_con_dry_days <- unlist(content(a_con_dry_days,"parsed"))
a_con_frost_days <- httr::GET(url = 'https://api.answr.space/api:climate-variables/a-con-frost-days', httr::add_headers(.headers=headers), query = params)
a_con_frost_days <- unlist(content(a_con_frost_days,"parsed"))
a_con_wet_days <- httr::GET(url = 'https://api.answr.space/api:climate-variables/a-con-wet-days', httr::add_headers(.headers=headers), query = params)
a_con_wet_days <- unlist(content(a_con_wet_days,"parsed"))
#Gather all outputs
list(a_con_dry_days, a_con_frost_days, a_con_wet_days)
}
template_naturaldisaster <- function(lat, lon, login) {
#Make the API requests to the data layers for the Climate Statistics template
headers = c(
`accept` = 'application/json',
`Authorization` = paste0('Bearer ',login$authToken)
)
params = list(
`Input_point` = paste0('{"type":"point","data":{"lng":',lon,',"lat":',lat,'}}')
)
flood_severity <- httr::GET(url = 'https://api.answr.space/api:natural-disasters/flood_severity', httr::add_headers(.headers=headers), query = params)
flood_severity <- unlist(content(flood_severity,"parsed"))
drought_probability <- httr::GET(url = 'https://api.answr.space/api:natural-disasters/drought_probability', httr::add_headers(.headers=headers), query = params)
drought_probability <- unlist(content(drought_probability,"parsed"))
windstorm_probability<- httr::GET(url = 'https://api.answr.space/api:natural-disasters/windstorm_probability', httr::add_headers(.headers=headers), query = params)
windstorm_probability <- unlist(content(windstorm_probability,"parsed"))
#Gather all outputs
list(flood_severity, drought_probability, windstorm_probability)
}
function(input, output, session) {
# Create the map
output$map <- renderLeaflet({
leaflet() %>%
setView(23.00, 37.45, 4) %>%
addProviderTiles(providers$OpenStreetMap) %>%
addDrawToolbar(
targetGroup='Add Point',
editOptions = editToolbarOptions(selectedPathOptions = selectedPathOptions()), singleFeature = TRUE, markerOptions = TRUE, circleMarkerOptions = FALSE, polylineOptions = FALSE, polygonOptions = FALSE, rectangleOptions = FALSE, circleOptions = FALSE) %>%
addLayersControl(overlayGroups = c('Add Point'), options =
layersControlOptions(collapsed=FALSE)) %>%
addStyleEditor()
})
observeEvent(once = FALSE, input$execute,
{
lon <- input$map_draw_all_features$features[[1]]$geometry$coordinates[[1]]
lat <- input$map_draw_all_features$features[[1]]$geometry$coordinates[[2]]
email <- input$email
password <- input$password
reporttype <- input$reporttype
login <- login_answr(email, password)
if (is.null(lon) || is.null(login$authToken)) {
if (is.null(lon)){
shinyalert("Oops!", "Please add point on the map firt!", type = "error")
}
if (is.null(login$authToken)) {
shinyalert("Oops!", "Please check your login credentials", type = "error")
}
} else {
#Select the appropriate report template
if (input$reporttype == "climatestatistics") {
acs <- template_climate_statistics(lat, lon, login)
template <- "Climatic Statistics"
if (class(unlist(acs[[3]])) == "character" || class(unlist(acs[[2]])) == "character" || class(unlist(acs[[1]])) == "character") {
shinyalert(as.character(unlist(acs[[3]])[1]), type = "error")
} else {
Data_Frame <- data.frame (
Months = c("January", "February", "March", "April", "May", "June", "July", "August", "September", "October", "November", "December"),
a_mean_temp = unlist(acs[[1]]),
a_prec_flux = unlist(acs[[2]]),
a_wind_speed = unlist(acs[[3]])
)
output$template <- renderText({template})
output$graph1 <- renderPlotly({ plot_ly( x = Data_Frame[,"Months"], y = Data_Frame[,"a_mean_temp"]) %>% layout(title = 'Average mean temperature', plot_bgcolor = "#e5ecf6", xaxis = list(title = "Months"), yaxis = list(title = "Kelvin")) })
output$graph2 <- renderPlotly({plot_ly( x = Data_Frame[,"Months"], y = Data_Frame[,"a_prec_flux"]) %>% layout(title = 'Average precipitation flux', plot_bgcolor = "#e5ecf6", xaxis = list(title = "Months"), yaxis = list(title = "mm per day")) })
output$graph3 <- renderPlotly({ plot_ly( x = Data_Frame[,"Months"], y = Data_Frame[,"a_wind_speed"]) %>% layout(title = 'Average wind speed', plot_bgcolor = "#e5ecf6", xaxis = list(title = "Months"), yaxis = list(title = "meters/second")) })
}
}
if (input$reporttype == "advancedclimatestatistics") {
acs <- template_advanced_climate_statistics(lat, lon, login)
template <- "Advanced Climatic Statistics"
if (class(unlist(acs[[3]])) == "character" || class(unlist(acs[[2]])) == "character" || class(unlist(acs[[1]])) == "character") {
shinyalert(as.character(unlist(acs[[3]])[1]), type = "error")
} else {
Data_Frame <- data.frame (
Months = c("January", "February", "March", "April", "May", "June", "July", "August", "September", "October", "November", "December"),
a_con_dry_days = unlist(acs[[1]]),
a_con_frost_days = unlist(acs[[2]]),
a_con_wet_days = unlist(acs[[3]])
)
output$template <- renderText({template})
output$graph1 <- renderPlotly({ plot_ly( x = Data_Frame[,"Months"], y = Data_Frame[,"a_con_dry_days"]) %>% layout(title = 'Average consecutive dry days', plot_bgcolor = "#e5ecf6", xaxis = list(title = "Months"), yaxis = list(title = "Days")) })
output$graph2 <- renderPlotly({plot_ly( x = Data_Frame[,"Months"], y = Data_Frame[,"a_con_frost_days"]) %>% layout(title = 'Average consecutive frost days', plot_bgcolor = "#e5ecf6", xaxis = list(title = "Months"), yaxis = list(title = "Days")) })
output$graph3 <- renderPlotly({ plot_ly( x = Data_Frame[,"Months"], y = Data_Frame[,"a_con_wet_days"]) %>% layout(title = 'Average consecutive wet days', plot_bgcolor = "#e5ecf6", xaxis = list(title = "Months"), yaxis = list(title = "Days")) })
}
}
if (input$reporttype == "naturaldisaster") {
acs <- template_naturaldisaster(lat, lon, login)
template <- "Natural Disasters"
#Check for usage and pricing tiers limits
if (class(unlist(acs[[3]])) == "character" || class(unlist(acs[[2]])) == "character" || class(unlist(acs[[1]])) == "character") {
shinyalert(as.character(unlist(acs[[3]])[1]), type = "error")
} else {
if (is.null(unlist(acs[[3]]))) {
} else {
Data_Frame_w <- data.frame (
windstorm = c("Highm, M12", "High, M11","High, M10", "High, M9","High, M8", "High, M7","High, M6","High, M5","High, M4","High, M3","High, M2","High, M1",
"Moderate, M12", "Moderate, M11","Moderate, M10", "Moderate, M9","Moderate, M8", "Moderate, M7","Moderate, M6","Moderate, M5","Moderate, M4","Moderate, M3","Moderate, M2","Moderate, M1",
"Low, M12", "Low, M11","Low, M10", "Low, M9","Low, M8", "Low, M7","Low, M6","Low, M5","Low, M4","Low, M3","Low, M2","Low, M1"),
windstorm_probability = unlist(acs[[3]])
)
output$graph3 <- renderPlotly({ plot_ly( x = Data_Frame_w[,"windstorm"], y = Data_Frame_w[,"windstorm_probability"]) %>% layout(title = 'Windstorm Probability', plot_bgcolor = "#e5ecf6", xaxis = list(title = "Severity Level, Month"), yaxis = list(title = "Probability of Occurance")) })
}
if (is.null(unlist(acs[[2]]))) {
} else {
Data_Frame_d <- data.frame (
drought = c("Autumn, Low", "Winter, Low", "Summer, Low", "Spring, Low", "Autumn, Moderate", "Winter, Moderate", "Summer, Moderate", "Spring, Moderate", "Autumn, High", "Winter, High", "Summer, High", "Spring, High", "Autumn, Extreme", "Winter, Extreme", "Summer, Extreme", "Spring, Extreme"),
drought_probability = unlist(acs[[2]])
)
output$graph2 <- renderPlotly({plot_ly( x = Data_Frame_d[,"drought"], y = Data_Frame_d[,"drought_probability"]) %>% layout(title = 'Drought Probability', plot_bgcolor = "#e5ecf6", xaxis = list(title = "Season, Severity Level"), yaxis = list(title = "Probability of Occurance")) })
}
if (is.null(unlist(acs[[1]]))) {
} else {
Data_Frame_f <- data.frame (
return_years = c("10 years", "20 years", "50 years", "100 years", "200 years", "500 years"),
flood_severity = unlist(acs[[1]])
)
output$graph1 <- renderPlotly({ plot_ly( x = Data_Frame_f[,"return_years"], y = Data_Frame_f[,"flood_severity"]) %>% layout(title = 'Flood Severity', plot_bgcolor = "#e5ecf6", xaxis = list(title = "Return Period"), yaxis = list(title = "Depth in meters")) })
}
output$template <- renderText({template})
}
}
}
}
)
}
global.R
library(shinyalert)
library(leaflet)
require(httr)
library(leaflet)
library(leaflet.extras)
library(plotly)User Interface
By running the app, a window will appear initially, that includes the map and the configuration menu.
Step 1: Add a marker on the map
Step 2: Fill in the email and password of your account
Step 3: Select the report type and click on "Create the Report"
Wait a few seconds and click on the "Generated Report" tab to see the results.
Last updated
