AGB DE RFs v2

Unweighted Fire Response Functions

agb.RF.calcs = AGB%>%
  group_by(MgmtID, StandID)%>%
  filter(Year>2030)%>%
  mutate(d.prop = ((Aboveground_Total_Live/Aboveground_Total_Live[1])-(Aboveground_Total_Live.base/Aboveground_Total_Live.base[1])))%>%
  mutate(d.prop = if_else(d.prop < -1, -1, d.prop))%>%
  mutate(d.prop = if_else(d.prop > 1, 1, d.prop))

median.RFs <- AGB %>%
  group_by(MgmtID, Year) %>%
  summarize(
    median.d.prop = round(median(d.prop, na.rm = TRUE), 3),
    .groups = 'drop'  # Ensures the result is ungrouped
  )%>%
  mutate(median.d.prop = if_else(median.d.prop < -1, -1, median.d.prop))%>%
  mutate(median.d.prop = if_else(median.d.prop > 1, 1, median.d.prop))

agb.plot=plot_ly(data = median.RFs, x = ~ Year, y = ~ median.d.prop, type = 'scatter', mode = 'lines', color = ~ MgmtID)%>%
  layout(title='Response Functions by Fire Intensity Class for Carbon')
  
agb.plot

agb.plot=plot_ly(data = median.RFs, x = ~ Year, y = ~ median.d.prop, type = 'bar',  color = ~ MgmtID)%>%
  layout(title='Response Functions by Fire Intensity Class for Carbon')
  
agb.plot

agb.plot=plot_ly(data = agb.RF.calcs, x = ~ Year, y = ~ d.prop, type = 'box',  color = ~ MgmtID)%>%
  layout(title='Response Functions by Fire Intensity Class for Carbon')
  
agb.plot

## Warning: Ignoring 36 observations

FRG-scaled Fire Response Functions

frg1.carb = AGB%>%
  filter(StandID %in% frg1.freq$StandID)%>%
  left_join(frg1.freq, AGB, by = 'StandID')%>%
  filter(StandID != 0)%>%
  mutate(w.Carb = d.prop)%>%
  select(MgmtID, Year, d.prop)%>%
  mutate(FRG = 1)

## Adding missing grouping variables: `StandID`

frg2.carb = AGB%>%
  filter(StandID %in% frg2.freq$StandID)%>%
  left_join(frg2.freq, AGB, by = 'StandID')%>%
  filter(StandID != 0)%>%
  mutate(w.Carb = d.prop)%>%
  select(MgmtID, Year, d.prop)%>%
  mutate(FRG = 2)

## Adding missing grouping variables: `StandID`

frg3.carb = AGB%>%
  filter(StandID %in% frg3.freq$StandID)%>%
  left_join(frg3.freq, AGB, by = 'StandID')%>%
  filter(StandID != 0)%>%
  mutate(w.Carb = d.prop)%>%
  select(MgmtID, Year, d.prop)%>%
  mutate(FRG = 3)

## Adding missing grouping variables: `StandID`

frg4.carb = AGB%>%
  filter(StandID %in% frg4.freq$StandID)%>%
  left_join(frg4.freq, AGB, by = 'StandID')%>%
  filter(StandID != 0)%>%
  mutate(w.Carb = d.prop)%>%
  select(MgmtID, Year, d.prop)%>%
  mutate(FRG = 4)

## Adding missing grouping variables: `StandID`

frg5.carb = AGB%>%
  filter(StandID %in% frg5.freq$StandID)%>%
  left_join(frg5.freq, AGB, by = 'StandID')%>%
  filter(StandID != 0)%>%
  mutate(w.Carb = d.prop)%>%
  select(MgmtID, Year, d.prop)%>%
  mutate(FRG = 5)

## Adding missing grouping variables: `StandID`

agb.RF.1 <- frg1.carb%>%
  group_by(MgmtID, Year) %>%
  summarize(
    median.d.prop = round(median(d.prop, na.rm = TRUE), 3),
    .groups = 'drop'  # Ensures the result is ungrouped
  )%>% 
  mutate(FRG = 1) 

agb.RF.2 = frg2.carb%>%
  group_by(MgmtID, Year) %>%
  summarize(
    median.d.prop = round(median(d.prop, na.rm = TRUE), 3),
    .groups = 'drop'  # Ensures the result is ungrouped
  )%>% 
  mutate(FRG = 2) 
agb.RF.3 = frg3.carb%>%
  group_by(MgmtID, Year) %>%
  summarize(
    median.d.prop = round(median(d.prop, na.rm = TRUE), 3),
    .groups = 'drop'  # Ensures the result is ungrouped
  )%>% 
  mutate(FRG = 3) 
agb.RF.4 = frg4.carb%>%
  group_by(MgmtID, Year) %>%
  summarize(
    median.d.prop = round(median(d.prop, na.rm = TRUE), 3),
    .groups = 'drop'  # Ensures the result is ungrouped
  )%>% 
  mutate(FRG = 4) 
agb.RF.5 = frg5.carb%>%
  group_by(MgmtID, Year) %>%
  summarize(
    median.d.prop = round(median(d.prop, na.rm = TRUE), 3),
    .groups = 'drop'  # Ensures the result is ungrouped
  )%>% 
  mutate(FRG = 5) 

de.agb.RF = rbind(agb.RF.1, agb.RF.2, agb.RF.3, agb.RF.4, agb.RF.5)

de.agb.RF%>%
  filter(Year == 2045)%>%
  kbl()%>%
  kable_minimal()

MgmtID	Year	median.d.prop	FRG
FIC1	2045	0.287	1
FIC2	2045	0.162	1
FIC3	2045	0.109	1
FIC4	2045	0.046	1
FIC5	2045	-0.538	1
FIC6	2045	-1.000	1
FIC1	2045	0.310	2
FIC2	2045	0.179	2
FIC3	2045	0.126	2
FIC4	2045	0.062	2
FIC5	2045	-0.542	2
FIC6	2045	-1.000	2
FIC1	2045	0.286	3
FIC2	2045	0.161	3
FIC3	2045	0.108	3
FIC4	2045	0.045	3
FIC5	2045	-0.538	3
FIC6	2045	-1.000	3
FIC1	2045	0.295	4
FIC2	2045	0.169	4
FIC3	2045	0.117	4
FIC4	2045	0.053	4
FIC5	2045	-0.540	4
FIC6	2045	-1.000	4
FIC1	2045	0.288	5
FIC2	2045	0.163	5
FIC3	2045	0.110	5
FIC4	2045	0.047	5
FIC5	2045	-0.538	5
FIC6	2045	-1.000	5

fig <- plot_ly(alpha = .8)

fig = fig %>% add_trace(y = ~agb.RF.2$median.d.prop, x = ~agb.RF.2$MgmtID, type = 'box', name = 'FIC2 - Unweighted')
fig = fig %>% add_trace(y = ~agb.RF.3$median.d.prop, x = ~agb.RF.3$MgmtID, type = 'box', name = 'FIC3 - Unweighted')

fig

FRG.32767 = de.agb.RF%>%
  group_by(MgmtID)%>%
  mutate(value = mean(median.d.prop))%>%
  distinct(MgmtID, value)%>%
  mutate(predictor_value = 32767)%>%
  arrange(MgmtID)

RF.agb = rbind(RF.agb, FRG.32767)%>%
  mutate(value = round(value, 3))%>%
  arrange(MgmtID, predictor_value)

REBA.Github <- read.csv('~/vibrant-science/AGB-RF/GITHUB-DE-Translator.csv')


# Step 5: Join REBA.PR with FRG.32767 and update values
REBA.PR <- REBA.Github %>%
  inner_join(RF.agb, by = c('MgmtID','predictor_value'))%>%
  mutate(value = if_else(predictor_value == 32767, value.y, value.x)) %>%
  select(-value.y, -value.x, -MgmtID)

# Ensure the column order in REBA.Github is maintained
REBA.PR <- REBA.Github%>%
  select(-MgmtID)%>%
  mutate(value = if_else(predictor_value == 6, 0, value))%>%
  arrange(intensity_class, predictor_value)#fill FRG 6 with 0 instead of NA
REBA.PR$value[28]=0.054
REBA.PR%>%
  kbl()%>%
  kable_minimal()

disturbance_type	intensity_class	sara_id	spatial_predictor	predictor_value	value	name	objective
Fire	1	34	FRG	1	0.423	Aboveground Live Biomass	crb
Fire	1	34	FRG	2	0.669	Aboveground Live Biomass	crb
Fire	1	34	FRG	3	0.400	Aboveground Live Biomass	crb
Fire	1	34	FRG	4	0.235	Aboveground Live Biomass	crb
Fire	1	34	FRG	5	0.163	Aboveground Live Biomass	crb
Fire	1	34	FRG	6	0.000	Aboveground Live Biomass	crb
Fire	1	34	FRG	32767	0.378	Aboveground Live Biomass	crb
Fire	2	34	FRG	1	0.259	Aboveground Live Biomass	crb
Fire	2	34	FRG	2	0.451	Aboveground Live Biomass	crb
Fire	2	34	FRG	3	0.226	Aboveground Live Biomass	crb
Fire	2	34	FRG	4	0.012	Aboveground Live Biomass	crb
Fire	2	34	FRG	5	0.012	Aboveground Live Biomass	crb
Fire	2	34	FRG	6	0.000	Aboveground Live Biomass	crb
Fire	2	34	FRG	32767	0.192	Aboveground Live Biomass	crb
Fire	3	34	FRG	1	0.147	Aboveground Live Biomass	crb
Fire	3	34	FRG	2	0.308	Aboveground Live Biomass	crb
Fire	3	34	FRG	3	0.110	Aboveground Live Biomass	crb
Fire	3	34	FRG	4	-0.089	Aboveground Live Biomass	crb
Fire	3	34	FRG	5	-0.088	Aboveground Live Biomass	crb
Fire	3	34	FRG	6	0.000	Aboveground Live Biomass	crb
Fire	3	34	FRG	32767	0.078	Aboveground Live Biomass	crb
Fire	4	34	FRG	1	0.092	Aboveground Live Biomass	crb
Fire	4	34	FRG	2	0.261	Aboveground Live Biomass	crb
Fire	4	34	FRG	3	0.053	Aboveground Live Biomass	crb
Fire	4	34	FRG	4	-0.154	Aboveground Live Biomass	crb
Fire	4	34	FRG	5	-0.154	Aboveground Live Biomass	crb
Fire	4	34	FRG	6	0.000	Aboveground Live Biomass	crb
Fire	4	34	FRG	32767	0.054	Aboveground Live Biomass	crb
Fire	5	34	FRG	1	-0.472	Aboveground Live Biomass	crb
Fire	5	34	FRG	2	-0.374	Aboveground Live Biomass	crb
Fire	5	34	FRG	3	-0.493	Aboveground Live Biomass	crb
Fire	5	34	FRG	4	-0.600	Aboveground Live Biomass	crb
Fire	5	34	FRG	5	-0.597	Aboveground Live Biomass	crb
Fire	5	34	FRG	6	0.000	Aboveground Live Biomass	crb
Fire	5	34	FRG	32767	-0.507	Aboveground Live Biomass	crb
Fire	6	34	FRG	1	-0.836	Aboveground Live Biomass	crb
Fire	6	34	FRG	2	-0.817	Aboveground Live Biomass	crb
Fire	6	34	FRG	3	-0.845	Aboveground Live Biomass	crb
Fire	6	34	FRG	4	-0.855	Aboveground Live Biomass	crb
Fire	6	34	FRG	5	-0.872	Aboveground Live Biomass	crb
Fire	6	34	FRG	6	0.000	Aboveground Live Biomass	crb
Fire	6	34	FRG	32767	-0.845	Aboveground Live Biomass	crb

Evaluate the change in RF via FRG

m.RF = median.RFs%>%
  filter(Year == 2045)
scalar.delta = RF.agb%>%
  group_by(MgmtID)%>%
  left_join(m.RF, by = 'MgmtID', suffix = c('', '.d'))%>%
  mutate(delta.value = value - median.d.prop)%>%
  filter(predictor_value<6)

WbP.plot2=plot_ly(data = scalar.delta, x = ~ predictor_value, y = ~ delta.value, type = 'box', color = ~ as.factor(predictor_value))%>%
  layout(title='Disturbance Effect Response Functions by FRG')

WbP.plot2