river-data-core 0.2.0

Common types & traits for the in the river-data platform
Documentation 
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89

# Source: cnet-data-portal (MIT, mclement18)
# File: app/utils/calculation_functions.R
# Lines: 287-368
#
# Verbatim copy — do not modify. See generate_fixtures.R for the
# standalone version used to produce golden test values.

calcDIC <- function(df, pool, labTemp = 'default', labPressure = 'default', ...) {
  # labTemp values c('default', 'cst', 'db')
  
  # Check for the presence of the correct columns
  allColumns <- sum(
    grepl(
      paste(
        c('lab_dic_air_temp',
          'lab_dic_acid_sample_wght',
          'lab_dic_acid_wght',
          'lab_dic_vol_overpressure',
          'lab_dic_SA_added',
          'lab_dic_co2_dry'),
        collapse = '|'
      ),
      colnames(df)
    )
  ) == 6
  
  if (nrow(df) == 1 & allColumns) {
    # Define constants to get
    cst_to_get <- c('h_co2_29815k', 'gas_const_r_mol', 'vial_volume', 'h3po4_added', 'lab_temp_avg_degC', 'lab_press_avg_atm')
    
    # Get constants
    constants <- getRows(pool, 'constants', name %in% cst_to_get, columns = c('name', 'value'))
    
    # Determine which constant to use, from data entry (db) or constant table (cst)
    # The default argument will prevail the 'db' and then fallback to the 'cst'
    # Get lab temp from data
    if (labTemp == 'db') {
      lab_temp <- df %>% pull('lab_dic_air_temp')
      # Get lab temp from constant
    } else if (labTemp == 'cst') {
      lab_temp <- constants %>%
        filter(name == 'lab_temp_avg_degC') %>%
        pull('value')
    } else if (labPressure == 'default') {
      # Get db temp
      lab_temp <- df %>% pull('lab_dic_air_temp')
      # If its value is NA, use constant
      if (is.na(lab_temp)) lab_temp <- constants %>%
          filter(name == 'lab_temp_avg_degC') %>%
          pull('value')
    }
    # Calculate temp in Kelvin
    lab_temp <- lab_temp + 273.15
    
    # values needed
    lab_dic_acid_sample_wght <- df %>% select(starts_with('lab_dic_acid_sample_wght')) %>% pull()
    lab_dic_acid_wght <- df %>% select(starts_with('lab_dic_acid_wght')) %>% pull()
    lab_dic_vol_overpressure <- df %>% select(starts_with('lab_dic_vol_overpressure')) %>% pull()
    lab_dic_SA_added <- df %>% select(starts_with('lab_dic_SA_added')) %>% pull()
    lab_dic_co2_dry <- df %>% select(starts_with('lab_dic_co2_dry')) %>% pull()
    
    # Constant needed
    h_co2_29815k <- constants %>% filter(name == 'h_co2_29815k') %>% pull('value')
    gas_const_r_mol <- constants %>% filter(name == 'gas_const_r_mol') %>% pull('value')
    vial_volume <- constants %>% filter(name == 'vial_volume') %>% pull('value')
    h3po4_added <- constants %>% filter(name == 'h3po4_added') %>% pull('value')
    
    # Calculate intermediate variables
    sampleV <- lab_dic_acid_sample_wght - lab_dic_acid_wght
    hsV <- vial_volume + lab_dic_vol_overpressure - (sampleV + h3po4_added)
    co2_acid <- lab_dic_co2_dry * (lab_dic_SA_added + hsV)
    gas_temp <- gas_const_r_mol * lab_temp
    exponent <- exp(2392.86 * (1/lab_temp - 1/298.15))
    
    dividend <- co2_acid * (h_co2_29815k * exponent * sampleV * gas_temp + 101.325 * hsV)
    divisor <- 10^3 * gas_temp * hsV * sampleV
    
    # Check for presence of both dividend and divisor
    if (!any(is.na(c(dividend, divisor))) & divisor != 0) {
      return(
        # Calculate DIC
        dividend / divisor
      )
    }
  }
  
  # If nothing is returned, return NA
  as.numeric(NA)
}