Skip to content

Commit

Permalink
Add temp about html
Browse files Browse the repository at this point in the history
  • Loading branch information
@stephpenn1
stephpenn1 committed May 31, 2024
1 parent 377efca commit a0216e5
Showing 1 changed file with 166 additions and 153 deletions.
319 changes: 166 additions & 153 deletions h2/components/modules/mod_tracking.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -40,168 +40,181 @@ tracking_ui <- function(id) {
"Carbon Fraction"=2),
selected = 1),
bsPopover(ns("view"), title="",content="Select whether you want to view the total amounts of carbon in each pool (Carbon Amount), or the fraction each pool has of the total amount in the system (Carbon Fraction).",
placement = "top", trigger = "hover", options = NULL),
actionButton(ns("generate"),"Generate"),
downloadButton(ns("download"),"Download Plots"),
placement = "top", trigger = "hover", options = NULL)
),
mainPanel(
withSpinner(plotOutput(ns("fig"))),
imageOutput(ns("gif")),
fluidRow(
actionButton(ns("generate"),"Generate", width = '150px', style = "background: #0B3F8F; color: white;"),
downloadButton(ns("download"),"Download Plots", style = "background: #B8B8B8; color: black;")
),
fluidRow(
withSpinner(plotOutput(ns("fig"))),
imageOutput(ns("gif"))
)
)
)
}

tracking_server <- function(id) {
moduleServer(id, function(input, output, session) {

observe({
# Run Hector w/ carbon tracking
ini_file <- reactive({system.file(input$ssp_path,package="hector")})
core <- newcore(ini_file())
tunits <- getunits(TRACKING_DATE())
setvar(core, NA, TRACKING_DATE(), input$start, tunits)
reset(core, core$reset_date)
print("Running Hector...")
run(core, runtodate = 2300)
print("Gathering data...")
df <- get_tracking_data(core)

# clean up pool names
df[df=="atmos_co2"] <- "Atmosphere"
df[df=="deep"] <- "Deep Ocean"
df[df=="detritus_c"] <- "Detritus"
df[df=="earth_c"] <- "Fossil Fuels"
df[df=="HL"] <- "HL Ocean"
df[df=="intermediate"] <- "Intermediate Ocean"
df[df=="LL"] <- "LL Ocean"
df[df=="soil_c"] <- "Soil"
df[df=="veg_c"] <- "Vegetation"

## filter df to just selected pool
selectedPool <- reactive({input$pool})
df <- filter(df,pool_name==selectedPool())
# filter out fossil fuels if selected
if (input$ff == 2) {
df <- subset(df, source_name!="Fossil Fuels")
}
# filter out permafrost rows (for now -- they're empty)
df <- subset(df, source_name!="permafrost_c")
df <- subset(df, source_name!="thawedp_c")

# fill in any missing pools
df <- df[order(df$source_name),] # sort by source, then year, so sources are always in same order each year
df <- df[order(df$year),]


# rank column for moving bar plot
df <- df %>%
group_by(year) %>%
mutate(rank = rank(-source_fraction),
frac_rel = source_fraction/source_fraction[rank==1],
source_amt = source_fraction*pool_value,
amt_lbl = paste0(format(round(source_amt,2), nsmall=2), " Pg C"),
frac_lbl = paste0(format(round(source_fraction,2),nsmall=2))) %>%
group_by(source_name) %>%
ungroup()

# Carbon amount
if (input$view == 1) {
area_plot <-
ggplot(df, aes(x=year,y=source_amt,fill=source_name)) +
geom_area(stat="identity") +
scale_fill_viridis_d(name="Source") +
scale_color_viridis_d() +
ggtitle(paste0(selectedPool(), " Carbon Amount by Source")) +
xlab("") +
ylab("Carbon Pool (Pg C)") +
theme(plot.title = element_text(size=20,face="bold"),
legend.title=element_text(size=16),
legend.position="bottom",
legend.text=element_text(size=12),
axis.title.y=element_text(size=14),
axis.text=element_text(size=10),
plot.margin = margin(1,1,1,1,"cm"))

# save as file
ggsave("outfile_area.jpeg",plot=area_plot,device="jpeg",
dpi=72,width=800,height=500,units="px")

}

# Carbon fraction
if (input$view == 2) {

print("Generating plot...")
area_plot <-
ggplot(df, aes(x=year,y=source_fraction,fill=source_name)) +
geom_area(stat="identity") +
scale_fill_viridis_d() +
scale_color_viridis_d() +
ggtitle(paste0(selectedPool(), " Carbon Fraction by Source")) +
xlab("") +
ylab("Carbon Pool (Fraction)") +
theme(plot.title = element_text(size=20,face="bold"),
legend.title=element_text(size=16),
legend.position="bottom",
legend.text=element_text(size=12),
axis.title.y=element_text(size=14),
axis.text=element_text(size=10),
plot.margin = margin(1,1,1,1,"cm"))

# save as file
ggsave("outfile_area.jpeg",plot=area_plot,device="jpeg",
width=800,height=500,units="px")

}

output$fig <- renderPlot(area_plot)

output$gif <- renderImage({

# Make animation
p <- ggplot(df,aes(fill=source_name,color=source_name,
x=reorder(source_name,source_amt),
y=source_amt)) +
geom_bar(stat="identity") +
geom_text(aes(y=0, label = paste(source_name, " ")),
vjust = 0.2, hjust = 1, size = 6) +
geom_text(aes(y = source_amt, label = paste(" ",amt_lbl), hjust=0),
size = 6) +
coord_flip(clip = "off", expand = FALSE) +
theme_void() +
theme(plot.title = element_text(size=20,face="bold"),
plot.subtitle = element_text(size=18),
legend.position="none",
panel.grid.major.x = element_line(linewidth=.1,color="snow2"),
panel.grid.minor.x = element_line(linewidth=.1,color="snow2"),
plot.margin = margin(1,6,1,6,"cm")) +
ylab("Carbon (Pg)") +
xlab("") +
scale_fill_viridis_d() +
scale_color_viridis_d() +

# gganimate
transition_time(year) +
ease_aes('linear')

# Animate
anim <- p + transition_states(year,transition_length=4,
state_length=2,wrap=FALSE) +
view_follow(fixed_x = TRUE) +
labs(title=paste0(selectedPool()," Carbon Sources"),
subtitle="Year: {closest_state}")

anim_save("outfile_bar.gif", animate(anim, height = 500, width = 800,
end_pause=30))
list(src = 'outfile_bar.gif',
contentType = 'image/gif'
# width = 800,
# height = 500,
# alt = "An animation tracking the sources of carbon in a chosen pool"
)}, deleteFile = TRUE)

}) %>%
bindEvent(input$generate)
observe({
withProgress(message = "Generating plots", value = 0, {
# Run Hector w/ carbon tracking
ini_file <- reactive({system.file(input$ssp_path,package="hector")})
core <- newcore(ini_file())
tunits <- getunits(TRACKING_DATE())
setvar(core, NA, TRACKING_DATE(), input$start, tunits)
reset(core, core$reset_date)

incProgress(0.25, detail = "Running hector...")
print("Running Hector...")
run(core, runtodate = 2300)

incProgress(0.25, detail = "Gathering data...")
print("Gathering data...")
df <- get_tracking_data(core)

# clean up pool names
df[df=="atmos_co2"] <- "Atmosphere"
df[df=="deep"] <- "Deep Ocean"
df[df=="detritus_c"] <- "Detritus"
df[df=="earth_c"] <- "Fossil Fuels"
df[df=="HL"] <- "HL Ocean"
df[df=="intermediate"] <- "Intermediate Ocean"
df[df=="LL"] <- "LL Ocean"
df[df=="soil_c"] <- "Soil"
df[df=="veg_c"] <- "Vegetation"

## filter df to just selected pool
selectedPool <- reactive({input$pool})
df <- filter(df,pool_name==selectedPool())
# filter out fossil fuels if selected
if (input$ff == 2) {
df <- subset(df, source_name!="Fossil Fuels")
}
# filter out permafrost rows (for now -- they're empty)
df <- subset(df, source_name!="permafrost_c")
df <- subset(df, source_name!="thawedp_c")

# fill in any missing pools
df <- df[order(df$source_name),] # sort by source, then year, so sources are always in same order each year
df <- df[order(df$year),]


# rank column for moving bar plot
df <- df %>%
group_by(year) %>%
mutate(rank = rank(-source_fraction),
frac_rel = source_fraction/source_fraction[rank==1],
source_amt = source_fraction*pool_value,
amt_lbl = paste0(format(round(source_amt,2), nsmall=2), " Pg C"),
frac_lbl = paste0(format(round(source_fraction,2),nsmall=2))) %>%
group_by(source_name) %>%
ungroup()

incProgress(0.25, detail = "Generating plots...")
# Carbon amount
if (input$view == 1) {
area_plot <-
ggplot(df, aes(x=year,y=source_amt,fill=source_name)) +
geom_area(stat="identity") +
scale_fill_viridis_d(name="Source") +
scale_color_viridis_d() +
ggtitle(paste0(selectedPool(), " Carbon Amount by Source")) +
xlab("") +
ylab("Carbon Pool (Pg C)") +
theme(plot.title = element_text(size=20,face="bold"),
legend.title=element_text(size=16),
legend.position="bottom",
legend.text=element_text(size=12),
axis.title.y=element_text(size=14),
axis.text=element_text(size=10),
plot.margin = margin(1,1,1,1,"cm"))

# save as file
ggsave("outfile_area.jpeg",plot=area_plot,device="jpeg",
dpi=72,width=800,height=500,units="px")

}

# Carbon fraction
if (input$view == 2) {

print("Generating plot...")
area_plot <-
ggplot(df, aes(x=year,y=source_fraction,fill=source_name)) +
geom_area(stat="identity") +
scale_fill_viridis_d() +
scale_color_viridis_d() +
ggtitle(paste0(selectedPool(), " Carbon Fraction by Source")) +
xlab("") +
ylab("Carbon Pool (Fraction)") +
theme(plot.title = element_text(size=20,face="bold"),
legend.title=element_text(size=16),
legend.position="bottom",
legend.text=element_text(size=12),
axis.title.y=element_text(size=14),
axis.text=element_text(size=10),
plot.margin = margin(1,1,1,1,"cm"))

# save as file
ggsave("outfile_area.jpeg",plot=area_plot,device="jpeg",
width=800,height=500,units="px")

}

output$fig <- renderPlot(area_plot)

output$gif <- renderImage({

# Make animation
p <- ggplot(df,aes(fill=source_name,color=source_name,
x=reorder(source_name,source_amt),
y=source_amt)) +
geom_bar(stat="identity") +
geom_text(aes(y=0, label = paste(source_name, " ")),
vjust = 0.2, hjust = 1, size = 6) +
geom_text(aes(y = source_amt, label = paste(" ",amt_lbl), hjust=0),
size = 6) +
coord_flip(clip = "off", expand = FALSE) +
theme_void() +
theme(plot.title = element_text(size=20,face="bold"),
plot.subtitle = element_text(size=18),
legend.position="none",
panel.grid.major.x = element_line(linewidth=.1,color="snow2"),
panel.grid.minor.x = element_line(linewidth=.1,color="snow2"),
plot.margin = margin(1,6,1,6,"cm")) +
ylab("Carbon (Pg)") +
xlab("") +
scale_fill_viridis_d() +
scale_color_viridis_d() +

# gganimate
transition_time(year) +
ease_aes('linear')

# Animate
anim <- p + transition_states(year,transition_length=4,
state_length=2,wrap=FALSE) +
view_follow(fixed_x = TRUE) +
labs(title=paste0(selectedPool()," Carbon Sources"),
subtitle="Year: {closest_state}")

anim_save("outfile_bar.gif", animate(anim, height = 500, width = 800,
end_pause=30))
list(src = 'outfile_bar.gif',
contentType = 'image/gif'
# width = 800,
# height = 500,
# alt = "An animation tracking the sources of carbon in a chosen pool"
)}, deleteFile = TRUE)

incProgress(0.25, detail = "Complete")
Sys.sleep(0.2)
})
}) %>%
bindEvent(input$generate)

# Download plots
output$download <- downloadHandler(
Expand Down

0 comments on commit a0216e5

Please sign in to comment.