Permalink
Cannot retrieve contributors at this time
Name already in use
A tag already exists with the provided branch name. Many Git commands accept both tag and branch names, so creating this branch may cause unexpected behavior. Are you sure you want to create this branch?
CohoesPVApp/app.R
Go to fileThis commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
870 lines (799 sloc)
36.8 KB
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| # See: https://github.rpi.edu/RensselaerIDEA/CohoesPVApp | |
| library(usmap) | |
| library(ggplot2) | |
| library(plotly) | |
| library(tidyverse) | |
| library(RColorBrewer) | |
| library(sf) | |
| library(raster) | |
| library(sp) | |
| library(leaflet) | |
| library(maps) | |
| library(shiny) | |
| library(htmltools) | |
| library(rgdal) | |
| library(maptools) | |
| library(forcats) | |
| library(DT) | |
| # Set up the US map ===== | |
| # Read in the data of all reservoirs in the US and select relevant columns | |
| reservoirs <- readRDS("data/general/reservoirs.Rds") | |
| reservoirs_trim <- reservoirs %>% | |
| dplyr::select("lat","lon"="long","dam_name", "pv_annual_kWh", "prim_owner") | |
| # Convert prim_owner to factor of ownership types | |
| transformed <- data.frame( | |
| lon = reservoirs_trim$lon, | |
| lat = reservoirs_trim$lat, | |
| dam_name = reservoirs_trim$dam_name, | |
| pv_annual_kWh = reservoirs_trim$pv_annual_kWh, | |
| prim_owner = reservoirs_trim$prim_owner | |
| ) | |
| transformed$prim_owner <- | |
| factor(transformed$prim_owner, | |
| levels = c("Federal","State","Local Government", "Public Utility","Private")) | |
| # Line up lon and lat coordinates to those of the regular US map | |
| transformed <- usmap_transform(transformed) | |
| # Helper functions ===== | |
| # Load states data | |
| # state_choices <- data.frame(state.name, state.abb) | |
| # names(state_choices) <- c('State', 'Abbreviation') | |
| # # Format state names | |
| # state_choices$Adjusted_Name <- tolower(state_choices$State) | |
| # state_choices$Adjusted_Name <- sub(' ', '_', state_choices$Adjusted_Name) | |
| state_choices <- readRDS("data/general/state_choices.Rds") | |
| # Linear regression model for determining zoom level | |
| # Data | |
| long_data <- c(0.972210, 0.100498, 3.206336, 3.723576, 0.410752, 7.002313, 0.628595, 0.111407, | |
| 1.972866, 2.147375, 0.486319, 5.967012, 5.397071, 0.102783, 0.196136, 12.009459, | |
| 8.152419) | |
| lat_data <- c(0.700755, 0.094805, 2.108303, 3.164308, 0.142852, 4.011043, 14.279383, 0.126216, | |
| 2.289809, 1.053529, 0.573602, 3.588167, 4.195910, 0.086062, 0.179504, 4.643185, | |
| 4.056821) | |
| ranges <- pmax(long_data,lat_data) | |
| zoom_data <- c(8, 12, 8, 7, 12, 6, 5, 12, 8, 8, 10, 6, 7, 12, 11, 6, 5) | |
| # Train the model | |
| zoom_lm <- lm(zoom_data ~ ranges) | |
| # Determine zoom level dynamically | |
| zoomcalc <- function(myrange) { | |
| return(round(predict(zoom_lm, data.frame(ranges = myrange))[[1]], 0)) | |
| } | |
| # State dataset selection | |
| get_dataset <- function(selected_state, which_type) { | |
| # Get file name | |
| state_name <- state_choices[which(state_choices$State == selected_state), 3] | |
| file_name <- paste(state_name, '.Rds', sep = '') | |
| # Generate the designated dataset | |
| if (which_type == 'lowmod') { | |
| return (readRDS(paste('data/lowmod/', file_name, sep = ''))) | |
| } | |
| else if (which_type == 'cd') { | |
| return (readRDS(paste('data/cong_districts/', file_name, sep = ''))) | |
| } | |
| else if (which_type == 'reservoir') { | |
| return (readRDS(paste('data/reservoirs/', file_name, sep = ''))) | |
| } | |
| else if (which_type == 'substation') { | |
| return (readRDS(paste('data/substations/', file_name, sep = ''))) | |
| } | |
| return(NULL) | |
| } | |
| # Congressional district centering | |
| get_view <- function(district) { | |
| all_coords <- as.data.frame(st_coordinates(district)) | |
| long <- all_coords$X | |
| lat <- all_coords$Y | |
| long_range <- abs(abs(max(long)) - abs(min(long))) | |
| lat_range <- abs(abs(max(lat)) - abs(min(lat))) | |
| max_range <- max(long_range, lat_range) | |
| long_avg <- mean(long) | |
| lat_avg <- mean(lat) | |
| zoom_level <- zoomcalc(max_range) | |
| return(c(long_avg, lat_avg, zoom_level)) | |
| } | |
| # Generalized function to create reactive data tables | |
| # Type 1 - Rows = Primary owner type; Cols = Primary purpose | |
| # Type 2 - Rows = Primary owner type; Cols = Low mod income buckets | |
| # Type 3 - Rows = Primary purpose; Cols = Low mod income buckets | |
| get_table <- function(reservoir_data, which_type) { | |
| table_data <- NULL | |
| if (which_type == 1) { | |
| table_data <- table(reservoir_data$prim_owner, reservoir_data$prim_purpose) | |
| } else if (which_type == 2) { | |
| table_data <- table(reservoir_data$prim_owner, reservoir_data$lowmod_bucket) | |
| } else if (which_type == 3) { | |
| table_data <- table(reservoir_data$prim_purpose, reservoir_data$lowmod_bucket) | |
| } | |
| table_data <- as.data.frame.matrix(table_data) | |
| if (which_type == 1) { # Sort rows and cols based on descending reservoir count | |
| table_data <- table_data[order(-rowSums(table_data)), order(-colSums(table_data))] | |
| } | |
| table_data$Total = rowSums(table_data) # compute total for rows | |
| table_data <- rbind(table_data, Total = colSums(table_data)) | |
| return(table_data) | |
| } | |
| # UI ===== | |
| ui <- fluidPage( | |
| # Main website panel | |
| titlePanel("Clean Energy Generation Capacity of Floating Solar on Reservoirs"), | |
| navbarPage( | |
| textOutput("input_text"), | |
| id = "mainpage", | |
| # State Estimated PV Production tab (homepage) ===== | |
| tabPanel( | |
| "State Estimated PV Production", | |
| value = "homepage", | |
| # State and district selection | |
| sidebarLayout( | |
| sidebarPanel( | |
| style = 'position: fixed', | |
| width = 2, | |
| selectInput( | |
| inputId = 'state', | |
| label = 'Choose a state:', | |
| choices = state_choices$State, | |
| selected = 'New York', # Make the default state NY | |
| width = '150px' | |
| ), | |
| selectInput( | |
| inputId = 'district', | |
| label = 'Highlight a district:', | |
| choices = sort(unique(get_dataset('New York', 'lowmod')$DISTRICT)), | |
| selected = '20' # Make the default district 20th (Cohoes) | |
| ), | |
| # Range selection for substations | |
| radioButtons( | |
| inputId = 'distance', | |
| label = 'Select the range (in miles) of displayed substations with respect to the center of the current district', | |
| choices = list(10, 25, 50, 100), | |
| width = '175px' | |
| ) | |
| ), | |
| # Main panel for map and explanations | |
| mainPanel( | |
| width = 9, | |
| style = 'position: relative', | |
| # Map | |
| tags$h3(textOutput('input_state')), | |
| tags$h4("This map charts the NREL-identified water reservoirs potentially | |
| 'suitable' for floating solar in this state, by ownership and | |
| potential electricity generation (per MWh)"), | |
| tags$ul( | |
| tags$li( | |
| "Click on a dot to view reservoir name, estimated PV production and | |
| census tract low/moderate income percentage." | |
| ), | |
| tags$li( | |
| "Click on an icon with lightning symbol to view information regarding an | |
| electric substation." | |
| ), | |
| tags$li( | |
| "Select a congressional district (left) to highlight census tracts | |
| in that district." | |
| ), | |
| tags$li( | |
| "NEW (Jan 2023): Congressional district boundaries for the ", tags$b("118th Congress")," are shown." | |
| ), | |
| ), | |
| tags$br(), | |
| leafletOutput('reservoir_map', height = '700'), | |
| # Display statistics | |
| tags$br(), | |
| tags$p( | |
| "**Income data used throughout this app is obtained from the US Census. | |
| \"Low income\" is defined as up to 50 percent of | |
| the Area Median Income (AMI); \"moderate income\" is | |
| defined as greater than 50 percent AMI and up to 80 percent AMI.**" | |
| ), | |
| tags$h3(textOutput('state_stats')), | |
| tags$h4(textOutput('total_res')), | |
| # Primary owner type / primary purpose data | |
| tabPanel('Plot', | |
| fluidRow(splitLayout(cellWidths = c('50%', '50%'), | |
| plotOutput('owner_type_dist'), | |
| plotOutput('prim_purpose_dist')))), | |
| tags$br(), | |
| tags$h4(textOutput('t1')), | |
| tabPanel('Table', fluidRow(column(12, DT::dataTableOutput('table_1')))), | |
| tags$br(), | |
| # Low mod data | |
| tags$h4("Distribution of low / moderate income levels across reservoir owner types and primary purposes"), | |
| tabPanel('Plot', | |
| fluidRow(splitLayout(cellWidths = c('50%', '50%'), | |
| plotOutput('rc_owner_type'), | |
| plotOutput('rc_prim_purpose')))), | |
| tags$br(), | |
| tags$h4(textOutput('t2')), | |
| tabPanel('Table', fluidRow(column(12, DT::dataTableOutput('table_2')))), | |
| tags$br(), | |
| tags$h4(textOutput('t3')), | |
| tabPanel('Table', fluidRow(column(12, DT::dataTableOutput('table_3')))), | |
| # Explanation below map | |
| tags$br(), | |
| tags$h3('Further Information'), | |
| tags$p( | |
| "The sources of data are listed under the \"Data Sources of the Floating Solar Explorer\" | |
| section of the \"About the Floating Solar Explorer\" page" | |
| ), | |
| tags$p( | |
| "Developed by the Rensselaer Institute for Data Exploration | |
| and Applications (IDEA) in support of the proposed City of Cohoes, NY | |
| Municipal Floating Solar Demonstration Project" | |
| ), | |
| tags$p( | |
| "For more information on the Cohoes, NY Municipal Floating Solar | |
| Demonstration project contact: Theresa Bourgeois, Director of | |
| Operations, City of Cohoes", | |
| tags$a( | |
| "TBourgeois@ci.cohoes.ny.us", href="mailto:TBourgeois@ci.cohoes.ny.us" | |
| ), | |
| "or 518-903-0142 or Joseph Seman-Graves, City Planner, City of Cohoes", | |
| tags$a( | |
| "JSeman-Graves@ci.cohoes.ny.us", href="mailto:JSeman-Graves@ci.cohoes.ny.us" | |
| ), | |
| "or 518-233-2130" | |
| ), | |
| # IDEA logo | |
| img(src='IDEA_logo_500.png', align = "right", height=75) | |
| ) | |
| ) | |
| ), | |
| # US Estimated PV Production tab (overview of all reservoirs) ===== | |
| tabPanel( | |
| "US Estimated PV Production", | |
| value ="us_page", | |
| # Explanation above map | |
| fluidRow( | |
| style = "height:100px;", | |
| column( | |
| width=12, | |
| tags$h3( | |
| "Floating Solar installed on 'suitable' water reservoirs in the U.S. | |
| could generate about 10% of the nation’s current annual electricity | |
| production, according to a 2018 National Renewable Energy Lab (NREL) study" | |
| ), | |
| tags$p( | |
| "This map charts the 24,419 NREL-identified water reservoirs | |
| potentially 'suitable' for floating solar, by ownership and potential | |
| electricity generation (per MWh)" | |
| ) | |
| ) | |
| ), | |
| # Continue explanation above map and plot the US map | |
| # TODO: Improve the map's interactability | |
| fluidRow( | |
| style = "height:850px;", | |
| column( | |
| width=12, | |
| tags$p( | |
| tags$i( | |
| "Zoom in on a region by clicking, dragging and releasing", | |
| tags$br(), | |
| "Reset by selecting 'autoscale' option | |
| (hover over upper right of map to see menu)" | |
| ) | |
| ), | |
| tags$div( | |
| style="float:left;", | |
| plotlyOutput("us_map") | |
| ) | |
| ) | |
| ), | |
| #Explanation below map | |
| fluidRow( | |
| style = "height:200px;", | |
| column( | |
| width=12, | |
| tags$p( | |
| "Estimated photovoltaic production data provided by National | |
| Renewable Energy Laboratory (NREL); see:", | |
| tags$a( | |
| "Floating photovoltaic systems: assessing the technical potential of | |
| photovoltaic systems on man-made water bodies in the continental | |
| United States.", href="https://pubs.acs.org/doi/abs/10.1021/acs.est.8b04735" | |
| ), | |
| "Regarding 'suitability,' the NREL study notes:", | |
| tags$i( | |
| "the high-level data used and analyzed lacks the resolution for | |
| case-by-case feasibility, and the results should only be considered | |
| as a starting point for national and regional examinations." | |
| ) | |
| ), | |
| tags$p( | |
| "Estimated reservoir area obtained from US Army Corps of Engineers | |
| (USACE). The NREL model and the underlying data may contain errors." | |
| ), | |
| tags$p( | |
| "Income data obtained from the US Census. | |
| Low income is defined as up to 50 percent of | |
| the Area Median Income (AMI); moderate income is | |
| defined as greater than 50 percent AMI and up to 80 percent AMI." | |
| ), | |
| tags$p( | |
| "Developed by the Rensselaer Institute for Data Exploration | |
| and Applications (IDEA) in support of the proposed City of Cohoes, | |
| NY Municipal Floating Solar Demonstration Project." | |
| ), | |
| tags$p( | |
| "For more information on the Cohoes, NY Municipal Floating Solar | |
| Demonstration project contact: Theresa Bourgeois, Director of | |
| Operations, City of Cohoes", | |
| tags$a( | |
| "TBourgeois@ci.cohoes.ny.us", href='mailto:TBourgeois@ci.cohoes.ny.us' | |
| ), | |
| 'or 518-903-0142 or Joseph Seman-Graves, City Planner, City of Cohoes', | |
| tags$a( | |
| 'JSeman-Graves@ci.cohoes.ny.us',href='mailto:JSeman-Graves@ci.cohoes.ny.us' | |
| ), | |
| 'or 518-233-2130' | |
| ), | |
| # IDEA logo | |
| img(src='IDEA_logo_500.png', align = "right", height=75) | |
| ) | |
| ) | |
| ), | |
| # Background information tab ===== | |
| tabPanel( | |
| 'About the Floating Solar Explorer', value = 'about', | |
| # Picture and paragraph on the right | |
| tabPanel('', | |
| fluidRow( | |
| column(5, | |
| tags$h1(img(src='20190731-nrel-fpv-install-53282.jpg', align = "center", height=250)), | |
| tags$p('FPV Installation in Walden, Colorado', | |
| tags$i('Photo by Dennis Schoreder via'), | |
| tags$a('NREL', href = 'http://bit.ly/3cyhq2A')) | |
| ), | |
| column(7, | |
| tags$h5('Floating Solar installed on suitable water reservoirs in the U.S. | |
| could generate about 10% of the nation’s current annual electricity | |
| production, according to a 2018 National Renewable Energy Lab (NREL) | |
| study'), | |
| tags$p("Floating Solar installed on the 24,419 suitable human-made water | |
| reservoirs in the United States could generate about 10% of the nation’s | |
| current annual electricity production, according to a 2018 National | |
| Renewable Energy Lab (NREL) study. The 2018 NREL report indicates there | |
| are 492 reservoirs in New York State alone, encompassing 134,425 acres of | |
| water suitable for Floatovoltaics. This could generate 16.4 TW-hr/yr."), | |
| tags$p("The City of Cohoes, New York is proposing a", | |
| tags$i("municipally owned and operated"), | |
| "(apparently first of its kind) 3.2 MWdc Floating Solar demonstration project | |
| to be installed on its water reservoir, at a cost of $5.9 million. The Cohoes | |
| clean energy project would demonstrate that leveling the playing field by | |
| providing grants to municipalities — as an alternative option to current | |
| tax credits for private investments — for Floating Solar installations would | |
| incentivize municipalities to invest in their own clean energy infrastructure | |
| in a sustainable way, while realizing the full economic benefits of | |
| doing so. The Cohoes project may also spark interest in tapping appropriate | |
| water surfaces as a viable platform for solar energy generation, and would | |
| offer K-to-College opportunities for STEM education, workforce development, | |
| and research.") | |
| ) | |
| ) | |
| ), | |
| # Quote | |
| tags$br(), | |
| tags$p(tags$b( | |
| 'Words of support from U.S. Rep. Paul Tonko (D-NY20), Chair of the U.S. | |
| House Energy and Commerce Committee’s Subcommittee on Environment and | |
| Climate Change, in an April 2021 announcement of his request for Federal | |
| funding to implement the Cohoes, NY Municipal Floating Solar | |
| Demonstration Project:')), | |
| tags$p(tags$blockquote(tags$i( | |
| '“The Cohoes floating solar initiative offers a groundbreaking opportunity | |
| to localize power generation, increase grid stability and drive down | |
| utility costs for consumers. I applaud this bold collaboration to develop | |
| innovative solutions that will help us realize the full potential of our | |
| energy infrastructure, and I hope this project can serve as a model for | |
| tackling some of America’s thorniest challenges regarding clean energy | |
| generation and preventing the worst outcomes of the climate crisis.” | |
| U.S. Rep Paul Tonko said.'))), | |
| # More info | |
| tags$p( | |
| 'This "Floating Solar Explorer" has been developed by the Rensselaer | |
| Institute for Data Exploration and Applications (IDEA) at Rensselaer | |
| Polytechnic Instuitute in support of the proposed City of Cohoes, NY | |
| Municipal Floating Solar Demonstration Project. This initial collaboration | |
| is designed to visualize the energy-generation opportunities and potential | |
| economic impact of adopting floating solar on human-made water reservoirs. ' | |
| ), | |
| tags$p( | |
| "The Floating Solar Explorer’s U.S. map charts the 24,419 NREL-identified | |
| water reservoirs potentially 'suitable' for floating solar, by ownership | |
| and potential electricity generation (per MWh)." | |
| ), | |
| tags$p( | |
| 'The individual state map charts the NREL-identified water reservoirs | |
| potentially "suitable" for floating solar in the selected state, by ownership | |
| and potential electricity generation (per MWh).' | |
| ), | |
| tags$p( | |
| 'A municipally owned and operated floating solar installation not only | |
| generates clean energy, it has the capacity to generate economic opportunity | |
| for the community as a result of electric bill savings. The City of Cohoes, | |
| a Low/Moderate Income (LMI) community with an Environmental Justice | |
| (EJ) designation, anticipates saving approximately $500,000 per year | |
| in electricity costs; money that can be reinvested back into the working | |
| class community.' | |
| ), | |
| tags$p( | |
| 'The Floating Solar Explorer incorporates economic data, to better | |
| illustrate where the state and national potential is for municipal | |
| floating solar installations in LMI communities like Cohoes.' | |
| ), | |
| tags$p( | |
| 'Meeting the ambitious and essential clean energy goals that have been | |
| set at the Federal, State, and local levels will require all sectors at | |
| all levels to do their part. Cities are on the front lines of that effort, | |
| and must lead by example to create the necessary changes at the required | |
| pace. Municipally owned and operated floating solar installations may | |
| offer a new opportunity to generate success.' | |
| ), | |
| tags$p( | |
| 'This early-stage Rensselaer IDEA project, developed by students and staff, | |
| is an example of the type of Floating Solar-related undergraduate student | |
| engagement and university-based research projects that can be sparked by | |
| and/or help advance this clean energy technology’s growth in the U.S.' | |
| ), | |
| # Data Sources block | |
| tags$h3("Data Sources of the Floating Solar Explorer"), | |
| tags$p("Estimated photovoltaic production data provided by National Renewable | |
| Energy Laboratory (NREL); see:", | |
| tags$a("Floating photovoltaic systems: assessing the technical potential | |
| of photovoltaic systems on man-made water bodies in the continental | |
| United States.", | |
| href="https://pubs.acs.org/doi/abs/10.1021/acs.est.8b04735"), | |
| "Regarding 'suitability,' the NREL study notes:", | |
| tags$i("the high-level data used and analyzed lacks the resolution for | |
| case-by-case feasibility, and the results should only be considered | |
| as a starting point for national and regional examinations.")), | |
| tags$p("Estimated reservoir area obtained from US Army Corps of Engineers | |
| (USACE). The NREL model and the underlying data may contain errors."), | |
| tags$p("Income data on the State Map is obtained from the US Census. Low income | |
| is defined as up to 50 percent of the Area Median Income (AMI); moderate | |
| income is defined as greater than 50 percent AMI and up to 80 percent AMI."), | |
| tags$p("Electric substation data on the State Map is obtained from the Homeland | |
| Infrastructure Foundation-Level Data (HIFLD)."), | |
| # Further information block | |
| tags$h3('Further information'), | |
| tags$p("Developed by the Rensselaer Institute for Data Exploration and Applications | |
| (IDEA) in support of the proposed City of Cohoes, NY Municipal Floating Solar | |
| Demonstration Project"), | |
| tags$p('NREL:', | |
| tags$a('NREL Details Great Potential for Floating PV Systems; Technology | |
| Already in Widespread Use Overseas, Especially in Japan.', | |
| href='https://www.nrel.gov/news/press/2018/nrel-details-great-potential-for-floating-pv-systems.html'), | |
| 'News release (Dec. 27, 2018)'), | |
| tags$p('About The Rensselaer IDEA:', | |
| tags$a('https://idea.rpi.edu/', href='https://idea.rpi.edu/')), | |
| tags$p('Building Floating Solar in Cohoes:', | |
| tags$a('https://www.ci.cohoes.ny.us/523/Building-Floating-Solar-in-Cohoes', | |
| href='https://www.ci.cohoes.ny.us/523/Building-Floating-Solar-in-Cohoes')), | |
| tags$p('For more information on the Cohoes, NY Municipal Floating Solar Demonstration | |
| project contact: Theresa Bourgeois, Director of Operations, City of Cohoes', | |
| tags$a('TBourgeois@ci.cohoes.ny.us',href='mailto:TBourgeois@ci.cohoes.ny.us'), | |
| 'or 518-903-0142 or Joseph Seman-Graves, City Planner, City of Cohoes', | |
| tags$a('JSeman-Graves@ci.cohoes.ny.us', href='mailto:JSeman-Graves@ci.cohoes.ny.us'), | |
| 'or 518-233-2130'), | |
| # IDEA logo | |
| img(src='IDEA_logo_500.png', align = "right", height=75) | |
| ) | |
| ) | |
| ) | |
| # Server ===== | |
| server <- function(input, output, session) { | |
| # Data ===== | |
| lowmod_data <- reactive({return(get_dataset(input$state, 'lowmod'))}) | |
| cd_data <- reactive({return(get_dataset(input$state, 'cd'))}) | |
| reservoir_data <- reactive({return(get_dataset(input$state, 'reservoir'))}) | |
| substation_data <- reactive({return(get_dataset(input$state, 'substation'))}) | |
| # Electric substation icon ===== | |
| sub_icon <- makeIcon( | |
| iconUrl = 'substation.png', | |
| iconWidth = 18, | |
| iconHeight = 18 | |
| ) | |
| # Update congressional district selection upon changing states ===== | |
| # Set to At-large for states containing only one congressional district | |
| # Default to 20 for New York | |
| # Set to 1 for other states | |
| get_sel_dist <- reactive({ | |
| single_dist_states <- c('Alaska', 'Delaware', 'Montana', 'North Dakota', | |
| 'South Dakota', 'Vermont', 'Wyoming') | |
| if (input$state %in% single_dist_states) { | |
| return('At-large') | |
| } else if (input$state == 'New York') { | |
| return('20') | |
| } else { | |
| return('1') | |
| } | |
| }) | |
| observeEvent( | |
| input$state, { | |
| updateSelectInput(session, | |
| inputId = 'district', | |
| choices = sort(unique(lowmod_data()$DISTRICT)), | |
| selected = get_sel_dist()) | |
| } | |
| ) | |
| # Reactive outputs, excluding state reservoirs map ==== | |
| # Show currently selected state on the top left corner | |
| output$input_text <- renderText(paste0('Selected State: ', | |
| state_choices[which(state_choices$State == input$state), 2])) | |
| # Show currently selected state above map | |
| output$input_state <- renderText(paste('Potentially Suitable Reservoirs in ', ' by Census Tract', | |
| sep = input$state)) | |
| # State statistics | |
| output$state_stats <- renderText(paste('State Statistics of ', input$state, sep = '')) | |
| output$total_res <- renderText(paste0('Total number of potentially suitable reservoirs | |
| for floating solar: ', | |
| nrow(reservoir_data()), sep = '')) | |
| output$owner_type_dist <- renderPlot(ggplot(data = reservoir_data(), | |
| aes(x = fct_infreq(prim_owner), | |
| fill = prim_purpose)) + | |
| geom_bar(position = 'stack') + | |
| ggtitle('Distribution of Primary Purposes Across Reservoir Owner Types') + | |
| xlab('Reservoir Owner Type') + ylab('Count') + | |
| theme(text = element_text(size = 10)) + | |
| scale_fill_discrete(name = "Primary Purpose")) | |
| output$prim_purpose_dist <- renderPlot(ggplot(data = reservoir_data(), | |
| aes(x = fct_infreq(prim_purpose), | |
| fill = prim_owner)) + | |
| geom_bar(position = 'stack') + | |
| ggtitle('Distribution of Reservoir Owner Types Across Primary Purposes') + | |
| xlab('Primary Purpose') + ylab('') + | |
| theme(text = element_text(size = 10)) + | |
| scale_fill_manual( | |
| name = "Reservoir Owner Type", | |
| values = c( | |
| 'Federal' = '#7FC97F', | |
| 'State' = '#BEAED4', | |
| 'Local Government' = '#FDC086', | |
| 'Public Utility' = '#FFFF99', | |
| 'Private' = '#386CB0' | |
| ))) | |
| output$rc_owner_type <- renderPlot(ggplot(data = reservoir_data(), | |
| aes(x = fct_infreq(prim_owner), | |
| fill = lowmod_bucket)) + | |
| geom_bar(position = 'stack') + | |
| xlab('Reservoir Owner Type') + ylab('Count') + | |
| theme(text = element_text(size = 10)) + | |
| scale_fill_manual( | |
| name = "Low/Mod Income Level", | |
| values = c( | |
| '0 - 20' = '#f7f7f7', | |
| '20 - 40' = '#cccccc', | |
| '40 - 60' = '#969696', | |
| '60 - 80' = '#636363', | |
| '80 - 100' = '#252525', | |
| 'No LMI Data' = '276DC2' | |
| ))) | |
| # + theme(legend.position = 'none')) | |
| output$rc_prim_purpose <- renderPlot(ggplot(data = reservoir_data(), | |
| aes(x = fct_infreq(prim_purpose), | |
| fill = lowmod_bucket)) + | |
| geom_bar(position = 'stack') + | |
| xlab('Primary Purpose') + ylab('') + | |
| theme(text = element_text(size = 10)) + | |
| scale_fill_manual( | |
| name = "Low/Mod Income Level", | |
| values = c( | |
| '0 - 20' = '#f7f7f7', | |
| '20 - 40' = '#cccccc', | |
| '40 - 60' = '#969696', | |
| '60 - 80' = '#636363', | |
| '80 - 100' = '#252525', | |
| 'No LMI Data' = '276DC2' | |
| ))) | |
| output$table_1 <- renderDataTable(get_table(reservoir_data(), 1), | |
| options = list(dom = 't')) | |
| output$table_2 <- renderDataTable(get_table(reservoir_data(), 2), | |
| options = list(dom = 't')) | |
| output$table_3 <- renderDataTable(get_table(reservoir_data(), 3), | |
| options = list(dom = 't')) | |
| output$t1 <- renderText(paste('Breakdown of reservoir types in ', input$state, sep = '')) | |
| output$t2 <- renderText(paste('Reservoir distribution in ', | |
| ', categorized by reservoir owner types, across low / moderate income levels', | |
| sep = input$state)) | |
| output$t3 <- renderText(paste('Reservoir distribution in ', | |
| ', categorized by primary purposes, across low / moderate income levels', | |
| sep = input$state)) | |
| # State reservoirs map ===== | |
| # Shading for census tracts ===== | |
| bins <- c(0, 20, 40, 60, 80, 100) | |
| dam_colors <- brewer.pal(n = 5, name = 'Accent') | |
| dam_labels <- c("Federal", | |
| "State", | |
| "Local Government", | |
| "Public Utility", | |
| "Private") | |
| names(dam_colors) <- dam_labels | |
| pal_dam <- colorFactor(dam_colors, | |
| levels = as.factor(dam_labels), | |
| ordered = TRUE) | |
| tag.map.title <- tags$style(HTML(" | |
| .leaflet-control.map-title { | |
| transform: translate(-50%,20%); | |
| position: fixed !important; | |
| left: 50%; | |
| text-align: left; | |
| padding-left: 10px; | |
| padding-right: 10px; | |
| background: rgba(255,255,255,0.75); | |
| font-weight: bold; | |
| font-size: 20px; | |
| }")) | |
| # Congressional district selection for leaflet ===== | |
| current_district <- reactive({ | |
| d <- input$district | |
| temp <- lowmod_data() %>% filter(DISTRICT == input$district) | |
| if (length(st_coordinates(temp)) == 0) { | |
| if (length(unique(lowmod_data()$DISTRICT)) == 1) { # Single congressional district states | |
| d <- 'At-large' | |
| } else { # States with multiple congressional districts | |
| d <- 1 | |
| } | |
| temp <- lowmod_data() %>% filter(DISTRICT == d) | |
| } | |
| return(temp) | |
| }) | |
| # Palette ===== | |
| dist_pal <- reactive({ | |
| colorBin(palette = 'Greys', domain = current_district()$Lowmod_pct, bins = bins) | |
| }) | |
| # Get dynamic zoom info ===== | |
| district_view <- reactive({ | |
| get_view(current_district()) | |
| }) | |
| # Substation selection ===== | |
| substations_in_range <- reactive({ | |
| view <- get_view(current_district()) | |
| # Get the center longitude and latitude of the currently selected district | |
| center_long <- view[1] | |
| center_lat <- view[2] | |
| # Filter substations to those within the selected range | |
| # One degree of latitude = 69 miles; one degree of longitude = 54.6 miles | |
| subs_in_range <- substation_data() %>% | |
| filter(sqrt(((LATITUDE - center_lat) * 69) ^ 2 + ((LONGITUDE - center_long) * 54.6) ^ 2) | |
| <= as.integer(input$distance)) | |
| return(subs_in_range) | |
| }) | |
| # Leaflet map ===== | |
| output$reservoir_map <- renderLeaflet({ | |
| leaflet() %>% | |
| # Background map | |
| addTiles() %>% | |
| # Dynamic zoom | |
| setView(lng = district_view()[1], | |
| lat = district_view()[2], | |
| zoom = district_view()[3]) %>% | |
| # Reservoir coloring legend ('Reservoir Owner Type') | |
| addLegend("topleft", | |
| colors = c("#7FC97F","#BEAED4","#FDC086","#FFFF99","#386CB0"), | |
| labels = dam_labels, | |
| title = "Reservoir Owner Type", | |
| opacity = 1 , | |
| labFormat = function(type, cuts, p){ # Forces correct label order | |
| paste0(dam_labels) | |
| }) %>% | |
| # Census tract legend ('Percentage Low or Moderate Income') | |
| addLegend('topleft', | |
| pal = dist_pal(), | |
| values = current_district()$Lowmod_pct, | |
| title = 'Percentage of Low or </br>Moderate Income', | |
| opacity = 1) | |
| }) | |
| # Update congressional district shading, outline, and markers upon | |
| # changing districts, state, or substation range | |
| observeEvent(c(input$state, input$district, input$distance), { | |
| leafletProxy('reservoir_map', session) %>% | |
| # Clear substations and range circle upon update | |
| clearGroup(group = list('substations', 'range', 'census_tract')) %>% | |
| # Census tract shading within the selected congressional district | |
| addPolygons( | |
| data = current_district(), | |
| fillColor = ~dist_pal()(Lowmod_pct), # color of census tract shading | |
| color = 'black', # color of census tract borders | |
| fillOpacity = 0.7, # opacity of shading | |
| weight = 0.75, # width of census tract border | |
| group = 'census_tract' | |
| ) %>% | |
| # Substation range circle | |
| addCircles( | |
| lng = district_view()[1], | |
| lat = district_view()[2], | |
| weight = 1, | |
| radius = as.integer(input$distance) * 1609.34, # leaflet radius is in meters | |
| color = 'blue', | |
| fillColor = 'lightblue', | |
| fillOpacity = 0, | |
| group = 'range' | |
| ) %>% | |
| # Congressional district outline | |
| addPolygons( | |
| data = cd_data(), | |
| weight = 2, | |
| fillOpacity = 0, | |
| color = 'green', | |
| group = 'outline' | |
| ) %>% | |
| # Reservoirs | |
| addCircleMarkers( | |
| data= reservoir_data(), | |
| weight = 2, | |
| opacity = 1, | |
| radius = 5, | |
| fillOpacity = 1, | |
| lng=reservoir_data()$long, | |
| lat=reservoir_data()$lat, | |
| color=~pal_dam(as.factor(reservoir_data()$prim_owner)), | |
| group = 'reservoirs', | |
| popup = paste0( | |
| reservoir_data()$dam_name,"<br/>", | |
| "Primary Purpose: ", reservoir_data()$prim_purpose, "<br/>", | |
| "Reservoir Owner Type: ", reservoir_data()$prim_owner, "<br/>", | |
| "Low/Mod Income Pct: ", reservoir_data()$Lowmod_pct,"%<br/>", | |
| "Estimated Surface Area (USACE): ",reservoir_data()$nid_area," acres<br/>", | |
| "Estimated PV Annual Production (NREL): ",reservoir_data()$pv_annual_kWh/1000," MWh<br/>", | |
| NULL | |
| ) | |
| ) %>% | |
| # Substations | |
| addMarkers( | |
| data = substations_in_range(), | |
| lng=substations_in_range()$LONGITUDE, | |
| lat=substations_in_range()$LATITUDE, | |
| icon = sub_icon, | |
| group = 'substations', | |
| popup = paste0(substations_in_range()$NAME, '<br/>', | |
| 'Substation ID: ', substations_in_range()$ID, "<br/>", | |
| 'Location: ', str_to_title(substations_in_range()$CITY), | |
| ', ', substations_in_range()$STATE, '<br/>', | |
| 'Type: ', str_to_title(substations_in_range()$TYPE), '<br/>', | |
| 'Status: ', str_to_title(substations_in_range()$STATUS), '<br/>', | |
| 'Source: eia.gov<br/>', | |
| NULL | |
| ) | |
| ) | |
| }) | |
| # Plot the US map ===== | |
| output$us_map <- renderPlotly({ | |
| p1 <- plot_usmap() + | |
| geom_point(data = transformed, | |
| aes(x = x, y = y, | |
| size=pv_annual_kWh, | |
| text = dam_name, | |
| color = prim_owner)) + | |
| labs(title = "Estimated Photovoltaic Production of US Reservoirs", | |
| subtitle = "Source: NREL") + | |
| theme(legend.position = "right") + | |
| scale_colour_manual(name = "Owner Type", values = dam_colors) | |
| p2 <- ggplotly(p1, tooltip = c("dam_name","prim_owner")) | |
| m <- list( | |
| l = 50, | |
| r = 50, | |
| b = 100, | |
| t = 100, | |
| pad = 4 | |
| ) | |
| p2 %>% layout(autosize = F, | |
| width = 1000, height = 900, margin = m, | |
| legend = list( | |
| orientation = "h" | |
| )) | |
| }) | |
| # Content of modal dialog | |
| query_modal <- modalDialog( | |
| title = "Welcome to the Floating Solar Explorer", | |
| "PLEASE NOTE: This application is the result of the efforts of students | |
| and staff of the Rensselaer IDEA in collaboration with the City of Cohoes, NY. | |
| This is a prototype application and may not meet all of the standards one might | |
| expect of a production commercial product.", | |
| easyClose = F, | |
| footer = tagList(actionButton("run", "Continue with the Floating Solar Explorer")) | |
| ) | |
| # Creates modal dialog | |
| showModal(query_modal) | |
| # Removes modal | |
| observeEvent(input$run, {removeModal()}) | |
| } | |
| shinyApp(ui, server) |