From fdaf47a8c84f68d38420a8f12b97bb7df14f864b Mon Sep 17 00:00:00 2001 From: fawda123 Date: Sun, 29 Oct 2023 12:10:17 -0400 Subject: [PATCH] removing more old code --- R/funcs.R | 175 +-- landuseold.Rmd | 134 -- landuseold.html | 3130 ----------------------------------------------- 3 files changed, 2 insertions(+), 3437 deletions(-) delete mode 100644 landuseold.Rmd delete mode 100644 landuseold.html diff --git a/R/funcs.R b/R/funcs.R index 7d47dbb..3679dc8 100644 --- a/R/funcs.R +++ b/R/funcs.R @@ -203,180 +203,9 @@ lngtrmtab_fun <- function(datin, colnm, yrsel, firstwidth = 240){ } -# alluvial function -# https://www.data-to-viz.com/graph/sankey.html -alluvout <- function(chgdat, lkup, var = 'HMPU_DESCRIPTOR', height = 1200){ - - clp <- lkup %>% - select(!!var, FLUCCSCODE) %>% - deframe() %>% - map(as.character) - - sumdat <- chgdat %>% - select(FLUCCS17, FLUCCS90, Acres) %>% - group_by(FLUCCS17, FLUCCS90) %>% - summarise(Acres = sum(Acres)) %>% - ungroup %>% - mutate( - FLUCCS17 = factor(FLUCCS17, levels = lkup$FLUCCSCODE), - FLUCCS17 = fct_recode(FLUCCS17, !!!clp), - FLUCCS90 = factor(FLUCCS90, levels = lkup$FLUCCSCODE), - FLUCCS90 = fct_recode(FLUCCS90, !!!clp), - ) %>% - na.omit() %>% - group_by(FLUCCS17, FLUCCS90) %>% - summarise(Acres = sum(Acres)) %>% - ungroup %>% - select(source = FLUCCS90, target = FLUCCS17, value = Acres) %>% - data.frame(stringsAsFactors = F) - sumdat$target <- paste(sumdat$target, " ", sep="") - - # From these flows we need to create a node data frame: it lists every entities involved in the flow - nodes <- data.frame(name=c(as.character(sumdat$source), as.character(sumdat$target)) %>% unique()) - - # With networkD3, connection must be provided using id, not using real name like in the links dataframe.. So we need to reformat it. - sumdat$IDsource=match(sumdat$source, nodes$name)-1 - sumdat$IDtarget=match(sumdat$target, nodes$name)-1 - - out <- sankeyNetwork(Links = sumdat, Nodes = nodes, - Source = "IDsource", Target = "IDtarget", - Value = "value", NodeID = "name", height = height, width = 800, - sinksRight=FALSE, units = 'acres', nodeWidth=40, fontSize=13, nodePadding=5) - - return(out) - -} - -# reactable change table for 1990 to 2017 comp -cmprctfun <- function(chgdat, lkup, var = 'HMPU_DESCRIPTOR'){ - - clp <- lkup %>% - select(!!var, FLUCCSCODE) %>% - deframe %>% - map(as.character) - - sumdat <- chgdat %>% - select(FLUCCS17, FLUCCS90, Acres) %>% - group_by(FLUCCS17, FLUCCS90) %>% - summarise(Acres = sum(Acres)) %>% - ungroup %>% - mutate( - FLUCCS17 = factor(FLUCCS17, levels = lkup$FLUCCSCODE), - FLUCCS17 = fct_recode(FLUCCS17, !!!clp), - FLUCCS90 = factor(FLUCCS90, levels = lkup$FLUCCSCODE), - FLUCCS90 = fct_recode(FLUCCS90, !!!clp), - ) %>% - na.omit() %>% - group_by(FLUCCS17, FLUCCS90) %>% - summarise(Acres = sum(Acres)) %>% - ungroup %>% - rename( - source = FLUCCS90, - target = FLUCCS17, - value = Acres - ) %>% - mutate( - target = factor(target, levels = sort(levels(target))), - source = factor(source, levels = sort(levels(source))) - ) - - totab <- sumdat %>% - complete(source, target) %>% - spread(target, value, fill = 0) %>% - mutate(Total = select_if(., is.numeric) %>% rowSums) - - srcttl <- select(totab, source, Total) - trgttl <- totab %>% - select(-source, -Total) %>% - gather('Category', 'Total') %>% - mutate(Category = factor(Category, levels = levels(totab$source))) %>% - group_by(Category) %>% - summarise(Total = sum(Total)) %>% - ungroup - - totab <- totab %>% - mutate( - chg = trgttl$Total - Total, - chgper = 100 * chg / Total, - chgper = ifelse(is.na(chgper), 0, chgper), - chg = as.character(round(chg, 0)), - chgper = as.character(round(chgper, 1)), - Total = as.character(round(Total, 0)) - ) - - jsfun <- JS("function(rowInfo) { - var value = rowInfo.row.chg - if (parseInt(value) >= 0) { - var color = '#008000E6' - } else if (parseInt(value) < 0) { - var color = '#e00000E6' - } - return { color: color, fontWeight: 'bold' } - }" - ) - - sticky_style <- list(position = "sticky", left = 0, background = "#fff", zIndex = 1, - borderRight = "1px solid #eee", fontWeight = 'bold') - - out <- reactable( - totab, - columns = list( - source = colDef( - name = '', - footer = '2017 total', - minWidth = 250, - style = sticky_style, - headerStyle = sticky_style, - footerStyle = sticky_style - ), - Total = colDef( - name = '1990 total', - style = list(fontWeight = 'bold'), - class = "sticky right-col-3a", - headerClass = "sticky right-col-3a", - footerClass = "sticky right-col-3a" - ), - chg = colDef( - name = '1990-2017 change (acres)', - style = jsfun, - class = "sticky right-col-2a", - headerClass = "sticky right-col-2a", - footerClass = "sticky right-col-2a" - ), - chgper = colDef( - name = '% change', - style = jsfun, - format = colFormat(suffix = '%', digits = 0), - class = "sticky right-col-1", - headerClass = "sticky right-col-1", - footerClass = "sticky right-col-1" - ) - ), - defaultColDef = colDef( - footerStyle = list(fontWeight = "bold"), - footer = function(values){ - if(!is.numeric(values)) - return() - - round(sum(values), 0) - - }, - format = colFormat(digits = 0, separators = TRUE), - resizable = TRUE - ), - # height = 800, - highlight = T, - wrap = T, - pagination = F - ) - - return(out) - -} - # alluvial plot function, for HMPU targets # https://www.data-to-viz.com/graph/sankey.html -alluvout2 <- function(datin, fluccs, mrg){ +alluvout <- function(datin, fluccs, mrg){ clp <- fluccs %>% pull(HMPU_TARGETS) %>% @@ -448,7 +277,7 @@ alluvout2 <- function(datin, fluccs, mrg){ } # reactable change table for year pairs -cmprctfun2 <- function(datin, fluccs, yrsel = '1990', maxyr = '2017', subt = F){ +cmprctfun <- function(datin, fluccs, yrsel = '1990', maxyr = '2017', subt = F){ clp <- fluccs %>% pull(HMPU_TARGETS) %>% diff --git a/landuseold.Rmd b/landuseold.Rmd deleted file mode 100644 index 4bf34ab..0000000 --- a/landuseold.Rmd +++ /dev/null @@ -1,134 +0,0 @@ ---- -output: - html_document: - code_folding: hide -css: styles.css ---- - -# Land use changes {.tabset} - -```{r setup, message = F, warning = F, results = 'hide', echo = FALSE} -knitr::opts_chunk$set(echo = TRUE, warning = F, message = F, echo = T, fig.path = 'figs/', dev.args = list(family = 'serif'), fig.path = 'figures/') - -library(tidyverse) -library(forcats) -library(foreign) -library(reactable) -library(here) -library(networkD3) - -data(chgdatold) -data(acresjso) -dat <- acresjso - -lkup <- read.csv('data/FLUCCShabsclass.csv') - -source('R/funcs.R') - -# # style file -# styles <- readLines('https://raw.githubusercontent.com/tbep-tech/css-styling/master/styles.css') -# writeLines(styles, 'styles.css') -``` - -Values in each table are acres. - -## Group - -```{r} -# format results -sums <- dat %>% - filter(var %in% 'HMPU_GROUP') %>% - select(-var) %>% - spread(name, areaac, fill = NA) %>% - mutate( - chg = `2017` - `1990`, - chgper = 100 * (`2017` - `1990`) / `1990` - ) - -lulcrct_fun(sums, 'Group', grpby = F) -``` - -##### 1990 to 2017 change {.tabset .tabset-pills} - -###### Plot - -```{r} -alluvout(chgdatold, lkup, var = "HMPU_GROUP", height = 900) -``` - -###### Table - -```{r} -cmprctfun(chgdatold, lkup, var = "HMPU_GROUP") -``` - -## Class - -```{r} -# format results -sums <- dat %>% - filter(var %in% 'HMPU_CLASS') %>% - select(-var) %>% - spread(name, areaac, fill = NA) %>% - mutate( - grpval = case_when( - val %in% c('Agriculture', 'Mining', 'Urban') ~ 'Developed', - val %in% c('Emergent Tidal Wetlands', 'Freshwater Wetlands', 'Native Forested Uplands', 'Native Non-Forested Uplands') ~ 'Native' - ), - chg = `2017` - `1990`, - chgper = 100 * (`2017` - `1990`) / `1990` - ) - -lulcrct_fun(sums, 'Class') -``` - -##### 1990 to 2017 change {.tabset .tabset-pills} - -###### Plot - -```{r} -alluvout(chgdatold, lkup, var = "HMPU_CLASS", height = 900) -``` - -###### Table - -```{r} -cmprctfun(chgdatold, lkup, var = "HMPU_CLASS") -``` - -## Descriptor - -```{r} -# format results -sums <- dat %>% - filter(var %in% 'HMPU_DESCRIPTOR') %>% - select(-var) %>% - spread(name, areaac, fill = NA) %>% - mutate( - grpval = case_when( - val %in% c('Mangrove_Swamps', 'Salt_Marshes', 'Salt_Barrens') ~ 'Tidal Wetlands', - val %in% c('Streams_and_Waterways', 'Lakes', 'Wetland_Hardwood_Forests','Wetland_Coniferous_Forests', 'Wetland_Forested_Mixed', 'Vegetated_Non-Forested_Wetlands') ~ 'Freshwater Wetlands', - val %in% c('Dry_Prairie', 'Shrub_and_Brushland', 'Mixed_Rangeland', 'Upland_Coniferous_Forest', 'Upland_Hardwood_Forest') ~ 'Native Uplands', - val %in% c('Restorable_Agriculture', 'Restorable_Developed', 'Restorable_Mining', 'Restorable_Shoreline', 'Restorable_Pond') ~ 'Opportunity Areas', - val %in% c('Lakes_Reservoirs', 'Developed') ~ 'Developed' - ), - chg = `2017` - `1990`, - chgper = 100 * (`2017` - `1990`) / `1990` - ) - -lulcrct_fun(sums, 'Habitat') -``` - -##### 1990 to 2017 change {.tabset .tabset-pills} - -###### Plot - -```{r} -alluvout(chgdatold, lkup, var = "HMPU_DESCRIPTOR", height = 1200) -``` - -###### Table - -```{r} -cmprctfun(chgdatold, lkup, var = "HMPU_DESCRIPTOR") -``` diff --git a/landuseold.html b/landuseold.html deleted file mode 100644 index b4eaaa3..0000000 --- a/landuseold.html +++ /dev/null @@ -1,3130 +0,0 @@ - - - - - - - - - - - - - -landuseold.utf8 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
- - - - - - - -
-

Land use changes

-

Values in each table are acreage, unless noted otherwise.

-
-

Group

-
# format results
-sums <- dat %>%
-  filter(var %in% 'HMPU_GROUP') %>% 
-  select(-var) %>% 
-  spread(name, areaac, fill = NA) %>% 
-  mutate(
-    chg = `2017` - `1990`,
-    chgper = 100 * (`2017` - `1990`) / `1990`
-  )
-
-rct_fun(sums, 'Group', grpby = F)
-
- -
-
1990 to 2017 change
-
-
Plot
-
alluvout(chgdatold, lkup, var = "HMPU_GROUP", height = 900)
-
- -
-
-
Table
-
cmprctfun(chgdatold, lkup, var = "HMPU_GROUP")
-
- -
-
-
-
-

Class

-
# format results
-sums <- dat %>%
-  filter(var %in% 'HMPU_CLASS') %>% 
-  select(-var) %>% 
-  spread(name, areaac, fill = NA) %>% 
-  mutate(
-    grpval = case_when(
-      val %in% c('Agriculture', 'Mining', 'Urban') ~ 'Developed', 
-      val %in% c('Emergent Tidal Wetlands', 'Freshwater Wetlands', 'Native Forested Uplands', 'Native Non-Forested Uplands') ~ 'Native'
-    ), 
-    chg = `2017` - `1990`,
-    chgper = 100 * (`2017` - `1990`) / `1990`
-  )
-
-rct_fun(sums, 'Class')
-
- -
-
1990 to 2017 change
-
-
Plot
-
alluvout(chgdatold, lkup, var = "HMPU_CLASS", height = 900)
-
- -
-
-
Table
-
cmprctfun(chgdatold, lkup, var = "HMPU_CLASS")
-
- -
-
-
-
-

Descriptor

-
# format results
-sums <- dat %>%
-  filter(var %in% 'HMPU_DESCRIPTOR') %>% 
-  select(-var) %>% 
-  spread(name, areaac, fill = NA) %>% 
-  mutate(
-    grpval = case_when(
-      val %in% c('Mangrove_Swamps', 'Salt_Marshes', 'Salt_Barrens') ~ 'Tidal Wetlands', 
-      val %in% c('Streams_and_Waterways', 'Lakes', 'Wetland_Hardwood_Forests','Wetland_Coniferous_Forests', 'Wetland_Forested_Mixed',  'Vegetated_Non-Forested_Wetlands') ~ 'Freshwater Wetlands', 
-      val %in% c('Dry_Prairie', 'Shrub_and_Brushland', 'Mixed_Rangeland', 'Upland_Coniferous_Forest', 'Upland_Hardwood_Forest') ~ 'Native Uplands',
-      val %in% c('Restorable_Agriculture', 'Restorable_Developed', 'Restorable_Mining', 'Restorable_Shoreline', 'Restorable_Pond') ~ 'Opportunity Areas', 
-      val %in% c('Lakes_Reservoirs', 'Developed') ~ 'Developed'
-    ), 
-    chg = `2017` - `1990`,
-    chgper = 100 * (`2017` - `1990`) / `1990`
-  )
-
-rct_fun(sums, 'Habitat')
-
- -
-
1990 to 2017 change
-
-
Plot
-
alluvout(chgdatold, lkup, var = "HMPU_DESCRIPTOR", height = 1200)
-
- -
-
-
Table
-
cmprctfun(chgdatold, lkup, var = "HMPU_DESCRIPTOR")
-
- -
-
-
-
- - - - -
- - - - - - - - - - - - - - - -