R/regression_functions.R

In paulnorthrop/walls: Statistical Inference for the Thermophysical Properties of Walls from In-Situ Surveys

in_reg_fn <- function(x1, x2, Qinp1, R1, R2, C1, tau) {
  r1 <- 1 / R1
  r2 <- 1 / R2
  dplus <- 2 * C1 / tau[1] + r1 + r2
  dminus <- 2 * C1 / tau[1] - r1 - r2
  b <- dminus / dplus
  return(2 * r1 * (r2 * x1 + C1 * x2 / tau) / dplus + b * Qinp1)
}

# sum_R = R1 + R2, frac_R = R1 / (R1 + R2)
sum_in_reg_fn <- function(x1, x2, Qinp1, sum_R, frac_R, C1, tau) {
  R1 <- sum_R * frac_R
  R2 <- sum_R * (1 - frac_R)
  r1 <- 1 / R1
  r2 <- 1 / R2
  dplus <- 2 * C1 / tau[1] + r1 + r2
  dminus <- 2 * C1 / tau[1] - r1 - r2
  b <- dminus / dplus
  return(2 * r1 * (r2 * x1 + C1 * x2 / tau) / dplus + b * Qinp1)
}

log_in_reg_fn <- function(x1, x2, Qinp1, logR1, logR2, logC1, tau) {
  R1 <- exp(logR1)
  R2 <- exp(logR2)
  C1 <- exp(logC1)
  #
  r1 <- 1 / R1
  r2 <- 1 / R2
  dplus <- 2 * C1 / tau[1] + r1 + r2
  dminus <- 2 * C1 / tau[1] - r1 - r2
  b <- dminus / dplus
  return(2 * r1 * (r2 * x1 + C1 * x2 / tau) / dplus + b * Qinp1)
}

out_reg_fn <- function(x1, x3, Qoutp1, R1, R2, C1, tau) {
  r1 <- 1 / R1
  r2 <- 1 / R2
  dplus <- 2 * C1 / tau[1] + r1 + r2
  dminus <- 2 * C1 / tau[1] - r1 - r2
  b <- dminus / dplus
  return(2 * r2 * (r1 * x1 + C1 * x3 / tau) / dplus + b * Qoutp1)
}

# sum_R = R1 + R2, frac_R = R1 / (R1 + R2)
sum_out_reg_fn <- function(x1, x3, Qoutp1, sum_R, frac_R, C1, tau) {
  R1 <- sum_R * frac_R
  R2 <- sum_R * (1 - frac_R)
  r1 <- 1 / R1
  r2 <- 1 / R2
  dplus <- 2 * C1 / tau[1] + r1 + r2
  dminus <- 2 * C1 / tau[1] - r1 - r2
  b <- dminus / dplus
  return(2 * r1 * (r2 * x1 + C1 * x3 / tau) / dplus + b * Qoutp1)
}

in_out_reg_fn <- function(x1, x23, Qsp1, R1, R2, C1, in_out, tau) {
  r1 <- 1 / R1
  r2 <- 1 / R2
  dplus <- 2 * C1 / tau[1] + r1 + r2
  dminus <- 2 * C1 / tau[1] - r1 - r2
  b <- dminus / dplus
  term1 <- 2 * r1 * r2 * x1
  term2a <- 2 * r1 * C1 * x23[in_out == "inside"] / tau[1]
  term2b <- 2 * r2 * C1 * x23[in_out == "outside"] / tau[1]
  term2 <- c(term2a, term2b)
  term3 <- b * Qsp1
  return((term1 + term2) / dplus + term3)
}

sum_in_out_reg_fn <- function(x1, x23, Qsp1, sum_R, frac_R, C1, in_out, tau) {
  R1 <- sum_R * frac_R
  R2 <- sum_R * (1 - frac_R)
  r1 <- 1 / R1
  r2 <- 1 / R2
  dplus <- 2 * C1 / tau[1] + r1 + r2
  dminus <- 2 * C1 / tau[1] - r1 - r2
  b <- dminus / dplus
  term1 <- 2 * r1 * r2 * x1
  term2a <- 2 * r1 * C1 * x23[in_out == "inside"] / tau[1]
  term2b <- 2 * r2 * C1 * x23[in_out == "outside"] / tau[1]
  term2 <- c(term2a, term2b)
  term3 <- b * Qsp1
  return((term1 + term2) / dplus + term3)
}

log_in_out_reg_fn <- function(x1, x23, Qsp1, logR1, logR2, logC1, in_out, tau) {
  R1 <- exp(logR1)
  R2 <- exp(logR2)
  C1 <- exp(logC1)
  #
  r1 <- 1 / R1
  r2 <- 1 / R2
  dplus <- 2 * C1 / tau[1] + r1 + r2
  dminus <- 2 * C1 / tau[1] - r1 - r2
  b <- dminus / dplus
  term1 <- 2 * r1 * r2 * x1
  term2a <- 2 * r1 * C1 * x23[in_out == "inside"] / tau[1]
  term2b <- 2 * r2 * C1 * x23[in_out == "outside"] / tau[1]
  term2 <- c(term2a, term2b)
  term3 <- b * Qsp1
  return((term1 + term2) / dplus + term3)
}