knitr::opts_chunk$set(echo = FALSE, message = FALSE) library(ggplot2) theme_set(theme_bw()) library(cosore) library(lubridate) ds <- params$dataset # Compute a mean timestamp for ease of use below dsd <- ds$data dsd$CSR_TIMESTAMP <- do.call(c, Map(function(x, y) mean(c(x, y)), dsd$CSR_TIMESTAMP_BEGIN, dsd$CSR_TIMESTAMP_END)) quick <- params$quick
r ds$description$CSR_DATASET
d <- ds$description diag <- ds$diagnostics if(embargoed(ds)) { cat("---------------------------------------------------------------\n") cat("EMBARGO FLAG IS SET--DATA WILL NOT BE RELEASED\n") cat("---------------------------------------------------------------\n") }
Info | Value
------------- | ----
Site | r d$CSR_SITE_NAME
Location | r d$CSR_LATITUDE
N, r d$CSR_LONGITUDE
E
Elevation | r d$CSR_ELEVATION
m
IGBP | r d$CSR_IGBP
Network | r paste(d$CSR_NETWORK, d$CSR_SITE_ID)
Timezone | r d$CSR_TIMEZONE
Notes | r d$CSR_NOTES
library(sp) library(leaflet) desc <- ds$description df <- data.frame(label = paste(desc$CSR_DATASET, desc$CSR_SITE_NAME), lon = desc$CSR_LONGITUDE, lat = desc$CSR_LATITUDE) coordinates(df) <- ~lon + lat x <- addMarkers(leaflet(df), label = df$label) addTiles(x, options = providerTileOptions(minZoom = 3, maxZoom = 5))
Info | Value
--------------- | ----
Publication (URL or DOI) | r d$CSR_PRIMARY_PUB
Other publications | r d$CSR_OTHER_PUBS
Data (URL or DOI) | r d$CSR_DATA_URL
Acknowledgment text: r d$CSR_ACKNOWLEDGMENT
x <- knitr::kable(unlist(ds$contributors), format = "html", col.names = c("Value")) kableExtra::kable_styling(x, full_width = FALSE, position = "left")
Instrument: r d$CSR_INSTRUMENT
Measurement length (s): r d$CSR_MSMT_LENGTH
File format: r d$CSR_FILE_FORMAT
Timestamp format: r d$CSR_TIMESTAMP_FORMAT
Timestamp timezone: r d$CSR_TIMESTAMP_TZ
dsp <- ds$ports x <- knitr::kable(dsp, format = "html") kableExtra::kable_styling(x, full_width = FALSE, position = "left")
if(is.data.frame(dsd)) { x <- cosore:::compute_interval(dsd) results <- list() for(yr in na.omit(unique(x$Year))) { d <- x[x$Year == yr,] results[[yr]] <- tibble(Year = yr, `Interval (min)` = round(weighted.mean(d$Interval, d$N, na.rm = TRUE), 1)) } results <- cosore:::rbind_list(results) kableExtra::kable_styling(knitr::kable(results), full_width = FALSE, position = "left") }
x <- knitr::kable(ds$columns, format = "html") kableExtra::kable_styling(x,full_width = FALSE, position = "left")
Info | Value
------------------- | ----
Records | r diag$CSR_RECORDS
Records removed (error) | r diag$CSR_RECORDS_REMOVED_ERR
Records removed (invalid timestamp) | r diag$CSR_RECORDS_REMOVED_TIMESTAMP
Bad timestamp examples | r diag$CSR_EXAMPLE_BAD_TIMESTAMPS
Records removed (no flux) | r diag$CSR_RECORDS_REMOVED_NA
Size | r format(object.size(ds), "Mb")
Flux summary:
if(is.data.frame(dsd) & !quick) { has_ch4 <- any(!is.na(dsd$CSR_FLUX_CH4)) has_co2 <- any(!is.na(dsd$CSR_FLUX_CO2)) dsd$Month = month(dsd$CSR_TIMESTAMP_BEGIN) #dsd <- subset(dsd, !is.na(CSR_FLUX_CO2) & CSR_FLUX_CO2 > 0) dsd$CSR_PORT <- as.factor(dsd$CSR_PORT) print(summary(dsd$CSR_FLUX_CO2)) print(summary(dsd$CSR_FLUX_CH4)) # flux over time if(has_co2) { p1 <- ggplot(dsd, aes(CSR_TIMESTAMP, CSR_FLUX_CO2, color = CSR_PORT)) + geom_line() if(length(unique(dsd$CSR_PORT)) < 17) { p1 <- p1 + geom_line() + facet_grid(CSR_PORT~., scales = "free_y") } else { # under these conditions a faceted plot looks terrible p1 <- p1 + geom_point() } print(p1) smry <- aggregate(CSR_FLUX_CO2 ~ CSR_PORT + Month, data = dsd, mean) p3 <- ggplot(smry, aes(Month, CSR_FLUX_CO2, color = CSR_PORT, group = CSR_PORT)) + geom_line() print(p3) } if(has_ch4) { p1_ch4 <- ggplot(dsd, aes(CSR_TIMESTAMP, CSR_FLUX_CH4, color = CSR_PORT)) + geom_line() + facet_grid(CSR_PORT~., scales = "free_y") print(p1_ch4) smry <- aggregate(CSR_FLUX_CH4 ~ CSR_PORT + Month, data = dsd, mean) p3_ch4 <- ggplot(smry, aes(Month, CSR_FLUX_CH4, color = CSR_PORT, group = CSR_PORT)) + geom_line() print(p3_ch4) } # Histogram if(has_co2) { p4 <- ggplot(dsd, aes(x = CSR_FLUX_CO2)) + geom_histogram(bins = 30) print(p4) } if(has_ch4) { p4_ch4 <- ggplot(dsd, aes(x = CSR_FLUX_CH4)) + geom_histogram(bins = 30) print(p4_ch4) } }
Temperature sensitivity:
if(is.data.frame(dsd) & !quick) { tcols <- grep("^CSR_T(AIR|[0-9]+)", names(dsd)) if(length(tcols)) { if(has_co2) { results <- list() for(col in tcols) { x <- dsd[c("CSR_FLUX_CO2", "CSR_PORT")] x$Temperature <- unlist(dsd[,col]) x$Which_temp <- names(dsd)[col] results[[as.character(col)]] <- x } results <- cosore:::rbind_list(results) p1 <- ggplot(results, aes(Temperature, CSR_FLUX_CO2, color = CSR_PORT)) + geom_point(size = 0.2, alpha = I(0.25)) + geom_smooth(method = "lm", se = FALSE) + facet_wrap(~Which_temp, scales = "free") print(p1) } if(has_ch4) { results <- list() for(col in tcols) { x <- dsd[c("CSR_FLUX_CH4", "CSR_PORT")] x$Temperature <- unlist(dsd[,col]) x$Which_temp <- names(dsd)[col] results[[as.character(col)]] <- x } results <- cosore:::rbind_list(results) p1_ch4 <- ggplot(results, aes(Temperature, CSR_FLUX_CH4, color = CSR_PORT)) + geom_point(size = 0.2, alpha = I(0.25)) + geom_smooth(method = "lm", se = FALSE) + facet_wrap(~Which_temp, scales = "free") print(p1_ch4) } } }
Soil moisture sensitivity:
if(is.data.frame(ds$data) & !quick) { smcols <- grep("^CSR_SM[0-9]+", names(dsd)) if(length(smcols)) { if(has_co2) { results <- list() for(col in smcols) { x <- dsd[c("CSR_FLUX_CO2", "CSR_PORT")] x$SM <- unlist(dsd[,col]) x$Which_sm <- names(dsd)[col] results[[as.character(col)]] <- x } results <- cosore:::rbind_list(results) p1 <- ggplot(results, aes(SM, CSR_FLUX_CO2, color = CSR_PORT)) + geom_point(size = 0.2, alpha = I(0.25)) + geom_smooth(method = "lm", se = FALSE) + facet_wrap(~Which_sm, scales = "free") + xlab("Soil moisture") print(p1) } if(has_ch4) { results <- list() for(col in smcols) { x <- dsd[c("CSR_FLUX_CH4", "CSR_PORT")] x$SM <- unlist(dsd[,col]) x$Which_sm <- names(dsd)[col] results[[as.character(col)]] <- x } results <- cosore:::rbind_list(results) p1_ch4 <- ggplot(results, aes(SM, CSR_FLUX_CH4, color = CSR_PORT)) + geom_point(size = 0.2, alpha = I(0.25)) + geom_smooth(method = "lm", se = FALSE) + facet_wrap(~Which_sm, scales = "free") + xlab("Soil moisture") print(p1_ch4) } } }
Ancillary dataset has r nrow(ds$ancillary)
rows.
names(ds$ancillary)
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.