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")
}

Site information

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))

Reference information

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

Contributors

x <- knitr::kable(unlist(ds$contributors), format = "html", col.names = c("Value")) 
kableExtra::kable_styling(x, full_width = FALSE, position = "left")

Measurement information

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")

Observation density

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")
}

Column mapping

x <- knitr::kable(ds$columns, format = "html")
kableExtra::kable_styling(x,full_width = FALSE, position = "left")

Data processing diagnostics

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 data

Ancillary dataset has r nrow(ds$ancillary) rows.

names(ds$ancillary)


bpbond/cosore documentation built on July 20, 2021, 3:17 p.m.