WIP: New Forecasting Dashboard

shiny/NewForecastingDashboard/.Rbuildignore

@@ -0,0 +1,3 @@
+^NewForecastingDashboard\.Rproj$
+^\.Rproj\.user$
+^LICENSE\.md$

shiny/NewForecastingDashboard/.gitignore

@@ -0,0 +1 @@
+.Rproj.user

shiny/NewForecastingDashboard/DESCRIPTION

@@ -0,0 +1,14 @@
+Package: NewForecastingDashboard
+Title: New PEcAn Forecasting Dashboard
+Version: 0.0.0.9000
+Authors@R: 
+    person("Nihar", "Sanda", , "[email protected]", role = c("aut", "cre"),
+           comment = c(ORCID = "0000-0001-5303-6400"))
+Description: This project allows to view the Forecasting plots very efficiently.
+License: MIT + file LICENSE
+Encoding: UTF-8
+Roxygen: list(markdown = TRUE)
+RoxygenNote: 7.1.2
+Depends: 
+    R (>= 2.10)
+LazyData: true

shiny/NewForecastingDashboard/Dockerfile

@@ -0,0 +1,15 @@
+FROM rocker/shiny
+
+RUN apt-get update \
+    && apt-get -y install libpq-dev libssl-dev \
+    && install2.r -e -s -n -1 curl dbplyr DT leaflet \
+    && rm -rf /srv/shiny-server/* \
+    && rm -rf /var/lib/apt/lists/*
+ADD . /srv/shiny-server/
+
+ADD https://raw.githubusercontent.com/rocker-org/shiny/master/shiny-server.sh /usr/bin/
+
+RUN chmod +x /usr/bin/shiny-server.sh
+
+# special script to start shiny server and preserve env variable
+CMD /srv/shiny-server/save-env-shiny.sh

shiny/NewForecastingDashboard/LICENSE

@@ -0,0 +1,2 @@
+YEAR: 2023
+COPYRIGHT HOLDER: NewForecastingDashboard authors

shiny/NewForecastingDashboard/LICENSE.md

@@ -0,0 +1,21 @@
+# MIT License
+
+Copyright (c) 2023 NewForecastingDashboard authors
+
+Permission is hereby granted, free of charge, to any person obtaining a copy
+of this software and associated documentation files (the "Software"), to deal
+in the Software without restriction, including without limitation the rights
+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
+copies of the Software, and to permit persons to whom the Software is
+furnished to do so, subject to the following conditions:
+
+The above copyright notice and this permission notice shall be included in all
+copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+SOFTWARE.

shiny/NewForecastingDashboard/NAMESPACE

@@ -0,0 +1,2 @@
+# Generated by roxygen2: do not edit by hand
+

shiny/NewForecastingDashboard/R/app.R

@@ -0,0 +1,6 @@
+library(shiny)
+library(data.table)
+
+newForecastingDashboardApp <- function(...) {
+  shinyApp(ui = ui, server = server, options = list(includeCSS("./R/styles.css")), ...)
+}

shiny/NewForecastingDashboard/R/server.R

@@ -0,0 +1,150 @@
+server <- function(input, output) {
+
+  options(shiny.maxRequestSize=30*1024^2)
+
+  data <- reactive({
+    req(input$csv_input)
+    df <- read.csv(input$csv_input$datapath)
+    df$datetime <- as.POSIXct(df$datetime)  # Convert datetime column to POSIXct object
+    df$error <- abs(df$observation - df$mean)
+    return(df)
+    })
+
+  observeEvent(data(),{
+    site_id_choices <- c(unique(data()$site_id))
+    start_date_choices <- c(unique(data()$reference_datetime))
+    updateSelectInput(inputId = "site_id", choices = site_id_choices)
+    updateSelectInput(inputId = "start_date", choices = start_date_choices)
+  })
+
+  site_id <- eventReactive(input$run_button,input$site_id)
+  start_date <- eventReactive(input$run_button,input$start_date)
+
+  # NEE Forecast Plot
+  forecast_plot <- function(forecast_data, input_site, start_date, input_variable){
+    forecast_data<- filter(forecast_data, variable == input_variable & site_id == input_site & reference_datetime == start_date & observation!="NA")
+
+    ggplot(forecast_data, aes(x = datetime)) +
+      geom_ribbon(
+        aes(ymin = quantile02.5, ymax = quantile97.5, fill = "95% Confidence Interval"),
+        alpha = 0.4
+      ) +
+      geom_line(aes(y = mean, color = "Predicted")) +
+      geom_line(aes(y = observation, color = "Observed Data"), size = 1) +
+      ggtitle(paste0("Forecast Horizon for ", input_site)) +
+      scale_color_manual(
+        name = "Legend",
+        labels = c("Observed Data", "Predicted"),
+        values = c("Observed Data" = "firebrick4", "Predicted" = "skyblue1")
+      ) +
+      scale_fill_manual(
+        labels = c("95% Confidence Interval"),
+        values = c("95% Confidence Interval" = "blue1")
+      ) +
+      scale_y_continuous(name = "NEE (kg C m-2 s-1)") +
+      scale_x_datetime(
+        name = "Date and Time",
+        date_labels = "%Y-%m-%d",
+        breaks = unique(as.POSIXct(as.Date(forecast_data$datetime))),
+        labels = format(unique(as.POSIXct(as.Date(forecast_data$datetime))), "%Y-%m-%d"),
+        guide = guide_axis(n.dodge = 1)
+      ) +
+      theme_minimal() +
+      theme(
+        plot.title = element_text(hjust = 0.5, size = 12),
+        legend.title = element_blank(),
+        legend.text = element_text(size = 10),
+        axis.text.x = element_text(size = 10, angle = 45, hjust = 1, vjust = 1),
+        axis.text.y = element_text(size = 11),
+        axis.title.y = element_text(size = 12)
+      )
+  }
+
+  scatter_plot<- function(scatter_data, input_site, start_date, input_variable) {
+    scatter_data<- filter(scatter_data, variable == input_variable & site_id == input_site & reference_datetime == start_date & observation!="NA")
+    scatter_data$E <- scatter_data$mean
+    scatter_data$O <- scatter_data$observation
+    all <- c(scatter_data$E, scatter_data$O)
+    RMSE <- sqrt(mean((scatter_data$E - scatter_data$O)^2, na.rm = TRUE))
+    Bias <- mean(scatter_data$E - scatter_data$O, na.rm = TRUE)
+
+    # Predicted vs Observed Scatter + 1:1 line + regression
+    ggplot(scatter_data, aes(x = E, y = O)) +
+      geom_point(size = 3) +
+      geom_line(data = data.frame(x = c(min(all, na.rm = TRUE), max(all, na.rm = TRUE)),
+                                  y = c(min(all, na.rm = TRUE), max(all, na.rm = TRUE))),
+                aes(x = x, y = y), color = "darkgrey", size = 2, linetype = "solid") +
+      labs(x = "Predicted", y = "Observed",
+           title = paste0("Scatter Plot for ", input_site)) +
+      theme_bw() +
+      theme(plot.title = element_text(hjust = 0.5),
+            legend.position = "none") +
+      annotate("text", x = 0.05, y = 0.9, label = paste0("RMSE = ", formatC(RMSE, format = "e", digits = 2)),
+               xref = "paper", yref = "paper")
+  }
+
+  error_plot <- function(error_data, input_site, start_date, input_variable) {
+    error_data<- filter(error_data, variable == input_variable & site_id == input_site & reference_datetime == start_date & observation!="NA")
+    ggplot(error_data, aes(x = datetime, y = error, group = 1)) +
+      geom_point(aes(color = datetime), size = 3) +
+      geom_hline(yintercept = 0, color = "black") +
+      xlab("Date") +
+      ylab("LE Error (kg C m-2 s-1)") +
+      theme_minimal() +
+      theme(
+        axis.title.x = element_text(size = 14),
+        axis.text.x = element_text(size = 12),
+        axis.text.y = element_text(size = 12),
+        axis.title.y = element_text(size = 14),
+        legend.title = element_text(size = 14),
+        legend.text = element_text(size = 12)
+      )
+  }
+
+  #NEE Forecast Plot
+  nee_ft_plot <- eventReactive(input$run_button,{
+    forecast_plot(data(), site_id(), start_date(), "nee")
+  })
+
+
+  output$nee_ft_plot <- renderPlotly(nee_ft_plot())
+
+  #NEE Scatter PLot
+  nee_sct_plot <- eventReactive(input$run_button, {
+    scatter_plot(data(), site_id(), start_date(), "nee")
+  })
+
+  output$nee_sct_plot <- renderPlotly(nee_sct_plot())
+
+  #NEE Error plot
+  nee_err_plot <- eventReactive(input$run_button,{
+    error_plot(data(), site_id(), start_date(), "nee")
+  })
+
+
+  output$nee_err_plot <- renderPlotly(nee_err_plot())
+
+  # LE Forecast Plot
+  le_ft_plot <- eventReactive(input$run_button,{
+    forecast_plot(data(), site_id(), start_date(), "le")
+  })
+
+
+  output$le_ft_plot <- renderPlotly(le_ft_plot())
+
+  # LE Scatter Plot
+  le_sct_plot <- eventReactive(input$run_button, {
+    scatter_plot(data(), site_id(), start_date(), "le")
+  })
+
+  output$le_sct_plot <- renderPlotly(le_sct_plot())
+
+  # LE Error Plot
+  le_err_plot <- eventReactive(input$run_button,{
+    error_plot(data(), site_id(), start_date(), "le")
+  })
+
+
+  output$le_err_plot <- renderPlotly(le_err_plot())
+
+}

shiny/NewForecastingDashboard/R/styles.css

@@ -0,0 +1,17 @@
+tags$head(
+  tags$style(HTML("
+    .plot-container {
+      border: 1px solid #ccc;
+      padding: 10px;
+      margin-bottom: 20px;
+      border-radius: 5px;
+      box-shadow: 0 2px 5px rgba(0,0,0,0.2);
+    }
+
+    @media (max-width: 768px) {
+      .plot-container {
+        margin: 0;
+      }
+    }
+  "))
+)

shiny/NewForecastingDashboard/R/ui.R

@@ -0,0 +1,94 @@
+library(shiny)
+library(ggplot2)
+library(plotly)
+library(dplyr)
+library(shinydashboard)
+library(gganimate)
+library(plotly)
+library(tidyverse)
+library(rpart)
+library(rattle)
+library(leaflet)
+library(htmltools)
+
+not_sel <- "Not Selected"
+
+ui <- dashboardPage( skin = "black",
+                     dashboardHeader(title = "Flux Dashboard"),
+
+                     dashboardSidebar(
+                       fileInput("csv_input", "Select CSV File to Import", accept = ".csv"),
+                       selectInput("site_id", h3("Select Site:"), choices = c(not_sel)),
+                       selectInput("start_date", label="Forecast Horizon Date:", choices = c(not_sel)),
+                       sidebarMenu(
+                         menuItem("NEE Forecast", tabName = "nee_ft", icon = icon("chart-area")),
+                         menuItem("NEE Scatter", tabName = "nee_sct", icon = icon("tree")),
+                         menuItem("NEE Error", tabName = "nee_err", icon = icon("tree")),
+                         menuItem("LE Forecast", tabName = "le_ft", icon = icon("chart-area")),
+                         menuItem("LE Scatter", tabName = "le_sct", icon = icon("tree")),
+                         menuItem("LE Error", tabName = "le_err", icon = icon("tree"))
+                       ),
+                       br(),
+                       actionButton("run_button", "Run Analysis", icon = icon("play"))
+                     ),
+
+                     dashboardBody(
+                       tabItems(
+                         #Map Tab
+                         tabItem(tabName = "nee_ft",
+                                 fluidRow(div(
+                                   style = "margin: 10px;",
+                                   tags$div(
+                                     style = "border: 5px solid black; border-radius: 5px;",
+                                     plotlyOutput("nee_ft_plot")
+                                   )
+                                 ))
+                         ),
+                         tabItem(tabName = "nee_sct",
+                                 fluidRow(div(
+                                   style = "margin: 10px;",
+                                   tags$div(
+                                     style = "border: 5px solid black; border-radius: 5px;",
+                                     plotlyOutput("nee_sct_plot")
+                                   )
+                                 ))
+                         ),
+                         tabItem(tabName = "nee_err",
+                                 fluidRow(div(
+                                   style = "margin: 10px;",
+                                   tags$div(
+                                     style = "border: 5px solid black; border-radius: 5px;",
+                                     plotlyOutput("nee_err_plot")
+                                   )
+                                 ))
+                         ),
+                         tabItem(tabName = "le_ft",
+                                 fluidRow(div(
+                                   style = "margin: 10px;",
+                                   tags$div(
+                                     style = "border: 5px solid black; border-radius: 5px;",
+                                     plotlyOutput("le_ft_plot")
+                                   )
+                                 ))
+                         ),
+                         tabItem(tabName = "le_sct",
+                                 fluidRow(div(
+                                   style = "margin: 10px;",
+                                   tags$div(
+                                     style = "border: 5px solid black; border-radius: 5px;",
+                                     plotlyOutput("le_sct_plot")
+                                   )
+                                 ))
+                         ),
+                         tabItem(tabName = "le_err",
+                                 fluidRow(div(
+                                   style = "margin: 10px;",
+                                   tags$div(
+                                     style = "border: 5px solid black; border-radius: 5px;",
+                                     plotlyOutput("le_err_plot")
+                                   )
+                                 ))
+                         )
+                       )
+                     )
+)

shiny/NewForecastingDashboard/README.md

@@ -0,0 +1,21 @@
+# New Forecasting Dashboard
+
+To use the application please follow the following steps
+
+## 1. Load the data
+The data can be loaded by using the `load()` function and mentioning the .rda file. Change the path depending on your path. 
+```
+load("~/pecan/shiny/NewForecastingDashboard/data/data.rda")
+``` 
+
+## 2. Load the package
+Run the following command after setting your working directory to the `NewForecastingDashboard` path.
+```
+load_all()
+``` 
+
+## 3. Using the app
+Run The following command in your console to run the shiny app after loading the package. 
+```
+NewForecastingDashboardApp()
+```