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"

Configuration tab

Wait a few seconds and click on the "Generated Report" tab to see the results.

Generated Report from selected template