diff --git a/.DS_Store b/.DS_Store
new file mode 100644
index 0000000..3812b47
Binary files /dev/null and b/.DS_Store differ
diff --git a/app/.DS_Store b/app/.DS_Store
new file mode 100644
index 0000000..f0840c5
Binary files /dev/null and b/app/.DS_Store differ
diff --git a/app/code/.DS_Store b/app/code/.DS_Store
index 7eab5e8..f379bc6 100644
Binary files a/app/code/.DS_Store and b/app/code/.DS_Store differ
diff --git a/app/code/.DS_Store~HEAD b/app/code/.DS_Store~HEAD
new file mode 100644
index 0000000..f379bc6
Binary files /dev/null and b/app/code/.DS_Store~HEAD differ
diff --git a/app/code/.gitignore b/app/code/.gitignore
new file mode 100644
index 0000000..e43b0f9
--- /dev/null
+++ b/app/code/.gitignore
@@ -0,0 +1 @@
+.DS_Store
diff --git a/app/code/helper_code/campus-belonging.Rmd b/app/code/helper_code/campus-belonging.Rmd
index 166f7c2..4119f59 100644
--- a/app/code/helper_code/campus-belonging.Rmd
+++ b/app/code/helper_code/campus-belonging.Rmd
@@ -4,6 +4,9 @@ title: "Campus Belonging"
```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = TRUE)
+library(shinydashboard)
+library(usethis)
+use_git_config(user.name = "dfaragon", user.email = "dotz.da@gmail.com")
```
## What we need here:
@@ -12,6 +15,7 @@ knitr::opts_chunk$set(echo = TRUE)
- filter apply to both maps
- maps are already extracted in "maps" folder: i have the standardized code for this already created so let me know if you are doing this piece -anwesha
- hover for text (see NPS example)
+- just heat maps?
## Brian's Code
```{r}
@@ -23,6 +27,17 @@ knitr::opts_chunk$set(echo = TRUE)
```
+## Data Tables
+```{r}
+# # bar plots
+# tables_bp <- readRDS("/Users/daragon/Library/CloudStorage/OneDrive-UniversityOfOregon/OAR EXTERN/SWaSI/place-based belonging/pbb_tables_for_bp.rds")
+# # tree maps
+# tables_tm <- readRDS("/Users/daragon/Library/CloudStorage/OneDrive-UniversityOfOregon/OAR EXTERN/SWaSI/place-based belonging/pbb_tables_for_tm.rds")
+# # reactable tables
+# tables_rt <- readRDS("/Users/daragon/Library/CloudStorage/OneDrive-UniversityOfOregon/OAR EXTERN/SWaSI/place-based belonging/pbb_tables_for_rt.rds")
+
+```
+
## UI draft
```{r}
@@ -33,9 +48,15 @@ dashboardBody(
# includeMarkdown("www/summary.md"),
fluidRow(
column(3, uiOutput("dynamicFilter")),
+<<<<<<< HEAD
+ column(3, reactableOutput("table")) %>% withSpinner(color = "navy"))))
+ # column(3, inclusive_bar_fun("campusImage")) %>% withSpinner(color =
+# ))
+=======
column(3, reactableOutput("table")) %>% withSpinner(color = "navy"))
#add map tabItem
))
+>>>>>>> main
```
@@ -47,13 +68,21 @@ shinyServer(function(input, output) {
# Dynamic UI for additional filters
output$dynamicFilter <- renderUI({
- if(input$typeSelect == "Undergraduate") {
+ if(input$typeSelect == "US Undergraduate") { # added US for clarity
selectInput("yearSelect", "Select Year:",
choices = c("2018", "2019", "2020", "2022", "Overall"))
} else if(input$typeSelect == "International") {
selectInput("intSelect", "Select Category:",
choices = c("Overall", "Undergrad and Grad 2022", "Undergrad 2020"))
+<<<<<<< HEAD
+<<<<<<< HEAD
+ # Here, do I add an option for campus inclusiveness after choosing the hear and needing to choose all years, 4th-year, 3-rd year etc.
+=======
+ #add whichever remaining filter (see pbb HTML)
+>>>>>>> main
+=======
#add whichever remaining filter (see pbb HTML)
+>>>>>>> main
} else {
return()
}
@@ -61,53 +90,309 @@ shinyServer(function(input, output) {
# Render the correct table based on the input selection
+######## campus summary tables ########
+ ## do not change this is your original example and is correct ##
output$table <- renderReactable({
if(input$typeSelect == "Undergraduate" && input$yearSelect == "Overall") {
- rt_cam_us_ug
+ reactable_fun(us_ug)
} else if(input$typeSelect == "Undergraduate" && input$yearSelect == "2022") {
- rt_cam_us_ug_ay2122
+ reactable_fun(us_ug_ay2122)
} else if(input$typeSelect == "Undergraduate" && input$yearSelect == "2020") {
- rt_cam_us_ug_ay1920
+ reactable_fun(us_ug_ay1920)
} else if(input$typeSelect == "Undergraduate" && input$yearSelect == "2019") {
- rt_cam_us_ug_ay1819
+ reactable_fun(us_ug_ay1819)
} else if(input$typeSelect == "Undergraduate" && input$yearSelect == "2018") {
- rt_cam_us_ug_ay1718
+ reactable_fun(us_ug_ay1718)
} else if(input$typeSelect == "International" && input$intSelect == "Overall") {
- rt_cam_i
+ reactable_fun(i)
} else if(input$typeSelect == "International" && input$intSelect == "Undergrad and Grad 2022") {
- rt_cam_i_ay2122
+ reactable_fun(i_ay2122)
} else if(input$typeSelect == "International" && input$intSelect == "Undergrad 2020") {
- rt_cam_i_ug_ay1920
+ reactable_fun(i_ug_ay1920)
} else if(input$typeSelect == "Graduate") {
- rt_cam_gr_ay2122
+ reactable_fun(gr_ay2122)
+ }
+ })
+
+
+######## campus heat maps ########
+ output$campusHeatMaps <- renderImage({
+ if(input$typeSelect == "US Undergraduate" && input$yearSelect == "Spring2022" && input$yearSelect == "AllYears") {
+ tags$div(
+ tags$img(src = "maps/map_cam_b_us_ug_ay2122.png", style = "display:inline-block;margin-right:10px;"),
+ tags$img(src = "maps/map_cam_db_us_ug_ay2122.png", style = "display:inline-block;")
+ )
+ } else if(input$typeSelect == "US Undergraduate" && input$yearSelect == "Spring2022" && input$yearSelect == "4th-Year") {
+ tags$div(
+ tags$img(src = "maps/map_cam_b_us_ug_ay2122_c2122.png", style = "display:inline-block;margin-right:10px;"),
+ tags$img(src = "maps/map_cam_db_us_ug_ay2122_c2122.png", style = "display:inline-block;")
+ )
+ } else if(input$typeSelect == "US Undergraduate" && input$yearSelect == "Spring2022" && input$yearSelect == "3th-Year") {
+ tags$div(
+ tags$img(src = "maps/map_cam_b_us_ug_ay2122_c2021.png", style = "display:inline-block;margin-right:10px;"),
+ tags$img(src = "maps/map_cam_db_us_ug_ay2122_c2021.png", style = "display:inline-block;")
+ )
+ } else if(input$typeSelect == "US Undergraduate" && input$yearSelect == "Spring2022" && input$yearSelect == "2th-Year") {
+ tags$div(
+ tags$img(src = "maps/map_cam_b_us_ug_ay2122_c1920.png", style = "display:inline-block;margin-right:10px;"),
+ tags$img(src = "maps/map_cam_db_us_ug_ay2122_c1920.png", style = "display:inline-block;")
+ )
+ } else if(input$typeSelect == "US Undergraduate" && input$yearSelect == "Spring2022" && input$yearSelect == "1th-Year") {
+ tags$div(
+ tags$img(src = "maps/map_cam_b_us_ug_ay2122_c1819.png", style = "display:inline-block;margin-right:10px;"),
+ tags$img(src = "maps/map_cam_db_us_ug_ay2122_c1819.png", style = "display:inline-block;")
+ )
+ #### spring 2020, 2021 was skipped
+ } else if(input$typeSelect == "US Undergraduate" && input$yearSelect == "Spring2020" && input$yearSelect == "1st-through-5th-Year") {
+ tags$div(
+ tags$img(src = "maps/map_cam_b_us_ug_ay1920.png", style = "display:inline-block;margin-right:10px;"),
+ tags$img(src = "maps/map_cam_db_us_ug_ay1920.png", style = "display:inline-block;")
+ )
+ } else if(input$typeSelect == "US Undergraduate" && input$yearSelect == "Spring2020" && input$yearSelect == "4th-Year") {
+ tags$div(
+ tags$img(src = "maps/map_cam_b_us_ug_ay1920_c1920.png", style = "display:inline-block;margin-right:10px;"),
+ tags$img(src = "maps/map_cam_db_us_ug_ay1920_c1920.png", style = "display:inline-block;")
+ )
+ } else if(input$typeSelect == "US Undergraduate" && input$yearSelect == "Spring2020" && input$yearSelect == "3th-Year") {
+ tags$div(
+ tags$img(src = "maps/map_cam_b_us_ug_ay1920_c1819.png", style = "display:inline-block;margin-right:10px;"),
+ tags$img(src = "maps/map_cam_db_us_ug_ay1920_c1819.png", style = "display:inline-block;")
+ )
+ } else if(input$typeSelect == "US Undergraduate" && input$yearSelect == "Spring2020" && input$yearSelect == "2th-Year") {
+ tags$div(
+ tags$img(src = "maps/map_cam_b_us_ug_ay1920_c1718.png", style = "display:inline-block;margin-right:10px;"),
+ tags$img(src = "maps/map_cam_db_us_ug_ay1920_c1718.png", style = "display:inline-block;")
+ )
+ } else if(input$typeSelect == "US Undergraduate" && input$yearSelect == "Spring2020" && input$yearSelect == "1th-Year") {
+ tags$div(
+ tags$img(src = "maps/map_cam_b_us_ug_ay1920_c1617.png", style = "display:inline-block;margin-right:10px;"),
+ tags$img(src = "maps/map_cam_db_us_ug_ay1920_c1617.png", style = "display:inline-block;")
+ )
+ #### spring 2019
+ } else if(input$typeSelect == "US Undergraduate" && input$yearSelect == "Spring2019" && input$yearSelect == "1st-through-4th-Year") {
+ tags$div(
+ tags$img(src = "maps/map_cam_b_us_ug_ay2122_c2122.png", style = "display:inline-block;margin-right:10px;"),
+ tags$img(src = "maps/map_cam_db_us_ug_ay2122_c2122.png", style = "display:inline-block;")
+ )
+ } else if(input$typeSelect == "US Undergraduate" && input$yearSelect == "Spring2019" && input$yearSelect == "4th-Year") {
+ tags$div(
+ tags$img(src = "maps/map_cam_b_us_ug_ay1819_c2122.png", style = "display:inline-block;margin-right:10px;"),
+ tags$img(src = "maps/map_cam_db_us_ug_ay1819_c2122.png", style = "display:inline-block;")
+ )
+ } else if(input$typeSelect == "US Undergraduate" && input$yearSelect == "Spring2019" && input$yearSelect == "3th-Year") {
+ tags$div(
+ tags$img(src = "maps/map_cam_b_us_ug_ay1819_c2122.png", style = "display:inline-block;margin-right:10px;"),
+ tags$img(src = "maps/map_cam_db_us_ug_ay1819_c2122.png", style = "display:inline-block;")
+ )
+ } else if(input$typeSelect == "US Undergraduate" && input$yearSelect == "Spring2019" && input$yearSelect == "2th-Year") {
+ tags$div(
+ tags$img(src = "maps/map_cam_b_us_ug_ay1819_c2122.png", style = "display:inline-block;margin-right:10px;"),
+ tags$img(src = "maps/map_cam_db_us_ug_ay1819_c2122.png", style = "display:inline-block;")
+ )
+ } else if(input$typeSelect == "US Undergraduate" && input$yearSelect == "Spring2019" && input$yearSelect == "1th-Year") {
+ tags$div(
+ tags$img(src = "maps/map_cam_b_us_ug_ay1819_c2122.png", style = "display:inline-block;margin-right:10px;"),
+ tags$img(src = "maps/map_cam_db_us_ug_ay1819_c2122.png", style = "display:inline-block;")
+ )
+ #### spring 2018
+ } else if(input$typeSelect == "US Undergraduate" && input$yearSelect == "Spring2018" && input$yearSelect == "1st-through-3th-Year") {
+ tags$div(
+ tags$img(src = "maps/map_cam_b_us_ug_ay1718.png", style = "display:inline-block;margin-right:10px;"),
+ tags$img(src = "maps/map_cam_db_us_ug_ay1718.png", style = "display:inline-block;")
+ )
+ ### international
+ } else if(input$typeSelect == "International" && input$intSelect == "Undergrad and Grad Spring 2022") {
+ tags$div(
+ tags$img(src = "maps/map_cam_b_i_ay2122.png", style = "display:inline-block;margin-right:10px;"),
+ tags$img(src = "maps/map_cam_db_i_ay2122.png", style = "display:inline-block;")
+ )
+ } else if(input$typeSelect == "International" && input$intSelect == "Undergrad Spring 2020") {
+ tags$div(
+ tags$img(src = "maps/map_cam_db_i_ug_ay1920.png", style = "display:inline-block;margin-right:10px;"),
+ tags$img(src = "maps/map_cam_db_i_ug_ay1920.png", style = "display:inline-block;")
+ )
+ ### graduate student
+ } else if(input$typeSelect == "Graduate") { # no other option needed here
+ tags$div(
+ tags$img(src = "maps/map_cam_b_gr_ay2122.png", style = "display:inline-block;margin-right:10px;"),
+ tags$img(src = "maps/map_cam_db_gr_ay2122.png", style = "display:inline-block;")
+ )
}
})
+
+})
- output$campusImage <- renderImage({
+
+# first version
+ # output$campusImage <- renderImage({
# Decide which table to render after the data has been effectively filtered based on the following filters
- if(input$typeSelect == "Undergraduate" && (is.null(input$yearSelect) || input$yearSelect == "Overall")) {
- return("Select year breakdown :)")
- } else if(input$typeSelect == "Undergraduate" && length(input$yearSelect) && input$yearSelect == "2022") {
- list(src = "maps/map_cam_b_us_ug_ay2122.png")
- } else if(input$typeSelect == "Undergraduate" && length(input$yearSelect) && input$yearSelect == "2020") {
- list(src = "maps/map_cam_b_us_ug_ay1920.png")
- } else if(input$typeSelect == "Undergraduate" && length(input$yearSelect) && input$yearSelect == "2019") {
- list(src = "maps/map_cam_b_us_ug_ay1819.png")
- } else if(input$typeSelect == "Undergraduate" && length(input$yearSelect) && input$yearSelect == "2018") {
- list(src = "maps/map_cam_b_us_ug_ay1718.png")
+ # if(input$typeSelect == "US Undergraduate" && (is.null(input$yearSelect) || input$yearSelect == "Overall")) {
+ # return("Select year breakdown :)")
+ # } else if(input$typeSelect == "US Undergraduate" && length(input$yearSelect) && input$yearSelect == "2022") {
+ # list(src = "maps/b_map_cam_us_ug_ay2122.png")
+ # } else if(input$typeSelect == "US Undergraduate" && length(input$yearSelect) && input$yearSelect == "2020") {
+ # list(src = "maps/b_map_cam_us_ug_ay1920.png")
+ # } else if(input$typeSelect == "US Undergraduate" && length(input$yearSelect) && input$yearSelect == "2019") {
+ # list(src = "maps/b_map_cam_us_ug_ay1819.png")
+ # } else if(input$typeSelect == "US Undergraduate" && length(input$yearSelect) && input$yearSelect == "2018") {
+ # list(src = "maps/b_map_cam_us_ug_ay1718.png")
+ # } else if(input$typeSelect == "International" && input$intSelect == "Overall") {
+ # return("Select year breakdown :)")
+ # } else if(input$typeSelect == "International" && input$intSelect == "Undergrad and Grad 2022") {
+ # return(rt_cam_i_ay2122)
+ # list(src = "maps/b_map_cam_i_ug_ay2122.png")
+ # } else if(input$typeSelect == "International" && input$intSelect == "Undergrad 2020") {
+ # return(rt_cam_i_ug_ay1920)
+ # list(src = "maps/b_map_cam_i_ug_ay1920.png")
+ # } else if(input$typeSelect == "Graduate") {
+ # list(src = "maps/b_map_cam_gr_ay2122.png")
+ # }
+ # })
+
+
+######## campus belong tree plots ########
+#### may be computationally expensive
+ output$campusTreeMaps <- renderPlotly({
+ # Ensure yearSelect and classSelect are not null
+ if (is.null(input$yearSelect) || is.null(input$classSelect) || input$yearSelect == "Overall") {
+ return(NULL)
+ }
+
+ # Mapping the years to their codes
+ yearMapping <- list(
+ "Spring 2018" = "ay1718",
+ "Spring 2019" = "ay1819",
+ "Spring 2020" = "ay1920",
+ "Spring 2021" = "ay2021",
+ "Spring 2022" = "ay2122"
+ )
+
+ # Mapping the class to their codes
+ classMapping <- list(
+ "1st-Year" = "c1",
+ "2nd-Year" = "c2",
+ "3rd-Year" = "c3",
+ "4th-Year" = "c4"
+ )
+
+ yearCode <- yearMapping[[input$yearSelect]]
+ classCode <- classMapping[[input$classSelect]]
+
+ # Generate the data for the tree map
+ dat <- your_data_preparation_function(yearCode, classCode) # Assuming you have a function for this
+
+ # Call the inclusive_tree_fun function to generate the tree map
+ tree_map <- inclusive_tree_fun(dat)
+
+ # Return the plotly object
+ tree_map
+ })
+
+
+
+#### code if the computational cost of creating the maps is too much and we need to use already developed images
+# output$campusImage <- renderImage({
+# # Ensure yearSelect and classSelect are not null
+# if (is.null(input$yearSelect) || is.null(input$classSelect) || input$yearSelect == "Overall") {
+# return("Select year breakdown :)")
+# }
+#
+# # Mapping the years to their codes
+# yearMapping <- list(
+# "Spring 2018" = "ay1718",
+# "Spring 2019" = "ay1819",
+# "Spring 2020" = "ay1920",
+# "Spring 2021" = "ay2021",
+# "Spring 2022" = "ay2122"
+# )
+#
+# # Mapping the class to their codes
+# classMapping <- list(
+# "AllYears" = "c_all", # would require that those without class add "c_all" in png image name
+# "1st-Year" = "c2122",
+# "2nd-Year" = "c2021",
+# "3rd-Year" = "c1920",
+# "4th-Year" = "c1819"
+# )
+#
+# yearCode <- yearMapping[[input$yearSelect]]
+# classCode <- classMapping[[input$classSelect]]
+#
+# belongImage <- ""
+# dontBelongImage <- ""
+#
+# # Constructing the image paths based on the typeSelect
+# if (input$typeSelect == "US Undergraduate") {
+# belongImage <- paste0("maps/map_cam_b_us_ug_", yearCode, "_", classCode, ".png")
+# dontBelongImage <- paste0("maps/map_cam_db_us_ug_", yearCode, "_", classCode, ".png")
+# } else if (input$typeSelect == "International") {
+# belongImage <- paste0("maps/map_cam_b_i_", yearCode, "_", classCode, ".png")
+# dontBelongImage <- paste0("maps/map_cam_db_i_", yearCode, "_", classCode, ".png")
+# } else if (input$typeSelect == "Graduate") {
+# belongImage <- paste0("maps/map_cam_b_gr_", yearCode, "_", classCode, ".png")
+# dontBelongImage <- paste0("maps/map_cam_db_gr_", yearCode, "_", classCode, ".png")
+# }
+#
+# # Rendering both images
+# tags$div(
+# tags$img(src = belongImage, style = "display:inline-block;margin-right:10px;"),
+# tags$img(src = dontBelongImage, style = "display:inline-block;")
+# )
+# })
+# }
+
+
+######## campus bar plots ########
+ ## good ##
+ output$campusBarPlots <- renderReactable({
+ if(input$typeSelect == "US Undergraduate" && input$yearSelect == "Overall") {
+ reactable_fun(cam_us_ug)
+ } else if(input$typeSelect == "US Undergraduate" && input$yearSelect == "Spring2022" && input$yearSelect == "AllYears") {
+ inclusive_bar_fun(cam_us_ug_ay2122)
+ } else if(input$typeSelect == "US Undergraduate" && input$yearSelect == "Spring2022" && input$yearSelect == "4th-Year") {
+ inclusive_bar_fun(cam_us_ug_ay2122_c2122)
+ } else if(input$typeSelect == "US Undergraduate" && input$yearSelect == "Spring2022" && input$yearSelect == "3th-Year") {
+ inclusive_bar_fun(cam_us_ug_ay2122_c2021)
+ } else if(input$typeSelect == "US Undergraduate" && input$yearSelect == "Spring2022" && input$yearSelect == "2th-Year") {
+ inclusive_bar_fun(cam_us_ug_ay2122_c1920)
+ } else if(input$typeSelect == "US Undergraduate" && input$yearSelect == "Spring2022" && input$yearSelect == "1th-Year") {
+ inclusive_bar_fun(cam_us_ug_ay2122_c1819)
+ #### spring 2020, 2021 was skipped
+ } else if(input$typeSelect == "US Undergraduate" && input$yearSelect == "Spring2020" && input$yearSelect == "1st-through-5th-Year") {
+ inclusive_bar_fun(cam_us_ug_ay1920)
+ } else if(input$typeSelect == "US Undergraduate" && input$yearSelect == "Spring2022" && input$yearSelect == "4th-Year") {
+ inclusive_bar_fun(us_ug_ay1920_1920)
+ } else if(input$typeSelect == "US Undergraduate" && input$yearSelect == "Spring2022" && input$yearSelect == "3th-Year") {
+ inclusive_bar_fun(us_ug_ay1920_c1819)
+ } else if(input$typeSelect == "US Undergraduate" && input$yearSelect == "Spring2022" && input$yearSelect == "2th-Year") {
+ inclusive_bar_fun(us_ug_ay1920_c1718)
+ } else if(input$typeSelect == "US Undergraduate" && input$yearSelect == "Spring2022" && input$yearSelect == "1th-Year") {
+ inclusive_bar_fun(us_ug_ay2122_c1617)
+ #### spring 2019
+ } else if(input$typeSelect == "US Undergraduate" && input$yearSelect == "Spring2019" && input$yearSelect == "1st-through-4th-Year") {
+ inclusive_bar_fun(cam_us_ug_ay1819)
+ } else if(input$typeSelect == "US Undergraduate" && input$yearSelect == "Spring2019" && input$yearSelect == "4th-Year") {
+ inclusive_bar_fun(us_ug_ay1819_1819)
+ } else if(input$typeSelect == "US Undergraduate" && input$yearSelect == "Spring2019" && input$yearSelect == "3th-Year") {
+ inclusive_bar_fun(us_ug_ay1819_c1718)
+ } else if(input$typeSelect == "US Undergraduate" && input$yearSelect == "Spring2019" && input$yearSelect == "2th-Year") {
+ inclusive_bar_fun(us_ug_ay1819_c1617)
+ } else if(input$typeSelect == "US Undergraduate" && input$yearSelect == "Spring2019" && input$yearSelect == "1th-Year") {
+ inclusive_bar_fun(us_ug_ay1819_c1516)
+ #### spring 2018
+ } else if(input$typeSelect == "US Undergraduate" && input$yearSelect == "Spring2018" && input$yearSelect == "1st-through-3th-Year") {
+ inclusive_bar_fun(cam_us_ug_ay1718)
} else if(input$typeSelect == "International" && input$intSelect == "Overall") {
- return("Select year breakdown :)")
- } else if(input$typeSelect == "International" && input$intSelect == "Undergrad and Grad 2022") {
- return(rt_cam_i_ay2122)
- list(src = "maps/map_cam_b_i_ug_ay2122.png")
- } else if(input$typeSelect == "International" && input$intSelect == "Undergrad 2020") {
- return(rt_cam_i_ug_ay1920)
- list(src = "maps/map_cam_b_i_ug_ay1920.png")
- } else if(input$typeSelect == "Graduate") {
- list(src = "maps/map_cam_b_gr_ay2122.png")
+ inclusive_bar_fun(i) # where is this one??
+ } else if(input$typeSelect == "International" && input$intSelect == "Undergrad and Grad Spring 2022") {
+ inclusive_bar_fun(cam_i_ay2122)
+ } else if(input$typeSelect == "International" && input$intSelect == "Undergrad Spring 2020") {
+ inclusive_bar_fun(cam_i_ug_ay1920)
+ } else if(input$typeSelect == "Graduate") { # no other option needed here
+ inclusive_bar_fun(cam_gr_ay2122)
}
})
-
-})
+
+
```
diff --git a/app/code/helper_code/emu-belonging.Rmd b/app/code/helper_code/emu-belonging.Rmd
index ebacefb..081a5a0 100644
--- a/app/code/helper_code/emu-belonging.Rmd
+++ b/app/code/helper_code/emu-belonging.Rmd
@@ -13,391 +13,97 @@ knitr::opts_chunk$set(echo = TRUE)
- maps are already extracted in "maps" folder: i have the standardized code for this already created so let me know if you are doing this piece -anwesha
- hover for text (see NPS example)
+## Brian's Code
+```{r}
+```
-## UI draft
+## Standardized
```{r}
-# UI draft
+
+```
+## UI draft
+```{r}
dashboardBody(
tabItem(tabName = "table",
- fluidRow(
- column(3, uiOutput("dynamicFilter")),
- column(6, reactableOutput("table") %>% withSpinner(color = "navy")),
- column(3, plotOutput("emuImage"))
- )
- )
-)
-
-
-
-
+
+ # summary section
+ # includeMarkdown("www/summary.md"),
+ fluidRow(
+ column(3, uiOutput("dynamicFilter")),
+ column(3, reactableOutput("table")) %>% withSpinner(color = "navy"))
+ ))
```
## Server draft
```{r}
-
-library(reactable)
-library(htmltools)
-library(treemapify)
-library(shiny)
-library(tidyverse)
-library(rvest)
-library(leaflet.extras)
-
-########################################
-
-## Functions ##
-
-########################################
-
-#function for interactive reactables
-reactable_fun<- function(dat) {
- options(
- reactable.theme = reactableTheme(
- color = "hsl(233, 9%, 87%)",
- backgroundColor = "hsl(233, 9%, 19%)",
- borderColor = "hsl(233, 9%, 22%)",
- stripedColor = "hsl(233, 12%, 22%)",
- highlightColor = "hsl(233, 12%, 24%)",
- inputStyle = list(backgroundColor = "hsl(233, 9%, 25%)"),
- selectStyle = list(backgroundColor = "hsl(233, 9%, 25%)"),
- pageButtonHoverStyle = list(backgroundColor = "hsl(233, 9%, 25%)"),
- pageButtonActiveStyle = list(backgroundColor = "hsl(233, 9%, 28%)")
- )
- )
- rt<- dat %>%
- reactable(
- .,
- groupBy = "agg_place",
- showPageSizeOptions = T,
- paginateSubRows = T,
- defaultSorted = c("agg_place", "full_place"),
- sortable = T,
- showSortable = T,
- striped = T,
- highlight = T,
- bordered = T,
- defaultColDef = colDef(
- vAlign = "center",
- headerVAlign = "bottom"
- ),
- columns = list(
- agg_place = colDef(
- name = "Aggregated Place",
- filterable = T,
- align = "left",
- minWidth = 240
- ),
- full_place = colDef(
- name = "Place",
- align = "left",
- minWidth = 215
- ),
- n_b = colDef(
- aggregate = "sum",
- align = "center",
- format = colFormat(separators = T, digits = 0),
- html = T,
- header = JS(
- 'function(column) {
- return `n
` + "Belong"
- }'
- )
- ),
- n_db = colDef(
- aggregate = "sum",
- align = "center",
- format = colFormat(separators = T, digits = 0),
- html = T,
- header = JS(
- 'function(column) {
- return `n
` + "Don\'t" +
- "
Belong"
- }'
- )
- ),
- perc_click_b = colDef(
- aggregate = "sum",
- align = "center",
- format = colFormat(percent = T, digits = 1),
- html = T,
- header = JS(
- 'function(column) {
- return "Click" + "
Belong"
- }'
- )
- ),
- perc_click_db = colDef(
- aggregate = "sum",
- align = "center",
- format = colFormat(percent = T, digits = 1),
- html = T,
- header = JS(
- 'function(column) {
- return "Click" + "
Don\'t" + "
Belong"
- }'
- )
- ),
- perc_stud_b = colDef(
- aggregate = "sum",
- align = "center",
- format = colFormat(percent = T, digits = 1),
- html = T,
- header = JS(
- 'function(column) {
- return "Student" + "
Belong"
- }'
- )
- ),
- perc_stud_db = colDef(
- aggregate = "sum",
- align = "center",
- format = colFormat(percent = T, digits = 1),
- html = T,
- header = JS(
- 'function(column) {
- return "Student" + "
Don\'t" + "
Belong"
- }'
- )
- ),
- incl = colDef(
- aggregate = "mean",
- name = "Inclusive",
- align = "center",
- format = colFormat(percent = T, digits = 1)
- )
- )
- )
- return(rt)
-}
-
-##############################################
-## But tree maps go in this tab or elsewhere?
-
-# Function for tree map
-
-inclusive_tree_fun <- function(dat) {
- df <- dat
- cp <- as.vector(if_else(df$incl > 75, "#30313A", "#FCFFA4"))
- plot <- dat %>%
- ggplot(aes(area = tot, fill = incl, label = place)) +
- geom_treemap() +
- geom_treemap_text(place = "center", grow = TRUE, reflow = TRUE, color = cp) +
- scale_fill_viridis_c(name = "Inclusiveness", option = "inferno", limits = c(0, 100)) +
- theme(
- panel.background = element_rect(fill = "#30313A"),
- plot.background = element_rect(color = "#30313A", fill = "#30313A"),
- legend.background = element_rect(fill = "#30313A"),
- legend.title = element_text(color = "#FCFFA4"),
- legend.text = element_text(color = "#FCFFA4"),
- plot.margin = margin(0.5, 0.5, 0.5, 0.5, "cm")
- )
- return(plot)
-}
-
-
-########################################
-
-## Server Logic ##
-
-########################################
-
- # Dynamic UI for additional filters
shinyServer(function(input, output) {
# Dynamic UI for additional filters
output$dynamicFilter <- renderUI({
- if(input$typeSelect == "Undergraduate") {
- # Default tag list for Undergraduate
- filters <- tagList(
+ if(input$typeSelect == "Undergraduate") {
selectInput("yearSelect", "Select Year:",
- choices = c("2018", "2019", "2020", "2022", "Overall")),
- selectInput("cohortSelect", "Select Cohort:",
- choices = c("15/16", "16/17", "17/18", "18/19", "19/20", "20/21", "21/22", "All Cohorts"))
- )
-
- # Add floor selection for specific years
- if (input$yearSelect %in% c("2018", "2019")) {
- filters <- tagList(
- filters,
- selectInput("floorSelect", "Select Floor:",
- choices = c("Full Building", "Level 1", "Level 2"))
- )
- }
-
- return(filters)
- } else if(input$typeSelect == "International") {
- # Filters for International
- return(tagList(
+ choices = c("2018", "2019", "2020", "2022", "Overall"))
+ } else if(input$typeSelect == "International") {
selectInput("intSelect", "Select Category:",
choices = c("Overall", "Undergrad and Grad 2022", "Undergrad 2020"))
- ))
- } else if(input$typeSelect == "Graduate") {
- # Filters for Graduate
- return(tagList(
- selectInput("yearSelect", "Select Year:",
- choices = c("2022", "Overall"))
- ))
- }
- })
-
- # Belonging
- # undergrad full year belonging maps emu: 1920, 2122
- # undergrad cohort specific belonging maps emu: Year: 1920 level: Full building
- # cohort: 1617, 1718, 1819, 1920
- # undergrad cohort specific belonging maps emu: Year: 2122 level: Full building
- # cohort: 1819, 1920, 2021, 2122
- # undergrad belonging map emu: 1718
- # level 1 & level 2
- # undergrad belonging map emu: 1819
- # level 1 & level 2
- # cohort: 1516, 1617, 1718, 1819
- # grad full year belonging map emu: 2122
- # international full year belonging map emu: 2122
- # international undergrad full year belonging map: 1920
+ } else {
+ return()
+ }
+ })
- # Don't belong
- # undergrad full year don't belong maps emu: 1920, 2122
- # undergrad cohort specific dont belong emu: Year: 1920
- # cohort: 1617, 1718, 1819, 1920
- # undergrad cohort specific dont belong emu: Year: 2122
- # cohort: 1819, 1920, 2021, 2122
- # undergrad cohort specific dont belong emu: Year: 1718
- # level: level 1, level 2
- # undergrad cohort specific dont belong emu: Year: 1819
- # level: level 1, level 2
- # cohort: 1516, 1617, 1718, 1819
- # grad full year dont belong emu: 2122
- # international dont belong emu: 2122
- # international undergrad dont belong emu: 1920
# Render the correct table based on the input selection
output$table <- renderReactable({
- table_to_display <- NULL
-
- if(input$typeSelect == "Undergraduate") {
- year <- input$yearSelect
-
- if(is.null(year) || year == "Overall") {
- table_to_display <- reactable_fun(us_ug)
- } else if (year %in% c("2022", "2020", "2019", "2018")) {
- table_name <- paste0("rt_emu_us_ug_ay", year)
- table_to_display <- get(table_name) # dynamically get the table based on the year
+ if(input$typeSelect == "Undergraduate" && input$yearSelect == "Overall") {
+ rt_emu_us_ug
+ } else if(input$typeSelect == "Undergraduate" && input$yearSelect == "2022") {
+ rt_emu_us_ug_ay2122
+ } else if(input$typeSelect == "Undergraduate" && input$yearSelect == "2020") {
+ rt_emu_us_ug_ay1920
+ } else if(input$typeSelect == "Undergraduate" && input$yearSelect == "2019") {
+ rt_emu_us_ug_ay1819
+ } else if(input$typeSelect == "Undergraduate" && input$yearSelect == "2018") {
+ rt_emu_us_ug_ay1718
+ } else if(input$typeSelect == "International" && input$intSelect == "Overall") {
+ rt_emu_i
+ } else if(input$typeSelect == "International" && input$intSelect == "Undergrad and Grad 2022") {
+ rt_emu_i_ay2122
+ } else if(input$typeSelect == "International" && input$intSelect == "Undergrad 2020") {
+ rt_emu_i_ug_ay1920
+ } else if(input$typeSelect == "Graduate") {
+ rt_emu_gr_ay2122
}
- } else if(input$typeSelect == "International") {
- if (input$intSelect == "Overall") {
- table_to_display <- rt_emu_i
- } else if (input$intSelect == "Undergrad and Grad 2022") {
- table_to_display <- rt_emu_i_ay2122
- } else if (input$intSelect == "Undergrad 2020") {
- table_to_display <- rt_emu_i_ug_ay1920
- }
- } else if(input$typeSelect == "Graduate" && input$yearSelect == "2022") {
- table_to_display <- rt_emu_gr_ay2122
- }
- # Render the table if it has been set
- # Note: this is a chatGPT suggestion
- if (!is.null(table_to_display)) {
- reactable(table_to_display)
- } else {
- HTML("No data available for the selected options.
")
- }
- })
-
+ })
- output$emuImage <- renderUI({
- # Define the base path for images
- # Note: this is a chatGPT suggestion
- base_path <- "maps/"
-
- # Initialize the image source variables
- # Note: this is a chatGPT suggestion
- image_src_belonging <- ""
- image_src_not_belonging <- ""
-
- if(input$typeSelect == "Undergraduate") {
- # Note: this is a chatGPT suggestion
- year <- input$yearSelect
- cohort <- input$cohortSelect
- floor <- input$floorSelect
-
- if (is.null(year) || year == "Overall") {
- image_src_belonging <- ""
- image_src_not_belonging <- ""
- } else if (year == "2122") {
- if (cohort == "All Cohorts") {
- image_src_belonging <- paste0(base_path, "b_map_emu_us_ug_ay2122.png")
- image_src_not_belonging <- paste0(base_path, "db_map_emu_us_ug_ay2122.png")
- } else if (cohort %in% c("1819", "1920", "2021", "2122")) {
- cohort <- gsub("/", "", cohort) # Remove '/' from cohort name
- image_src_belonging <- paste0(base_path, "b_map_emu_us_ug_ay2122_c", cohort, ".png")
- image_src_not_belonging <- paste0(base_path, "db_map_emu_us_ug_ay2122_c", cohort, ".png")
- }
- } else if (year == "1920") {
- if (cohort == "All Cohorts") {
- image_src_belonging <- paste0(base_path, "b_map_emu_us_ug_ay1920.png")
- image_src_not_belonging <- paste0(base_path, "db_map_emu_us_ug_ay1920.png")
- } else if (cohort %in% c("1617", "1718", "1819", "1920")) {
- cohort <- gsub("/", "", cohort)
- image_src_belonging <- paste0(base_path, "b_map_emu_us_ug_ay1920_c", cohort, ".png")
- image_src_not_belonging <- paste0(base_path, "db_map_emu_us_ug_ay1920_c", cohort, ".png")
- }
- } else if (year == "1819") {
- if (floor == "Level 1") {
- if (cohort == "All Cohorts") {
- image_src_belonging <- paste0(base_path, "b_map_emu1_us_ug_ay1819.png")
- image_src_not_belonging <- paste0(base_path, "db_map_emu1_us_ug_ay1819.png")
- } else {
- cohort <- gsub("/", "", cohort) # Clean cohort name if necessary
- image_src_belonging <- paste0(base_path, "b_map_emu1_us_ug_ay1819_c", cohort, ".png")
- image_src_not_belonging <- paste0(base_path, "db_map_emu1_us_ug_ay1819_c", cohort, ".png")
- }
- } else if (floor == "Level 2") {
- if (cohort == "All Cohorts") {
- image_src_belonging <- paste0(base_path, "b_map_emu2_us_ug_ay1819.png")
- image_src_not_belonging <- paste0(base_path, "db_map_emu2_us_ug_ay1819.png")
- } else {
- cohort <- gsub("/", "", cohort) # Clean cohort name if necessary
- image_src_belonging <- paste0(base_path, "b_map_emu2_us_ug_ay1819_c", cohort, ".png")
- image_src_not_belonging <- paste0(base_path, "db_map_emu2_us_ug_ay1819_c", cohort, ".png")
- }
- }
- } else if (year == "1718") {
- if (floor == "Level 1") {
- image_src_belonging <- paste0(base_path, "b_map_emu1_us_ug_ay1718.png")
- image_src_not_belonging <- paste0(base_path, "db_map_emu1_us_ug_ay1718.png")
- } else if (floor == "Level 2") {
- image_src_belonging <- paste0(base_path, "b_map_emu2_us_ug_ay1718.png")
- image_src_not_belonging <- paste0(base_path, "db_map_emu2_us_ug_ay1718.png")
- }
- }
- } else if(input$typeSelect == "International") {
- if (input$intSelect == "Overall") {
- image_src_belonging <- ""
- image_src_not_belonging <- ""
- } else if (input$intSelect == "Undergrad and Grad 2022") {
- image_src_belonging <- paste0(base_path, "b_map_emu_b_i_ug_ay2122.png")
- image_src_not_belonging <- paste0(base_path, "db_map_emu_b_i_ug_ay2122.png")
- } else if (input$intSelect == "Undergrad 2020") {
- image_src_belonging <- paste0(base_path, "b_map_emu_b_i_ug_ay1920.png")
- image_src_not_belonging <- paste0(base_path, "db_map_emu_b_i_ug_ay1920.png")
- }
- } else if(input$typeSelect == "Graduate" && input$yearSelect == "2022") {
- image_src_belonging <- paste0(base_path, "b_map_emu_b_gr_ay2122.png")
- image_src_not_belonging <- paste0(base_path, "db_map_emu_b_gr_ay2122.png")
+ output$emuImage <- renderImage({
+ # Decide which table to render after the data has been effectively filtered based on the following filters
+ if(input$typeSelect == "Undergraduate" && (is.null(input$yearSelect) || input$yearSelect == "Overall")) {
+ return("Select year breakdown :)")
+ } else if(input$typeSelect == "Undergraduate" && length(input$yearSelect) && input$yearSelect == "2022") {
+ list(src = "maps/map_emu_b_us_ug_ay2122.png")
+ } else if(input$typeSelect == "Undergraduate" && length(input$yearSelect) && input$yearSelect == "2020") {
+ list(src = "maps/map_emu_b_us_ug_ay1920.png")
+ } else if(input$typeSelect == "Undergraduate" && length(input$yearSelect) && input$yearSelect == "2019") {
+ list(src = "maps/map_emu_b_us_ug_ay1819.png")
+ } else if(input$typeSelect == "Undergraduate" && length(input$yearSelect) && input$yearSelect == "2018") {
+ list(src = "maps/map_emu_b_us_ug_ay1718.png")
+ } else if(input$typeSelect == "International" && input$intSelect == "Overall") {
+ return("Select year breakdown :)")
+ } else if(input$typeSelect == "International" && input$intSelect == "Undergrad and Grad 2022") {
+ return(rt_cam_i_ay2122)
+ list(src = "maps/map_emu_b_i_ug_ay2122.png")
+ } else if(input$typeSelect == "International" && input$intSelect == "Undergrad 2020") {
+ return(rt_cam_i_ug_ay1920)
+ list(src = "maps/map_emu_b_i_ug_ay1920.png")
+ } else if(input$typeSelect == "Graduate") {
+ list(src = "maps/map_emu_b_gr_ay2122.png")
}
-
- tagList(
- img(src = image_src_belonging, height = "500px"),
- img(src = image_src_not_belonging, height = "500px")
- )
})
})
-
-
```
diff --git a/app/code/helper_code/where.Rmd b/app/code/helper_code/where.Rmd
index e4066d0..4a50fa8 100644
--- a/app/code/helper_code/where.Rmd
+++ b/app/code/helper_code/where.Rmd
@@ -13,49 +13,254 @@ knitr::opts_chunk$set(echo = TRUE)
- campus inclusiveness treemap
- emu inclusiveness treemap
+## Brian's Code
+```{r}
+```
-## UI draft
-
+## Standardize
```{r}
-# UI draft
-# Used code from the campus-belonging rmd
-
-dashboardBody(
- tabItem(tabName = "table",
- fluidRow(
- column(3, uiOutput("dynamicFilter")),
- column(6, reactableOutput("table") %>% withSpinner(color = "navy")),
- column(3, plotOutput("treemap")),
- column(3, plotOutput("treemap_emu")))
- )
- )
-
```
+
+## UI draft
+
## Server draft
-```{r server}
-# Server Draft
+## Possibly useful code
+
+
+just droppped in some code below. this is just the outline and works when you load everything in as .RData, but we want to avoid that. but you can use as draft - anwesha
+
+### Standardized piece (probably can be condensed even more)
+```{r initial setup, include = FALSE}
+
+knitr::opts_chunk$set(echo = TRUE)
+library(tidyverse)
+library(viridis)
library(reactable)
library(htmltools)
+library(magick)
library(treemapify)
-library(shiny)
-library(tidyverse)
-library(rvest)
-library(leaflet.extras)
+library(udpipe)
+library(tidytext)
+library(wordcloud2)
+library(igraph)
+library(ggraph)
+
+ay_1<- 2122 #CHANGE year (academic year format 1920 etc.)
+ay_2<- 2223 #CHANGE year (academic year format 1920 etc.)
+
+#function for big Ns that have , marks
+big_n<- function(x) {
+ prettyNum(x, big.mark = ",", scientific = F)
+}
+
+#stats that get 1 decimal like percentages
+stat_1<- function(x) {
+ formatC(x, format = "f", digits = 1)
+}
+
+#get place names
+places<- read_csv(
+ paste0(
+ "data/processed/pbb_eoy_1718_thru_",
+ ay_1,
+ "_places.csv"
+ )
+)
+
+waves<- c("Spring 2022, Spring 2020, Spring 2019, Spring 2018") #CHANGE add waves as more data come in
+
+
+#read data ####
-########################################
+#get long campus data
+campus_long<- read_csv(
+ paste0(
+ "data/processed/pbb_eoy_1718_thru_",
+ ay_1,
+ "_campus_bdb_long.csv"
+ )
+) %>%
+ left_join(
+ .,
+ places %>%
+ filter(level == "campus"),
+ by = c("ayear", "place")
+ ) %>%
+ within(cohort[is.na(cohort)]<- "no cohort") %>% #a trick to let me do the same function to data that are either cohort-specific or cohort-irrelevant
+ within(
+ full_place[
+ full_place == "Thompsons"
+ ]<- "Thompson's University Center"
+ )
+
+#get survey demos ####
+#need to get gi and so from eoy when available, otherwise bl
+#need to get others from bl data
-## Functions ##
+#get recs demos ####
+#need to add eoy22 who don't have bl to a set with bl
-########################################
+#combine above for doing analyses by demos ####
+#join ds and dr to campus_long - reference bl wb by demos
-# Function for interactive reactables
+#get emu long data
+emu_long<- read_csv(
+ paste0(
+ "data/processed/pbb_eoy_1718_thru_",
+ ay_1,
+ "_emu_bdb_long.csv"
+ )
+) %>%
+ left_join(
+ .,
+ places %>%
+ filter(level == "emu"),
+ by = c("ayear", "place")
+ ) %>%
+ within(cohort[is.na(cohort)]<- "no cohort") %>%
+ filter(
+ place_num %in% c("b1", "b2", "b3", "db1", "db2", "db3")
+ ) %>%
+ within(
+ full_place[
+ full_place == "Craft Center - Outdoor"
+ ]<- "Craft Center"
+ )
-reactable_fun<- function(dat) {
+#compute n resps > 3 (method was split across 2 maps in 1718 and 1819. students were instructed to select 3 but some selected more)
+too_many_resps_emu<- read_csv(
+ paste0(
+ "data/processed/pbb_eoy_1718_thru_",
+ ay_1,
+ "_emu_bdb_wide.csv"
+ ),
+ guess_max = 1900
+) %>%
+ filter(
+ !is.na(b4) |
+ !is.na(db4)
+ ) %>%
+ group_by(ayear) %>%
+ summarise(n = sum(!is.na(id)))
+
+#combine above for doing analyses by demos ####
+#join ds and dr to emu_long - reference bl wb by demos
+
+
+#function for getting place counts
+place_fun<- function(dat, s_vec, c_vec, gt, lt, p, by_p, n_dat) {
+ df<- full_join(
+ dat %>%
+ within(
+ full_place[
+ agg_place == "Other" |
+ agg_place == "Out of Bounds"
+ ]<- "Other/Out of Bounds"
+ ) %>%
+ within(
+ agg_place[
+ agg_place == "Other" |
+ agg_place == "Out of Bounds"
+ ]<- "Other/Out of Bounds"
+ ) %>%
+ filter(
+ sample %in% c(s_vec) &
+ cohort %in% c(c_vec) &
+ ayear > gt &
+ ayear < lt &
+ sent == "Belong"
+ ) %>%
+ count(!!sym(p)) %>%
+ arrange(desc(n)),
+ dat %>%
+ within(
+ full_place[
+ agg_place == "Other" |
+ agg_place == "Out of Bounds"
+ ]<- "Other/Out of Bounds"
+ ) %>%
+ within(
+ agg_place[
+ agg_place == "Other" |
+ agg_place == "Out of Bounds"
+ ]<- "Other/Out of Bounds"
+ ) %>%
+ filter(
+ sample %in% c(s_vec) &
+ cohort %in% c(c_vec) &
+ ayear > gt &
+ ayear < lt &
+ sent == "Don't Belong"
+ ) %>%
+ count(!!sym(p)) %>%
+ arrange(desc(n)),
+ by = by_p
+ ) %>%
+ filter(!!sym(p) != "No Place") %>%
+ rename(
+ n_b = n.x,
+ n_db = n.y
+ ) %>%
+ within(n_b[is.na(n_b)]<- 0) %>%
+ within(n_db[is.na(n_db)]<- 0) %>%
+ mutate(
+ perc_click_b = n_b/sum(n_b)*100,
+ perc_click_db = n_db/sum(n_db)*100,
+ perc_stud_b = n_b/sum(n_dat$n_b)*100,
+ perc_stud_db = n_db/sum(n_dat$n_db)*100,
+ incl = n_b/(n_b+n_db)*100
+ ) %>%
+ select(!!sym(p), incl, n_b, n_db, everything())
+ return(df)
+}
+
+#lt term in ns_fun, nw_fun, and place_fun for us undergrad overall and us undergrad by cohort sets
+lt_term<- 2223 #CHANGE increment term as ayears are added
+
+
+
+#make vectors for indexing ####
+vnm_long<- names(campus_long) #same as emu_long
+
+cohorts<- c(
+ "0102",
+ "0708",
+ "1011",
+ "1112",
+ "1415",
+ "1516",
+ "1617",
+ "1718",
+ "1819",
+ "1920",
+ "2021",
+ "2122",
+ "2223"
+ #CHANGE add cohorts as cohorts are added
+)
+
+classes<- c("Freshman", "Sophomore", "Junior", "Senior")
+
+noco<- "no cohort"
+
+vnm_pl<- c(
+ "full_place",
+ "incl",
+ "n_b",
+ "n_db",
+ "perc_click_b",
+ "perc_click_db",
+ "perc_stud_b",
+ "perc_stud_db"
+)
+
+#function for interactive datatables
+reactable_fun<- function() {
options(
reactable.theme = reactableTheme(
color = "hsl(233, 9%, 87%)",
@@ -69,7 +274,149 @@ reactable_fun<- function(dat) {
pageButtonActiveStyle = list(backgroundColor = "hsl(233, 9%, 28%)")
)
)
- rt<- dat %>%
+ rt<- bind_rows(
+ pl_cam %>%
+ left_join(
+ .,
+ places %>%
+ filter(level == "campus") %>%
+ select(full_place, agg_place),
+ by = "full_place"
+ ) %>%
+ distinct(full_place, .keep_all = T) %>%
+ mutate(
+ incl = incl / 100,
+ across(
+ perc_click_b:perc_stud_db, ~.x / 100
+ )
+ ) %>%
+ within(
+ full_place[
+ full_place == "Jordan Schnitzer Museum of Art"
+ ]<- "J. Schnitzer Museum of Art"
+ ) %>%
+ within(
+ full_place[
+ full_place == "Thompson's University Center"
+ ]<- "Thompson's Univ Center"
+ ) %>%
+ within(
+ full_place[
+ full_place == "Museum of Natural and Cultural History"
+ ]<- "Museum of Nat & Cult Hist"
+ ) %>%
+ within(
+ full_place[
+ full_place == "Campus Planning and Facilities Management"
+ ]<- "Campus Plan & Facil Mgmt"
+ ) %>%
+ within(
+ agg_place[
+ agg_place == "Jordan Schnitzer Museum of Art"
+ ]<- "J. Schnitzer Museum of Art"
+ ) %>%
+ within(
+ agg_place[
+ agg_place == "Museum of Natural and Cultural History"
+ ]<- "Museum of Nat & Cult Hist"
+ ) %>%
+ within(
+ agg_place[
+ agg_place == "Campus Planning and Facilities Management"
+ ]<- "Campus Plan & Facil Mgmt"
+ ) %>%
+ within(
+ agg_place[
+ agg_place == "Student Recreation Complex"
+ ]<- "Student Rec Complex"
+ ) %>%
+ within(
+ agg_place[
+ agg_place == "Thompson's University Center"
+ ]<- "Thompson's Univ Center"
+ ) %>%
+ within(
+ agg_place[
+ is.na(agg_place)
+ ]<- "Other/Out of Bounds"
+ ),
+ pl_emu %>%
+ left_join(
+ .,
+ places %>%
+ filter(level == "emu") %>%
+ select(full_place, agg_place),
+ by = "full_place"
+ ) %>%
+ distinct(full_place, .keep_all = T) %>%
+ mutate(
+ incl = incl / 100,
+ across(
+ perc_click_b:perc_stud_db, ~.x / 100
+ ),
+ agg_place = "EMU-Specific Places"
+ ) %>%
+ within(
+ full_place[
+ full_place == "ASUO Student Governance Center"
+ ]<- "ASUO Stdnt Gov Cntr"
+ ) %>%
+ within(
+ full_place[
+ full_place == "Bartolotti's Pizza Bistro"
+ ]<- "Bartolotti's Pizza"
+ ) %>%
+ within(
+ full_place[
+ full_place == "Center for Student Involvement Resource Center"
+ ]<- "CSI Resource Center"
+ ) %>%
+ within(
+ full_place[
+ full_place == "Collegiate Recover Center"
+ ]<- "Collegiate Recovery Cntr"
+ ) %>%
+ within(
+ full_place[
+ full_place == "Falling Sky Pizzeria and Public House"
+ ]<- "Falling Sky"
+ ) %>%
+ within(
+ full_place[
+ full_place == "Fraternity and Sorority Life"
+ ]<- "Fraternity & Sorority Life"
+ ) %>%
+ within(
+ full_place[
+ full_place == "International Student Association"
+ ]<- "Intl Stdnt Assoc"
+ ) %>%
+ within(
+ full_place[
+ full_place == "International Student Groups"
+ ]<- "Intl Stdnt Groups"
+ ) %>%
+ within(
+ full_place[
+ full_place == "Legal Services Student Advocacy"
+ ]<- "Legal Srvc Stdnt Advocacy"
+ ) %>%
+ within(
+ full_place[
+ full_place == "Nontraditional Student Union"
+ ]<- "Nontrad Stdnt Union"
+ ) %>%
+ within(
+ full_place[
+ full_place == "Scheduling and Event Services"
+ ]<- "Sched & Event Services"
+ ) %>%
+ within(
+ full_place[
+ full_place == "Student Sustainability Center"
+ ]<- "Stdnt Sustainability Cntr"
+ )
+ ) %>%
reactable(
.,
groupBy = "agg_place",
@@ -175,74 +522,44 @@ reactable_fun<- function(dat) {
return(rt)
}
+```
-##############################################
-
-# Function for tree map
-
-inclusive_tree_fun <- function(dat) {
- df <- dat
- cp <- as.vector(if_else(df$incl > 75, "#30313A", "#FCFFA4"))
- plot <- dat %>%
- ggplot(aes(area = tot, fill = incl, label = place)) +
- geom_treemap() +
- geom_treemap_text(place = "center", grow = TRUE, reflow = TRUE, color = cp) +
- scale_fill_viridis_c(name = "Inclusiveness", option = "inferno", limits = c(0, 100)) +
- theme(
- panel.background = element_rect(fill = "#30313A"),
- plot.background = element_rect(color = "#30313A", fill = "#30313A"),
- legend.background = element_rect(fill = "#30313A"),
- legend.title = element_text(color = "#FCFFA4"),
- legend.text = element_text(color = "#FCFFA4"),
- plot.margin = margin(0.5, 0.5, 0.5, 0.5, "cm")
- )
- return(plot)
-}
-
-########################################
-
-## Server Logic ##
-########################################
+### For UI piece:
+```{r eval=FALSE, include=FALSE}
+# this will be in the dashboardbody piece
+tabItem(tabName = "table",
+
+ # summary section
+ # includeMarkdown("www/summary.md"),
+ fluidRow(
+ column(3, uiOutput("dynamicFilter")),
+ column(3, reactableOutput("table")) %>% withSpinner(color = "navy")))
+```
+### For Server piece:
+```{r}
+#need some of these but not all I think
+library(shiny)
+library(tidyverse)
+library(rvest)
+library(leaflet.extras)
+library(reactable)
shinyServer(function(input, output) {
# Dynamic UI for additional filters
output$dynamicFilter <- renderUI({
- if(input$typeSelect == "Undergraduate") {
- # Default tag list for Undergraduate
- filters <- tagList(
+ if(input$typeSelect == "Undergraduate") {
selectInput("yearSelect", "Select Year:",
- choices = c("2018", "2019", "2020", "2022", "Overall")),
- selectInput("cohortSelect", "Select Cohort:",
- choices = c("15/16", "16/17", "17/18", "18/19", "19/20", "20/21", "21/22", "All Cohorts"))
- )
-
- # Add floor selection for specific years
- if (input$yearSelect %in% c("2018", "2019")) {
- filters <- tagList(
- filters,
- selectInput("floorSelect", "Select Floor:",
- choices = c("Full Building", "Level 1", "Level 2"))
- )
- }
-
- return(filters)
- } else if(input$typeSelect == "International") {
- # Filters for International
- return(tagList(
+ choices = c("2018", "2019", "2020", "2022", "Overall"))
+ } else if(input$typeSelect == "International") {
selectInput("intSelect", "Select Category:",
choices = c("Overall", "Undergrad and Grad 2022", "Undergrad 2020"))
- ))
- } else if(input$typeSelect == "Graduate") {
- # Filters for Graduate
- return(tagList(
- selectInput("yearSelect", "Select Year:",
- choices = c("2022", "Overall"))
- ))
- }
- })
+ } else {
+ return()
+ }
+ })
# Render the correct table based on the input selection
@@ -268,33 +585,6 @@ shinyServer(function(input, output) {
}
})
-
-
-# Render tree map based on input
- output$treemap <- renderPlot({
- if(input$typeSelect == "Undergraduate" && input$yearSelect == "Overall") {
- rt_cam_us_ug
- } else if (input$typeSelect == "Undergraduate" && input$yearSelect == "2022") {
- rt_cam_us_ug_ay2122
- } else if (input$typeSelect == "Undergraduate" && input$yearSelect == "2020") {
- rt_cam_us_ug_ay1920
- } else if (input$typeSelect == "Undergraduate" && input$yearSelect == "2019") {
- rt_cam_us_ug_ay1819
- } else if (input$typeSelect == "Undergraduate" && input$yearSelect == "2018") {
- rt_cam_us_ug_ay1718
- } else if (input$typeSelect == "International" && input$intSelect == "Overall") {
- rt_cam_i
- } else if (input$typeSelect == "International" && input$intSelect == "Undergrad and Grad 2022") {
- rt_cam_i_ay2122
- } else if (input$typeSelect == "International" && input$intSelect == "Undergrad 2020") {
- rt_cam_i_ug_ay1920
- } else if (input$typeSelect == "Graduate") {
- rt_cam_gr_ay2122
- }
- })
-
})
-
```
-
diff --git a/app/code/server.R b/app/code/server.R
index 0663a80..2c31269 100644
--- a/app/code/server.R
+++ b/app/code/server.R
@@ -10,92 +10,56 @@ library(rvest)
library(leaflet.extras)
library(reactable)
-path <- "/Users/aguha/Desktop/r_projects/oar/place-based-belonging/app"
+path <- "/Users/aguha/Desktop/r_projects/oar/pbb_app"
setwd(path)
-
-pbb_tables_for_rt <- readRDS("~/Desktop/r_projects/oar/place-based-belonging/app/data/separated/pbb_tables_for_rt.rds")
-
-df_names <- names(pbb_tables_for_rt)
-
-for (name in df_names) {
- assign(name, pbb_tables_for_rt[[name]])
-}
+load("pbb2.RData")
#####################
# SUPPORT FUNCTIONS #
#####################
-source("code/helpers.R")
-
################
# SERVER LOGIC #
################
-shinyServer(function(input, output, session) {
-
- # filters
- output$typeSelect <- renderUI({
- selectInput("selectedType", "Select:", c("Undergraduate", "International", "Graduate"))
- })
-
- output$yearSelect <- renderUI({
- selectInput("selectedYear", "Select Year:", sort(as.character(unique(dynamic_filter[dynamic_filter$col1==input$selectedType, c("col2")]))))
- })
-
- output$cohortSelect <- renderUI({
- selectInput("selectedCohort", "Select Cohort (if applicable):", sort(as.character(unique(dynamic_filter[dynamic_filter$col1==input$selectedType & dynamic_filter$col2==input$selectedYear, c("col3")]))))
- })
-
-
- output$table <- renderReactable({
-
- #Undergrad
- if(input$selectedType == "Undergraduate") {
- year <- input$selectedYear
-
- if(input$selectedYear == "Overall") {
- reactable_fun(us_ug)
- } else if (input$selectedYear == "2022") {
- if(input$selectedCohort == "All Years") {reactable_fun(us_us_ay2122)
- } elseif(input$selectedCohort == "4th Year") { reactable_fun(us_ug_ay2122_c2122)
- } elseif(input$selectedCohort == "3th Year") { reactable_fun(us_ug_ay2122_c2021)
- } elseif(input$selectedCohort == "2nd Year") { reactable_fun(us_ug_ay2122_c1920)
- } elseif(input$selectedCohort == "1st Year") { reactable_fun(us_ug_ay2122_c1819)}
- } else if (input$selectedYear == "2020") {
- if(input$selectedCohort == "All Years") {reactable_fun(us_us_ay1920)
- } elseif(input$selectedCohort == "4th Year") { reactable_fun(us_ug_ay1920_c1920)
- } elseif(input$selectedCohort == "3th Year") { reactable_fun(us_ug_ay1920_c1819)
- } elseif(input$selectedCohort == "2nd Year") { reactable_fun(us_ug_ay1920_c1718)
- } elseif(input$selectedCohort == "1st Year") { reactable_fun(us_ug_ay1920_c1617)}
- } else if (input$selectedYear == "2019") {
- if(input$selectedCohort == "All Years") {reactable_fun(us_us_ay1819)
- } elseif(input$selectedCohort == "4th Year") { reactable_fun(us_ug_ay1819_c1819)
- } elseif(input$selectedCohort == "3th Year") { reactable_fun(us_ug_ay1819_c1718)
- } elseif(input$selectedCohort == "2nd Year") { reactable_fun(us_ug_ay1819_c1617)
- } elseif(input$selectedCohort == "1st Year") { reactable_fun(us_ug_ay1819_c1516)}
- }
- }
- # International
- else if(input$selectedType == "International") {
- if (input$selectedYear == "Overall") {
- reactable_fun(i)
- } else if (input$selectedYear == "Undergrad and Grad 2022") {
- reactable_fun(i_ay2122)
- } else if (input$selectedYear == "Undergrad 2020") {
- reactable_fun(i_ug_ay1920)
- }
- }
- # Graduate
- else if(input$selectedType == "Graduate" && input$selectedYear == "2022") {
- reactable_fun(gr_ay2122)
- }
- else if(input$selectedType == "Graduate" && input$selectedYear == "Overall") {
- box("Idk")
- }
- else {
- HTML("No data available for the selected options.
")
- }
- })
-
+shinyServer(function(input, output) {
+
+ # Dynamic UI for additional filters
+ output$dynamicFilter <- renderUI({
+ if(input$typeSelect == "Undergraduate") {
+ selectInput("yearSelect", "Select Year:",
+ choices = c("2018", "2019", "2020", "2022", "Overall"))
+ } else if(input$typeSelect == "International") {
+ selectInput("intSelect", "Select Category:",
+ choices = c("Overall", "Undergrad and Grad 2022", "Undergrad 2020"))
+ } else {
+ return()
+ }
+ })
+
+
+ # Render the correct table based on the input selection
+ output$table <- renderReactable({
+ if(input$typeSelect == "Undergraduate" && input$yearSelect == "Overall") {
+ rt_cam_us_ug
+ } else if(input$typeSelect == "Undergraduate" && input$yearSelect == "2022") {
+ rt_cam_us_ug_ay2122
+ } else if(input$typeSelect == "Undergraduate" && input$yearSelect == "2020") {
+ rt_cam_us_ug_ay1920
+ } else if(input$typeSelect == "Undergraduate" && input$yearSelect == "2019") {
+ rt_cam_us_ug_ay1819
+ } else if(input$typeSelect == "Undergraduate" && input$yearSelect == "2018") {
+ rt_cam_us_ug_ay1718
+ } else if(input$typeSelect == "International" && input$intSelect == "Overall") {
+ rt_cam_i
+ } else if(input$typeSelect == "International" && input$intSelect == "Undergrad and Grad 2022") {
+ rt_cam_i_ay2122
+ } else if(input$typeSelect == "International" && input$intSelect == "Undergrad 2020") {
+ rt_cam_i_ug_ay1920
+ } else if(input$typeSelect == "Graduate") {
+ rt_cam_gr_ay2122
+ }
+ })
+
})
diff --git a/app/code/ui.R b/app/code/ui.R
index bc91f1a..a9e67c0 100644
--- a/app/code/ui.R
+++ b/app/code/ui.R
@@ -11,186 +11,174 @@ library(shinycssloaders)
library(DT)
library(tigris)
library(reactable)
-library(markdown)
-path <- "/Users/aguha/Desktop/r_projects/oar/place-based-belonging/app"
+path <- "/Users/aguha/Desktop/r_projects/oar/pbb_app"
setwd(path)
-col1 <- c(rep("Undergraduate", 17), rep("International", 2), rep("Graduate", 2))
-col2 <- c(rep("2022",5), rep("2020",5), rep("2019",5), "2018", "Overall",
- "Undergrad and Grad 2022", "Undergrad 2020",
- "2022", "Overall")
-col3 <- c(rep(c("All Years", "4th Year", "3rd Year", "2nd Year", "1st Year"),3), #2022-2019
- "All Years", #2018
- NA, #Overall UG
- rep(NA, 4)
- )
-
-dynamic_filter <- data.frame(col1, col2, col3)
-
###########
# LOAD UI #
###########
shinyUI(fluidPage(
-
- # load custom stylesheet
- includeCSS("www/style.css"),
-
- # load google analytics script -- this is so you can track who is viewing the dashboard. cool! but will hold off
- # tags$head(includeScript("www/google-analytics-bioNPS.js")),
-
- # remove shiny "red" warning messages on GUI
- tags$style(type="text/css",
- ".shiny-output-error { visibility: hidden; }",
- ".shiny-output-error:before { visibility: hidden; }"
- ),
-
- # load page layout
- dashboardPage(
-
- skin = "blue",
-
- dashboardHeader(title="University of Oregon Place Based Belonging", titleWidth = 200),
-
- dashboardSidebar(width = 300,
- sidebarMenu(
- HTML(paste0(
- "
",
- "
",
- "
"
- )),
- menuItem("Who is SWaSI?", tabName = "about", icon = icon("users")),
- menuItem("Summary", tabName = "summary", icon = icon("thumbtack")),
- menuItem("Where? Campus Belonging", tabName = "campus", icon = icon("table")),
- menuItem("Where? EMU Belonging", tabName = "emu", icon = icon("random", lib = "glyphicon")),
- menuItem("Where? Inclusiveness", tabName = "inclusiveness", icon = icon("stats", lib = "glyphicon")),
- menuItem("Why There? Wordnets & Wordclouds", tabName = "words", icon = icon("dashboard")),
- menuItem("Why There? Emotions", tabName = "emotions", icon = icon("dashboard")),
- menuItem("Where for Whom?", tabName = "whom", icon = icon("question")),
- menuItem("Between Here and Where?", tabName = "between", icon = icon("question")),
- menuItem("Supplemental Method", tabName = "method", icon = icon("question")),
- HTML(paste0("
",
- "
",
- "",
- "© - https://github.com/UOSLAR -
")
- ))
-
- ), # end dashboardSidebar
-
- dashboardBody( #startdashboardBody
-
- tabItems( #start all tabItems
-
- tabItem(tabName = "about",
-
- # about section
- # uiOutput("aboutContent")
- includeMarkdown("www/pbb-about.md")
- # I am losing my mind with this section
-
- ),
-
- tabItem(tabName = "summary",
-
- # summary section
- includeMarkdown("www/summary.md")
-
- ),
-
- tabItem(tabName = "campus",
-
- fluidRow(
- column(width = 6,
- box(width = NULL, uiOutput("dynamicFilter")),
- box(width = NULL, background = "black",
- "Some text here.")),
- column(width = 6,
- box(width = NULL, title = "Belong", solidHeader = TRUE),
- box(width = NULL, title = "Don't Belong", solidHeader = TRUE)))
-
- ),
-
- tabItem(tabName = "emu",
-
- fluidRow(
- column(4, uiOutput("typeSelect")),
- column(4, uiOutput("yearSelect")),
- column(4, uiOutput("cohortSelect"))),
- fluidRow(
- reactableOutput("table") %>% withSpinner(color = "green"))
-
- # fluidRow(
- # column(width = 6,
- # box(width = NULL, uiOutput("dynamicFilter")),
- # box(width = NULL, background = "black",
- # "Some text here.")),
- # column(width = 6,
- # box(width = NULL, title = "Belong", solidHeader = TRUE),
- # box(width = NULL, title = "Don't Belong", solidHeader = TRUE)))
- ),
-
- tabItem(tabName = "inclusiveness",
-
- fluidRow(
- column(width = 6,
- box(width = NULL, title = "Campus Inclusiveness", solidHeader = TRUE),
- box(width = NULL, title = "EMU Inclusiveness", solidHeader = TRUE))),
- column(width = 6,
- box(width = NULL, uiOutput("dynamicFilter")),
- box(width = NULL, background = "black",
- "Some text here."))
-
- ),
-
- tabItem(tabName = "words",
-
- fluidRow(uiOutput("dynamicFilter")),
- fluidRow(
- column(width = 6,
- box(width = NULL, title = "Campus Inclusiveness", solidHeader = FALSE),
- box(width = NULL, title = "EMU Inclusiveness", solidHeader = FALSE))),
- column(width = 6,
- box(width = NULL, title = "Campus Inclusiveness", solidHeader = FALSE),
- box(width = NULL, title = "EMU Inclusiveness", solidHeader = FALSE))
-
- ),
-
- tabItem(tabName = "emotions",
-
- fluidRow(
- column(width = 6,
- box(width = NULL, title = "Plutchik's Wheel of Emotions", solidHeader = TRUE),
- box(width = NULL, background = "black", "text about emo."))),
- column(width = 6,
- box(width = NULL, uiOutput("dynamicFilter")),
- box(width = NULL, background = "black",
- "Bar graphs here."))
-
- ),
-
- tabItem(tabName = "whom",
-
- includeMarkdown("www/whom.md")
-
- ),
- tabItem(tabName = "between",
-
- includeMarkdown("www/between.md")
- ),
-
- tabItem(tabName = "method",
-
- includeMarkdown("www/method.md")
- )
-
- ) #end tabItems
-
- ) # end dashboardBody
-
- )# end dashboardPage
-
-))
+
+ # load custom stylesheet
+ includeCSS("www/style.css"),
+
+ # load google analytics script -- this is so you can track who is viewing the dashboard. cool! but will hold off
+ # tags$head(includeScript("www/google-analytics-bioNPS.js")),
+
+ # remove shiny "red" warning messages on GUI
+ tags$style(type="text/css",
+ ".shiny-output-error { visibility: hidden; }",
+ ".shiny-output-error:before { visibility: hidden; }"
+ ),
+
+ # load page layout
+ dashboardPage(
+
+ skin = "blue",
+
+ dashboardHeader(title="University of Oregon Place Based Belonging", titleWidth = 300),
+
+ dashboardSidebar(width = 300,
+ sidebarMenu(
+ HTML(paste0(
+ "
",
+ "",
+ "
"
+ )),
+ menuItem("Who is SWaSI?", tabName = "about", icon = icon("users")),
+ menuItem("Summary", tabName = "summary", icon = icon("thumbtack")),
+ menuItem("Where?", tabName = "table", icon = icon("table")),
+ menuItem("Campus Belonging", tabName = "campus", icon = icon("random", lib = "glyphicon")),
+ menuItem("Erb Memorial Union Belonging", tabName = "emu", icon = icon("stats", lib = "glyphicon")),
+ menuItem("Why There? Wordnets & Wordclouds", tabName = "why", icon = icon("dashboard")),
+ menuItem("Why There? Emotions", tabName = "emotions", icon = icon("dashboard")),
+ menuItem("Where for Whom?", tabName = "whom", icon = icon("question")),
+ menuItem("Between Here and Where?", tabName = "between", icon = icon("question")),
+ menuItem("Supplemental Method", tabName = "method", icon = icon("question")),
+ HTML(paste0("
",
+ "
",
+ "",
+ "© - https://github.com/UOSLAR -
")
+ ))
+
+ ), # end dashboardSidebar
+
+ dashboardBody(
+
+ tabItems(
+
+ tabItem(tabName = "about",
+
+ # about section
+ includeMarkdown("www/pbb-about.md")
+
+ ),
+
+ tabItem(tabName = "summary",
+
+ # summary section
+ includeMarkdown("www/summary.md")
+
+ ),
+
+ tabItem(tabName = "table",
+
+ # summary section
+ # includeMarkdown("www/summary.md"),
+ fluidRow(
+ column(3, uiOutput("dynamicFilter")),
+ column(3, reactableOutput("table")) %>% withSpinner(color = "navy"))
+ # reactable table should just go in here directly
+ # dataTableOutput("speciesDataTable") %>% withSpinner(color = "lightseagreen")
+
+ ),
+
+ tabItem(tabName = "campus",
+
+ # summary section
+ includeMarkdown("www/summary.md")
+
+ # campus needs ...
+ # includeMarkdown("www/tree.md"),
+ # column(3, uiOutput("parkSelectComboTree")),
+ # column(3, uiOutput("categorySelectComboTree")),
+ # collapsibleTreeOutput('tree', height='700px') %>% withSpinner(color = "lightseagreen")
+
+ ),
+
+ tabItem(tabName = "emu",
+
+ # summary section
+ includeMarkdown("www/summary.md")
+
+ # ggplot2 species charts section
+ # includeMarkdown("www/charts.md"),
+ # fluidRow(column(3, uiOutput("categorySelectComboChart"))),
+ # column(6, plotOutput("ggplot2Group1") %>% withSpinner(color = "lightseagreen")),
+ # column(6, plotOutput("ggplot2Group2") %>% withSpinner(color = "lightseagreen"))
+
+ ),
+
+ tabItem(tabName = "why",
+
+ # summary section
+ includeMarkdown("www/summary.md")
+
+ # # choropleth species map section
+ # includeMarkdown("www/choropleth.md"),
+ # fluidRow(
+ # column(3, uiOutput("statesSelectCombo")),
+ # column(3, uiOutput("categorySelectComboChoro"))
+ # ),
+ # fluidRow(
+ # column(3,tableOutput('stateCategoryList') %>% withSpinner(color = "lightseagreen")),
+ # column(9,leafletOutput("choroplethCategoriesPerState") %>% withSpinner(color = "lightseagreen"))
+ # )
+
+ ),
+
+ tabItem(tabName = "emotions",
+
+ # summary section
+ includeMarkdown("www/summary.md")
+
+ # # choropleth species map section
+ # includeMarkdown("www/choropleth.md"),
+ # fluidRow(
+ # column(3, uiOutput("statesSelectCombo")),
+ # column(3, uiOutput("categorySelectComboChoro"))
+ # ),
+ # fluidRow(
+ # column(3,tableOutput('stateCategoryList') %>% withSpinner(color = "lightseagreen")),
+ # column(9,leafletOutput("choroplethCategoriesPerState") %>% withSpinner(color = "lightseagreen"))
+ # )
+
+ ),
+
+ tabItem(tabName = "whom",
+
+ includeMarkdown("www/whom.md")
+
+ ),
+ tabItem(tabName = "between",
+
+ includeMarkdown("www/between.md")
+ ),
+
+ tabItem(tabName = "method",
+
+ includeMarkdown("www/method.md")
+ )
+
+ ) #end tabItems
+
+ ) # end dashboardBody
+
+ )# end dashboardPage
+
+))
\ No newline at end of file
diff --git a/app/www/maps/.DS_Store b/app/www/maps/.DS_Store
new file mode 100644
index 0000000..5008ddf
Binary files /dev/null and b/app/www/maps/.DS_Store differ
diff --git a/app/www/maps/.DS_Store~HEAD b/app/www/maps/.DS_Store~HEAD
new file mode 100644
index 0000000..5008ddf
Binary files /dev/null and b/app/www/maps/.DS_Store~HEAD differ
diff --git a/app/www/maps/.gitignore b/app/www/maps/.gitignore
new file mode 100644
index 0000000..e43b0f9
--- /dev/null
+++ b/app/www/maps/.gitignore
@@ -0,0 +1 @@
+.DS_Store
diff --git a/app/www/pbb-about.md b/app/www/pbb-about.md
index e259d7d..4adde09 100644
--- a/app/www/pbb-about.md
+++ b/app/www/pbb-about.md
@@ -1,14 +1,14 @@
# Who is SWaSI?
-The [Student Wellbeing and Success Initiative](https://uoregon-my.sharepoint.com/:u:/g/personal/clark13_uoregon_edu/EY4zzGdo3o9ImgpS89tM2wAB4CrNAqmPyAxDAZQ-mNuzJw){target="_blank" style="color: #DF63A4"} is:
+The [[Student Wellbeing and Success Initiative](https://uoregon-my.sharepoint.com/:u:/g/personal/clark13_uoregon_edu/EY4zzGdo3o9ImgpS89tM2wAB4CrNAqmPyAxDAZQ-mNuzJw){target="_blank"}]{style="color: #DF63A4"} is:
-- an ongoing, multicohort, longitudinal research program designed to holistically understand institutional inputs to undergraduate students’ wellbeing and success across the college experience
-- an educational program designed to equitably improve wellbeing and success outcomes, particularly among historically marginalized populations (e.g., first-generation students, Black students)
-- an assessment and evaluation program designed to gauge whether various programmatic activities, including but not limited to the ones internal to the Initiative itself, are meeting their stated goals
+- an ongoing, multicohort, longitudinal research program designed to holistically understand institutional inputs to undergraduate students’ wellbeing and success across the college experience
+- an educational program designed to equitably improve wellbeing and success outcomes, particularly among historically marginalized populations (e.g., first-generation students, Black students)
+- an assessment and evaluation program designed to gauge whether various programmatic activities, including but not limited to the ones internal to the Initiative itself, are meeting their stated goals
-Better understanding better informs us, affording opportunities to improve institutional practices that equitably support students’ learning and development and foster their achievement and persistence. Unlike many for-profit companies, which use data to sell people, this is a strategy that uses data to [empower](#){style="color: #11E8FF"} people.
+Better understanding better informs us, affording opportunities to improve institutional practices that equitably support students’ learning and development and foster their achievement and persistence. Unlike many for-profit companies, which use data to sell people, this is a strategy that uses data to [empower]{style="color: #11E8FF"} people.
-The Student Wellbeing and Success Initiative is led by Brian Clark, Assistant Director of the [Office of Assessment and Research](https://studentlife.uoregon.edu/research){target="_blank" style="color: #DF63A4"} in the [Division of Student Life](https://studentlife.uoregon.edu/){target="_blank" style="color: #DF63A4"}. It is supported primarily by the Office of the Vice President for Student Life with integral support from units of the Division of Student Life -- the [Department of Physical Education and Recreation](https://rec.uoregon.edu/){target="_blank" style="color: #DF63A4"}, the [Erb Memorial Union](https://emu.uoregon.edu/){target="_blank" style="color: #DF63A4"}, and the [Office of the Dean of Students](https://dos.uoregon.edu/){target="_blank" style="color: #DF63A4"} -- and across campus from many and varied units in [Global Engagement](https://international.uoregon.edu/){target="_blank" style="color: #DF63A4"}, the [Office of the Provost](https://provost.uoregon.edu/){style="color: #DF63A4"}, [Student Services and Enrollment Management](https://ssem.uoregon.edu/){target="_blank" style="color: #DF63A4"}, [UO Libraries](https://library.uoregon.edu/){target="_blank" style="color: #DF63A4"}, and [Undergraduate Education and Student Success](https://uess.uoregon.edu/){target="_blank" style="color: #DF63A4"}.
+The Student Wellbeing and Success Initiative is led by Brian Clark, Assistant Director of the [[Office of Assessment and Research](https://studentlife.uoregon.edu/research){target="_blank"}]{style="color: #DF63A4"} in the [[Division of Student Life](https://studentlife.uoregon.edu/){target="_blank"}]{style="color: #DF63A4"}. It is supported primarily by the Office of the Vice President for Student Life with integral support from units of the Division of Student Life -- the [[Department of Physical Education and Recreation](https://rec.uoregon.edu/){target="_blank"}]{style="color: #DF63A4"}, the [[Erb Memorial Union](https://emu.uoregon.edu/){target="_blank"}]{style="color: #DF63A4"}, and the [[Office of the Dean of Students](https://dos.uoregon.edu/){target="_blank"}]{style="color: #DF63A4"} -- and across campus from many and varied units in [[Global Engagement](https://international.uoregon.edu/){target="_blank"}]{style="color: #DF63A4"}, the [[Office of the Provost](https://provost.uoregon.edu/)]{style="color: #DF63A4"}, [[Student Services and Enrollment Management](https://ssem.uoregon.edu/){target="_blank"}]{style="color: #DF63A4"}, [[UO Libraries](https://library.uoregon.edu/){target="_blank"}]{style="color: #DF63A4"}, and [[Undergraduate Education and Student Success](https://uess.uoregon.edu/){target="_blank"}]{style="color: #DF63A4"}.
@@ -16,28 +16,28 @@ The Student Wellbeing and Success Initiative is led by Brian Clark, Assistant Di
The purposes of this document are:
-1. to conduct a comprehensive analysis of place-based belonging data
-2. to provide a general reference and resource tool for higher education professionals who do things and make decisions about things that affect students (many of those things are tied to or rooted in physical places)
-3. to describe the development of methods used to generate place-based belonging data
+1. to conduct a comprehensive analysis of place-based belonging data
+2. to provide a general reference and resource tool for higher education professionals who do things and make decisions about things that affect students (many of those things are tied to or rooted in physical places)
+3. to describe the development of methods used to generate place-based belonging data
-[This document is currently under construction and is in a "good enough for now" state](#){style="color: #11E8FF"}. It will be incrementally updated through Summer 2023, which will include adding Spring 2023 data. At that point, it will be considered complete, because we intend to augment methods dramatically the following year. Forthcoming sections include an overall summary, two content sections, and the supplemental method section. Forthcoming features include alternative text for plots and images and hover text for treemaps.
+[This document is currently under construction and is in a "good enough for now" state]{style="color: #11E8FF"}. It will be incrementally updated through Summer 2023, which will include adding Spring 2023 data. At that point, it will be considered complete, because we intend to augment methods dramatically the following year. Forthcoming sections include an overall summary, two content sections, and the supplemental method section. Forthcoming features include alternative text for plots and images and hover text for treemaps.
## What is Place-Based Belonging?
-Over the last several years, we have been incrementally exploring the concept of place-based belonging: the idea that people’s affinity for physical places, or lack thereof, is intertwined with their sense of whether they fit in socially. Theoretically, it is a special case of the environmental psychology concept of place attachment ([Altman & Low, 1992](https://link.springer.com/chapter/10.1007/978-1-4684-8753-4_1){target="_blank" style="color: #DF63A4"}), with conceptual focus on the place dimension over the person or process dimensions ([Scannell & Gifford, 2010](https://uoregon-my.sharepoint.com/:b:/g/personal/clark13_uoregon_edu/EUOwgiMvl5pKonwqByWz8BoBkjCnPQk0VAw9mm1fzn3XfQ?e=WW9q1Z){target="_blank" style="color: #DF63A4"}) and content focus on social meanings with which places are imbued as a subset of the general affective associations people have with places. Methodologically, it departs significantly from the psychometric approach of much place attachment research (e.g., [Williams, 2014](https://uoregon-my.sharepoint.com/:b:/g/personal/clark13_uoregon_edu/EVGZxfZPNRlEoofpQI9UQz4BreUZgn5Z-W0Z7gVMNK7fdQ?e=xTznoC){target="_blank" style="color: #DF63A4"}; [Williams & Vaske, 2003](https://uoregon-my.sharepoint.com/:b:/g/personal/clark13_uoregon_edu/EVXdi_qf-_hPpRc_iruUoNwBJ1ma0fuw3ZHknWZWW2YAXQ?e=pVPMkt){target="_blank" style="color: #DF63A4"}), aligning more closely with cultural mapping. Cultural mapping is an interdisciplinary field broadly tied together by a mode of inquiry and general methodology that reckons with documenting a community's place-based features and assets for a wide range of purposes. See [Duxbury et al. (2015)](https://uoregon-my.sharepoint.com/:b:/g/personal/clark13_uoregon_edu/EQSU3UqGrw1GpScojaHKFVUBLiH2uuzMOtTlFmkpMoEr6w?e=jE9T38){target="_blank" style="color: #DF63A4"} for an introduction and the [whole book](https://www.routledge.com/Cultural-Mapping-as-Cultural-Inquiry/Duxbury-Garrett-Petts-MacLennan/p/book/9780367599003){target="_blank" style="color: #DF63A4"} for varied perspectives. Place-based belonging, specifically, has roots in humanistic and cultural geography traditions, which feed into cultural mapping, and is depicted by a kind of symbol mapping ([Soini, 2001](https://uoregon-my.sharepoint.com/:b:/g/personal/clark13_uoregon_edu/EVIw9hlo0LdGkCrxUpVFoYwBg__H3LRwrnGmUAavpQ1pRg?e=JyQV4u){style="color: #DF63A4"}).
+Over the last several years, we have been incrementally exploring the concept of place-based belonging: the idea that people’s affinity for physical places, or lack thereof, is intertwined with their sense of whether they fit in socially. Theoretically, it is a special case of the environmental psychology concept of place attachment ([[Altman & Low, 1992](https://link.springer.com/chapter/10.1007/978-1-4684-8753-4_1){target="_blank"}]{style="color: #DF63A4"}), with conceptual focus on the place dimension over the person or process dimensions ([[Scannell & Gifford, 2010](https://uoregon-my.sharepoint.com/:b:/g/personal/clark13_uoregon_edu/EUOwgiMvl5pKonwqByWz8BoBkjCnPQk0VAw9mm1fzn3XfQ?e=WW9q1Z){target="_blank"}]{style="color: #DF63A4"}) and content focus on social meanings with which places are imbued as a subset of the general affective associations people have with places. Methodologically, it departs significantly from the psychometric approach of much place attachment research (e.g., [[Williams, 2014](https://uoregon-my.sharepoint.com/:b:/g/personal/clark13_uoregon_edu/EVGZxfZPNRlEoofpQI9UQz4BreUZgn5Z-W0Z7gVMNK7fdQ?e=xTznoC){target="_blank"}]{style="color: #DF63A4"}; [[Williams & Vaske, 2003](https://uoregon-my.sharepoint.com/:b:/g/personal/clark13_uoregon_edu/EVXdi_qf-_hPpRc_iruUoNwBJ1ma0fuw3ZHknWZWW2YAXQ?e=pVPMkt){target="_blank"}]{style="color: #DF63A4"}), aligning more closely with cultural mapping. Cultural mapping is an interdisciplinary field broadly tied together by a mode of inquiry and general methodology that reckons with documenting a community's place-based features and assets for a wide range of purposes. See [[Duxbury et al. (2015)](https://uoregon-my.sharepoint.com/:b:/g/personal/clark13_uoregon_edu/EQSU3UqGrw1GpScojaHKFVUBLiH2uuzMOtTlFmkpMoEr6w?e=jE9T38){target="_blank"}]{style="color: #DF63A4"} for an introduction and the [[whole book](https://www.routledge.com/Cultural-Mapping-as-Cultural-Inquiry/Duxbury-Garrett-Petts-MacLennan/p/book/9780367599003){target="_blank"}]{style="color: #DF63A4"} for varied perspectives. Place-based belonging, specifically, has roots in humanistic and cultural geography traditions, which feed into cultural mapping, and is depicted by a kind of symbol mapping ([[Soini, 2001](https://uoregon-my.sharepoint.com/:b:/g/personal/clark13_uoregon_edu/EVIw9hlo0LdGkCrxUpVFoYwBg__H3LRwrnGmUAavpQ1pRg?e=JyQV4u)]{style="color: #DF63A4"}).
-Adapting methods from [Pitcher & Royal (2016)](https://uoregon-my.sharepoint.com/:b:/g/personal/clark13_uoregon_edu/ETDssdQ-bW1LsSA_db4aaVgBd_vO02wIffeQ_AqgQ3TgwQ?e=yBVY5o){target="_blank" style="color: #DF63A4"}, we ask students to click up to three places on a campus map they feel like they “belong, fit in, are connected, are accepted, etc.,” and separately, to click up to three places they feel like they "[do not](#){style="color: #11E8FF"} belong, [do not](#){style="color: #11E8FF"} fit in, are [dis](#){style="color: #11E8FF"}connected, are [not](#){style="color: #11E8FF"} accepted, etc.” After clicking "belong" and "don't belong" places on a campus map, we follow up about select places to try and understand more about them. Generally, we ask students to describe in text why they feel the ways they do about the places. A unique aspect of follow-up involves delving into the Erb Memorial Union (EMU), which is a compact set of places, which cannot be disaggregated given a campus map and which form a unified place we call the EMU. If a student clicks on the EMU at the campus level, we follow up with a map of the EMU and ask them to click on places within the EMU they feel like they belong and don't belong, and then ask them to describe why. (Map and follow-up methods have varied over the years of development. See [Supplemental Method](#supmeth){style="color: #DF63A4"} for more details.)
+Adapting methods from [Pitcher & Royal (2016)](https://uoregon-my.sharepoint.com/:b:/g/personal/clark13_uoregon_edu/ETDssdQ-bW1LsSA_db4aaVgBd_vO02wIffeQ_AqgQ3TgwQ?e=yBVY5o){target="_blank"}, we ask students to click up to three places on a campus map they feel like they “belong, fit in, are connected, are accepted, etc.,” and separately, to click up to three places they feel like they "[do not]{style="color: #11E8FF"} belong, [do not]{style="color: #11E8FF"} fit in, are [dis]{style="color: #11E8FF"}connected, are [not]{style="color: #11E8FF"} accepted, etc.” After clicking "belong" and "don't belong" places on a campus map, we follow up about select places to try and understand more about them. Generally, we ask students to describe in text why they feel the ways they do about the places. A unique aspect of follow-up involves delving into the Erb Memorial Union (EMU), which is a compact set of places, which cannot be disaggregated given a campus map and which form a unified place we call the EMU. If a student clicks on the EMU at the campus level, we follow up with a map of the EMU and ask them to click on places within the EMU they feel like they belong and don't belong, and then ask them to describe why. (Map and follow-up methods have varied over the years of development. See [[Supplemental Method](#supmeth)]{style="color: #DF63A4"} for more details.)
The methods above generate data that allow us to do several things:
-- describe a place and rank-order multiple places in terms of belong and don't belong sentiments
-- describe a place and rank-order multiple places in terms of inclusiveness, which is a combination of both belong and don't belong sentiments
-- disaggregate a place's inclusiveness by demographics
-- explore why places have belong or don't belong sentiments associated with them
-- describe how places relate to each other through belong and don't belong sentiments
+- describe a place and rank-order multiple places in terms of belong and don't belong sentiments
+- describe a place and rank-order multiple places in terms of inclusiveness, which is a combination of both belong and don't belong sentiments
+- disaggregate a place's inclusiveness by demographics
+- explore why places have belong or don't belong sentiments associated with them
+- describe how places relate to each other through belong and don't belong sentiments
Application Notes:
-- The application is created using the [**periscope**](https://github.com/neuhausi/periscope) package. Periscope was originally developed as the core Shiny component for bioinformatics and systems biology analysis applications. It provides a predefined but flexible template for new Shiny applications with a default dashboard layout, three locations for user alerts, a nice busy indicator and logging features. One of the most important features of the shiny applications created with this framework is the separation by file of functionality that exists in one of the three shiny scopes: global, server-global, and server-local. The framework forces application developers to consciously consider scoping in Shiny applications by making scoping distinctions very clear without interfering with normal application development. Scoping consideration is important for performance and scaling, which is critical when working with large datasets and/or across many users. In addition to providing a template application, the framework also contains a number of convenient modules: a (multi)file download button module and a downloadable table module for example.
+- The application is created using the [**periscope**](https://github.com/neuhausi/periscope) package. Periscope was originally developed as the core Shiny component for bioinformatics and systems biology analysis applications. It provides a predefined but flexible template for new Shiny applications with a default dashboard layout, three locations for user alerts, a nice busy indicator and logging features. One of the most important features of the shiny applications created with this framework is the separation by file of functionality that exists in one of the three shiny scopes: global, server-global, and server-local. The framework forces application developers to consciously consider scoping in Shiny applications by making scoping distinctions very clear without interfering with normal application development. Scoping consideration is important for performance and scaling, which is critical when working with large datasets and/or across many users. In addition to providing a template application, the framework also contains a number of convenient modules: a (multi)file download button module and a downloadable table module for example.
-*This application is developed and maintained by Anwesha Guha. This is a work in progress. v2*
+*This application is developed and maintained by Anwesha Guha. This is a work in progress.*