0byt3m1n1
Path:
C:
/
Users
/
Administrator
/
AppData
/
Local
/
RStudio
/
sources
/
session-d2b5bf0d
/
[
Home
]
File: 35A85375-contents
library(shiny) library(dplyr) library(ggplot2) library(plotly) library(tidyr) library(zoo) library(lubridate) library(RColorBrewer) library(shinythemes) library(shinyWidgets) library(DiagrammeR) library(ggtext) library(gganimate) library(reactable) # Read the daily rainfall data rainfall_data <- read.csv("rainfall_data.csv") # Clean and pre-process the data start_date <- as.Date("1987-01-01") end_date <- as.Date("2023-02-28") Date <- seq(from = start_date, to = end_date, by = "day") rainfall_data$Date <- Date rainfall_data$Date <- as.Date(rainfall_data$Date, format = "%Y-%m-%d") rainfall_data$Week <- week(rainfall_data$Date) rainfall_data$Month <- month(rainfall_data$Date) rainfall_data$Year <- year(rainfall_data$Date) # Group the data by Year and Month, and calculate the average rainfall for each group rainfall_data <- rainfall_data %>% group_by(Year, Month) %>% mutate(avg_rainfall = mean(rainfall)) # Remove missing values from the dataframe rainfall_data <- na.omit(rainfall_data) # Ungroup the data rainfall_data <- ungroup(rainfall_data) # Create a new variable indicating the season information rainfall_data <- rainfall_data %>% mutate(Season = ifelse(Month %in% c(12, 1, 2), "Winter", ifelse(Month %in% c(3, 4, 5), "Summer", ifelse(Month %in% c(6, 7, 8, 9), "South West Monsoon", "Post Monsoon")))) ## # Define UI ui <- navbarPage( title = HTML("<span style='font-size: 36px; color: #FFFFFF; font-family: Arial, sans-serif; font-weight: bold; text-shadow: 1px 1px #000000;'>Discover the Secrets of Rainfall: An Interactive Data Visualization Tool</span>"), theme = shinytheme("paper"), tags$head( tags$style( HTML(" body { background-image: url('https://cdn.pixabay.com/photo/2016/06/08/12/08/sea-1440809_960_720.jpg'); background-repeat: no-repeat; background-size: cover; background-position: center center; } .navbar-default { background-color: #1f2d3d; border-color: #1f2d3d; } .navbar-default .navbar-brand { color: #FFFFFF; } ") ) ), tabPanel(tags$h3("Rainfall Overview", style = "color: #fff; background-color: #007bff; padding: 10px;"), sidebarLayout( sidebarPanel( dateRangeInput("date_range", "Select Date Range:", start = min(rainfall_data$Date), end = max(rainfall_data$Date)), selectInput("month_range", "Select Month Range:", choices = c("All", month.name[1:12]), selected = "All"), selectInput("monthly_slicer", "Select a Month:", choices = c("", month.name[1:12])), actionButton("reset", "Reset Date and Month Range") ), mainPanel( fluidRow( column(width = 6, plotlyOutput("annual_plot")), column(width = 6, plotlyOutput("monthly_trend")) ), fluidRow( column(width = 6, plotlyOutput("daily_plot")), column(width = 6, plotlyOutput("monthly_plot")) ) ) )), tabPanel(tags$h3("Seasonal Analysis", style = "color: #fff; background-color: #007bff; padding: 10px;"), sidebarLayout( sidebarPanel( selectInput("season", label = "Select Season:", choices = c("All Seasons", "Winter", "Summer", "South West Monsoon", "Post Monsoon"), selected = "All Seasons"), actionButton("reset_season", "Reset Seasonal Slicer") ), mainPanel( tabsetPanel( type = "tabs", tabPanel("Time Series Plot", plotlyOutput("tsplot")), tabPanel("Histogram", plotlyOutput("histogram")), tabPanel("Boxplot", plotlyOutput("boxplot")), tabPanel("Seasonal Decomposition", plotlyOutput("decomposition")), tabPanel("Seasonal Rainfall Trend", plotlyOutput("seasonal_trend")), tabPanel("Seasonal Rainy Day Plot", plotlyOutput("seasonal_rainy_days")) ) ) )), tabPanel(tags$h3("Rainfall Summary & Extreme Events", style = "color: #fff; background-color: #007bff; padding: 10px;"), fluidRow( column(width = 6, reactableOutput("rainfall_summary")), column(width = 6, reactableOutput("extreme_rainfall_table")) ) ) ) # Define custom theme theme_custom <- function() { theme_bw(base_size = 14) + theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank(), axis.line = element_line(colour = "black",size = 12), axis.text = element_text(colour = "black",size = 12), axis.title = element_text(colour = "black", size = 16), plot.title = element_text(colour = "black", size = 20), plot.background = element_rect(fill = ""), panel.background = element_rect(fill = "white")) } # Define server logic server <- function(input, output, session) { # Filter data based on selected date range and month range filtered_data <- reactive({ d <- rainfall_data %>% filter(Date >= input$date_range[1], Date <= input$date_range[2]) if (nrow(d) == 0) { return(data.frame()) } if (input$month_range != "All") { month_num <- match(input$month_range, month.name) d <- d %>% filter(Month == month_num) } if (input$monthly_slicer != "") { month_num <- match(input$monthly_slicer, month.name) d <- d %>% filter(Month == month_num) } d }) ##monthly rainyday plot output$monthly_plot <- renderPlotly({ filtered_data_monthly <- filtered_data() %>% mutate(Rainy_Day = ifelse(rainfall > 2.5, 1, 0)) %>% group_by(Year, Month) %>% summarise(Total_Rainy_Days = sum(Rainy_Day), .groups = "drop") %>% ungroup() if (nrow(filtered_data_monthly) == 0) { return(NULL) } if (input$monthly_slicer != "") { month_num <- match(input$monthly_slicer, month.name) filtered_data_monthly <- filtered_data_monthly %>% filter(Month == month_num) } # Define a color palette based on the number of months colors <- colorRampPalette(brewer.pal(n = 12, name = "Set3")) # Set the color of the bars based on the month colorscale <- colors(length(unique(filtered_data_monthly$Month))) p <- plot_ly(filtered_data_monthly, x = ~as.Date(paste(Year, Month, "1", sep = "-")), y = ~Total_Rainy_Days, type = "bar", marker = list(color = colorscale), showlegend = FALSE) p %>% layout(xaxis = list(title = "Date",font = list(size = 12, color = "black", family = "Arial Bold")), yaxis = list(title = "Total Rainy Days",font = list(size = 12, color = "black", family = "Arial Bold")), title = list(text = "Monthly Rainy Days", font = list(size = 18, color = "black", family = "Arial Bold")), margin = list(l = 60, r = 10, t = 80, b = 50), plot_bgcolor = "", paper_bgcolor = "white") }) # Annual rainfall plot output$annual_plot <- renderPlotly({ filtered_data_annual <- filtered_data() %>% group_by(Year) %>% summarise(Total_Rainfall = sum(rainfall), .groups = "drop") %>% ungroup() if (nrow(filtered_data_annual) == 0) { return(NULL) } avg_rainfall <- mean(filtered_data_annual$Total_Rainfall) min_year <- min(filtered_data_annual$Year) plot <- ggplot(filtered_data_annual, aes(x = Year, y = Total_Rainfall, fill = Total_Rainfall)) + geom_col() + scale_fill_gradient(low = "blue", high = "lightblue") + geom_hline(yintercept = avg_rainfall, color = "red", linetype = "dashed") + annotate("text", x = min_year, y = avg_rainfall, label = "Average", color = "red", size = 3) + labs(title = "Annual Rainfall", x = "Year", y = "Rainfall (mm)", size = 14) + theme(plot.background = element_rect(fill = "white", color = NA), panel.background = element_blank(), plot.title = element_text(size = 20), legend.position = "none", plot.margin = unit(c(1,1,1,1), "cm")) + stat_smooth(method = "loess", formula = y ~ x, se = FALSE, color = "black") ggplotly(plot) }) # Monthly rainfall trend plot output$monthly_trend <- renderPlotly({ filtered_data_monthly <- filtered_data() %>% group_by(Year, Month) %>% summarise(Total_Rainfall = sum(rainfall), .groups = "drop") %>% ungroup() if (nrow(filtered_data_monthly) == 0) { return(NULL) } if (input$monthly_slicer != "") { month_num <- match(input$monthly_slicer, month.name) filtered_data_monthly <- filtered_data_monthly %>% filter(Month == month_num) } # Calculate average rainfall avg_rainfall <- mean(filtered_data_monthly$Total_Rainfall) # Calculate linear regression lm_model <- lm(Total_Rainfall ~ ymd(paste0(Year, "-", Month, "-01")), data = filtered_data_monthly) r_squared <- round(summary(lm_model)$r.squared, 2) eq <- paste0("y = ", round(lm_model$coefficients[1], 2), " + ", round(lm_model$coefficients[2], 2), "x") plot <- ggplot(filtered_data_monthly, aes(x = as.Date(paste0(Year, "-", Month, "-01")), y = Total_Rainfall)) + geom_line(color = "blue") + geom_smooth(method = "lm", se = FALSE, color = "red", formula = y ~ x) + labs(title = paste0("Monthly Rainfall Trend - Average Rainfall: ", round(avg_rainfall, 2), " mm"), x = "Date", y = "Rainfall (mm)", color = "Trend") + theme_bw()+ theme(plot.title = element_text(size = 12)) + annotate("text", x = as.Date(paste0(max(filtered_data_monthly$Year), "-", max(filtered_data_monthly$Month), "-01")), y = max(filtered_data_monthly$Total_Rainfall), label = paste0("R-squared: ", round(r_squared, 2), " "), hjust = 1, vjust = 1, size = 3) + annotate("text", x = as.Date(paste0(min(filtered_data_monthly$Year), "-", min(filtered_data_monthly$Month), "-01")), y = max(filtered_data_monthly$Total_Rainfall), label = paste0(" Average:",round(avg_rainfall, 1),"mm"), hjust = 0, vjust = 1, size = 3) + annotate("text", x = as.Date(paste0(max(filtered_data_monthly$Year),"-",max(filtered_data_monthly$Month), "-01")), y = 0.9 * max(filtered_data_monthly$Total_Rainfall), label = paste0("y=",round(lm_model$coefficients[1], 1), "+",round(lm_model$coefficients[2], 1),"x"," "), size = 3, hjust = 0.5, vjust = 1) plotly::ggplotly(plot) %>% layout(title = "Monthly Rainfall Plot", xaxis = list(title = "Date"), yaxis = list(title = "Rainfall (mm)")) }) # Daily rainfall plot output$daily_plot <- renderPlotly({ filtered_data_daily <- filtered_data() %>% mutate(Date = as.Date(Date)) %>% group_by(Date) %>% summarise(Total_Rainfall = sum(rainfall), .groups = "drop") if (nrow(filtered_data_daily) == 0) { return(NULL) } if (input$monthly_slicer != "") { month_num <- match(input$monthly_slicer, month.name) filtered_data_daily <- filtered_data_daily %>% filter(as.numeric(format(Date, "%m")) == month_num) } p <- plot_ly(filtered_data_daily, x = ~Date, y = ~Total_Rainfall, type = "scatter", mode = "lines+markers", marker = list(size = 6), showlegend = FALSE) p %>% layout(xaxis = list(title = "Date", font = list(size = 12, color = "black", family = "Arial Bold")), yaxis = list(title = "Total Rainfall (mm)", font = list(size = 12, color = "black", family = "Arial Bold")), title = list(text = "Daily Rainfall", font = list(size = 18, color = "black", family = "Arial Bold")), margin = list(l = 60, r = 10, t = 80, b = 50), plot_bgcolor = "", paper_bgcolor = "white") }) # Filter data based on region and season inputs # Filter data based on selected season filtered_data <- reactive({ if (input$season == "All Seasons") { rainfall_data } else { subset(rainfall_data, Season == input$season) } }) output$tsplot <- renderPlotly({ filtered_data_daily <- filtered_data() %>% mutate(Date = as.Date(Date)) %>% group_by(Date) %>% summarise(Total_Rainfall = sum(rainfall), .groups = "drop") if (nrow(filtered_data_daily) == 0) { return(NULL) } p <- plot_ly(filtered_data_daily, x = ~Date, y = ~Total_Rainfall, type = "scatter", mode = "lines+markers", marker = list(size = 6), showlegend = FALSE) p %>% layout(xaxis = list(title = "Date", font = list(size = 12, color = "black", family = "Arial Bold")), yaxis = list(title = "Total Rainfall (mm)", font = list(size = 12, color = "black", family = "Arial Bold")), title = list(text = "Rainfall Time Series Plot", font = list(size = 18, color = "black", family = "Arial Bold")), margin = list(l = 60, r = 10, t = 80, b = 50), plot_bgcolor = "", paper_bgcolor = "white") }) # Seasonal rainfall trend plot output$seasonal_trend <- renderPlotly({ # Aggregate the data by season and year agg_data <- filtered_data() %>% mutate(Year = year(Date)) %>% group_by(Season, Year) %>% summarise(Rainfall = sum(rainfall)) %>% ungroup() # Plot using ggplot ggplot(agg_data, aes(x = Year, y = Rainfall, group = Season, color = Season)) + geom_line(size = 1) + geom_point(size = 3, shape = 21, fill = "white") + # add points stat_smooth(method = "lm", formula = y ~ x, se = FALSE) + # add trend line labs(title = "Seasonal Rainfall Trend", x = "Year", y = "Rainfall (mm)", color = "Season") + theme_classic(base_size = 14) + theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank(), legend.position = "bottom", legend.direction = "horizontal", plot.title = element_text(hjust = 0.5, size = 20, face = "bold"), axis.title = element_text(size = 16, face = "bold"), axis.text = element_text(size = 14), legend.text = element_text(size = 14)) + scale_color_brewer(palette = "Dark2") + # change color palette theme(plot.background = element_rect(fill = "white"), # add white background panel.background = element_rect(fill = "white"), # add white panel background legend.box.background = element_rect(color = "black"), # add border around legend legend.title = element_blank(), # remove legend title legend.key = element_blank(), # remove legend symbols legend.margin = margin(t = 5, r = 5, b = 5, l = 5), # adjust legend margin legend.text.align = 0, # left-align legend text legend.spacing.x = unit(0.2, "cm")) + # adjust legend spacing geom_smooth(method = "lm", formula = y ~ x, se = FALSE) + # add trend line theme(plot.title = element_text(hjust = 0.5, size = 20, face = "bold"), plot.background = element_rect(fill = "white"), # add white background panel.background = element_rect(fill = "white"), # add white panel background axis.title = element_text(size = 16, face = "bold"), axis.text = element_text(size = 14), legend.text = element_text(size = 14)) + scale_color_brewer(palette = "Dark2") # change color palette # Convert ggplot to plotly ggplotly() }) # Seasonal rainy day plot # Seasonal rainy day plot output$seasonal_rainy_days <- renderPlotly({ # Aggregate the data by season and year agg_data <- filtered_data() %>% mutate(Year = year(Date), Rainy_Day = ifelse(rainfall > 2.5, 1, 0)) %>% group_by(Season, Year) %>% summarise(Rainy_Days = sum(Rainy_Day), Total_Days = n()) %>% ungroup() %>% mutate(Rainy_Day_Count = Rainy_Days) # add a new column for rainy day counts # Create the ggplot object p <- ggplot(agg_data, aes(x = Year, y = Rainy_Day_Count, fill = Season)) + geom_bar(stat = "identity", position = "dodge", color = "black") + geom_text(aes(label = Rainy_Day_Count), position = position_dodge(width = 0.9), vjust = -0.5, size = 3.5) + # add text labels on top of bars labs(title = "Seasonal Rainy Day Counts", x = "Year", y = "Number of Rainy Days", fill = "Season") + theme_classic(base_size = 14) + theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank(), legend.position = "bottom", legend.direction = "horizontal", plot.title = element_text(hjust = 0.5, size = 20, face = "bold"), axis.title = element_text(size = 16, face = "bold"), axis.text = element_text(size = 14), legend.text = element_text(size = 14)) + scale_fill_brewer(palette = "Dark2") + # change color palette theme(plot.background = element_rect(fill = "white"), # add white background panel.background = element_rect(fill = "white"), # add white panel background legend.box.background = element_rect(color = "black"), # add border around legend legend.title = element_blank(), # remove legend title legend.margin = margin(t = 5, r = 5, b = 5, l = 5), # adjust legend margin legend.text.align = 0, # left-align legend text legend.spacing.x = unit(0.2, "cm")) # adjust legend spacing # Convert ggplot object to plotly object ggplotly(p) }) # Histogram output$histogram <- renderPlotly({ p <- ggplot(data = filtered_data(), aes(x = rainfall)) + geom_histogram(fill = "#0072B2", color = "#0072B2", alpha = 0.5) + geom_vline(aes(xintercept = mean(rainfall)), color = "#D55E00", linetype = "dashed", size = 1) + labs(title = "Rainfall Histogram", x = "Rainfall (mm)", y = "Frequency") + theme_bw() + theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank()) + scale_x_continuous(labels = scales::number_format(accuracy = 0.01)) ggplotly(p) }) # Boxplot output$boxplot <- renderPlotly({ p <- ggplot(data = filtered_data(), aes(x = Season, y = rainfall, fill = Season)) + geom_boxplot(alpha = 0.7, outlier.color = NA) + geom_point(aes(x = Season, y = rainfall)) + labs(title = "Rainfall Boxplot", x = "Season", y = "Rainfall (mm)", fill = "Season", title.size = 20, x.text.size = 14, y.text.size = 14, legend.title.size = 14, legend.text.size = 12) + theme_bw(base_size = 14) + theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank(), legend.position = "bottom", legend.direction = "horizontal") ggplotly(p) }) output$decomposition <- renderPlotly({ ts_data <- ts(filtered_data()$rainfall, frequency = 12) decompose_data <- decompose(ts_data) # Convert decomposed data into a data frame df <- data.frame( Date = time(ts_data), Observed = decompose_data$x, Seasonal = decompose_data$seasonal, Trend = decompose_data$trend, Random = decompose_data$random ) df_long <- tidyr::pivot_longer(df, -Date, names_to = "Component", values_to = "Value") # Plot using ggplot p <- ggplot(df_long, aes(x = Date, y = Value, color = Component)) + geom_line() + facet_wrap(~Component, ncol = 1, scales = "free_y") + labs(title = "Rainfall Seasonal Decomposition", x = "", y = "Rainfall (mm)", color = "Component") + theme_bw(base_size = 16) + theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank(), legend.title = element_text(size = 18), legend.text = element_text(size = 16), plot.title = element_text(size = 20, face = "bold"), axis.title = element_text(size = 18, face = "bold"), axis.text = element_text(size = 12)) ggplotly(p) }) # Filter data based on selected date range and month range filtered_data <- reactive({ d <- rainfall_data %>% filter(Date >= input$date_range[1], Date <= input$date_range[2]) if (nrow(d) == 0) { return(data.frame()) } if (input$month_range != "All") { month_num <- match(input$month_range, month.name) d <- d %>% filter(Month == month_num) } if (input$monthly_slicer != "") { month_num <- match(input$monthly_slicer, month.name) d <- d %>% filter(Month == month_num) } d }) # Render the rainfall summary table output$rainfall_summary <- renderReactable({ filtered_data_summary <- filtered_data() %>% group_by(Year, Month) %>% summarise(Total_Rainfall = sum(rainfall), .groups = "drop") if (nrow(filtered_data_summary) == 0) { return(NULL) } filtered_data_summary$Month <- factor(month.name[filtered_data_summary$Month], levels = month.name) filtered_data_summary %>% group_by(Month) %>% summarise(mean = round(mean(Total_Rainfall), digits = 1), sd = round(sd(Total_Rainfall), digits = 1), cv = round((sd(Total_Rainfall) / mean(Total_Rainfall))*100, digits = 2), min = min(Total_Rainfall), max = max(Total_Rainfall), .groups = "drop") %>% mutate_if(is.numeric, function(x) format(x, big.mark = ",")) %>% rename(Month_summary = "Month", Mean = "mean", SD = "sd", CV = "cv", Min = "min", Max = "max") %>% reactable( bordered = TRUE, striped = TRUE, highlight = TRUE, fullWidth = FALSE, height = "500px", width = "750px" ) }) # Render the extreme rainfall table output$extreme_rainfall_table <- renderReactable({ filtered_data_extreme <- filtered_data() %>% group_by(Year, Month, Date) %>% summarise(Total_Rainfall = sum(rainfall), .groups = "drop") %>% arrange(desc(Total_Rainfall)) %>% slice_head(n = 100) if (nrow(filtered_data_extreme) == 0) { return(NULL) } filtered_data_extreme$Month <- factor(month.name[filtered_data_extreme$Month], levels = month.name) filtered_data_extreme %>% mutate(Rank = row_number()) %>% select(Rank, Year, Month, Date, Total_Rainfall) %>% mutate_if(is.numeric, function(x) format(x, big.mark = ",")) %>% rename(Extremities_Rank = "Rank", Year = "Year", Month = "Month", Date = "Date", Total_Rainfall = "Total_Rainfall") %>% reactable(bordered = TRUE, striped = TRUE, highlight = TRUE, fullWidth = FALSE, height = "500px", width = "750px") }) #Reset button observeEvent(input$reset, { updateDateRangeInput(session, "date_range", start = min(rainfall_data$Date), end = max(rainfall_data$Date)) updateSelectInput(session, "month_range", selected = "All") updateSelectInput(session, "monthly_slicer", selected = "") }) #reset button #reset button observeEvent(c(input$reset, input$reset_season), { updateSelectInput(session, "season", selected = "All Seasons") }) } #Run the application shinyApp(ui = ui, server = server) app <- shinyApp(ui,server) runApp(app,host="0.0.0.0",port=5050)