added a spectral reconstruction function

Author: JZauner

NAMESPACE

@@ -60,6 +60,7 @@ export(pulses_above_threshold)
 export(sc2interval)
 export(sleep_int2Brown)
 export(solar_noon)
+export(spectral_reconstruction)
 export(supported_devices)
 export(symlog_trans)
 export(threshold_for_duration)

R/spectral_reconstruction.R

@@ -0,0 +1,111 @@
+#' Reconstruct spectral irradiance from sensor counts
+#'
+#' This function takes sensor data in the form of (normalized) counts and
+#' reconstructs a spectral power distribution (SPD) through a calibration matrix.
+#' The matrix takes the form of `sensor channel x wavelength`, and the spectrum
+#' results form a linear combination of `counts x calibration-value` for any
+#' wavelength in the matrix. Handles multiple sensor readings by returning a list of spectra
+#'
+#' Please note that calibration matrices are not provided by LightLogR, but can
+#' be provided by a wearable device manufacturer. Counts can be normalized with
+#' the [normalize_counts()] function, provided that the output also contains a
+#' `gain` column.
+#'
+#' @param sensor_channels Named numeric vector or dataframe with
+#'   sensor readings. Names must match calibration matrix columns.
+#' @param calibration_matrix Matrix or dataframe with sensor-named columns and
+#'   wavelength-indexed rows
+#' @param format Output format: "long" (list of tibbles) or "wide" (dataframe)
+#'
+#' @return 
+#' - "long": List of tibbles (wavelength, irradiance)
+#' - "wide": Dataframe with wavelength columns and one row per spectrum
+#'
+#' @export
+#'
+#' @examples
+#' # Calibration matrix example
+#' calib <- matrix(1:12, ncol=3, dimnames = list(400:403, c("R", "G", "B")))
+#'
+#' # Named vector input
+#' spectral_reconstruction(c(R=1, G=2, B=3), calib)
+#'
+#' # Dataframe input
+#' df <- data.frame(R=1, G=2, B=3, other_col=10)
+#' spectral_reconstruction(dplyr::select(df, R:B), calib)
+#' 
+#' # Multiple spectra: as list columns
+#' df <- data.frame(Measurement = c(1,2), R=c(1,2), G=c(2,4), B=c(3,6))
+#' df <- 
+#' df |> 
+#'   dplyr::mutate(
+#'       Spectrum = spectral_reconstruction(dplyr::pick(R:B), calib)
+#'       )
+#' df |> tidyr::unnest(Spectrum)
+#' 
+#' # Multiple spectra: as extended dataframes
+#' df |> 
+#'   dplyr::mutate(
+#'       Spectrum = spectral_reconstruction(dplyr::pick(R:B), calib, "wide"))
+
+spectral_reconstruction <- function(sensor_channels, 
+                                    calibration_matrix,
+                                    format = c("long", "wide")) {
+  format <- match.arg(format)
+  
+  # Convert calibration matrix to tibble
+  calibration_df <- tryCatch({
+    dplyr::as_tibble(
+      as.data.frame(calibration_matrix), 
+      rownames = "wavelength"
+    )
+  }, error = function(e) stop("Invalid calibration matrix format"))
+  
+  # Validate calibration structure
+  if (!"wavelength" %in% colnames(calibration_df)) {
+    stop("Calibration matrix must have wavelength row names")
+  }
+  cal_cols <- setdiff(colnames(calibration_df), "wavelength")
+  if (length(cal_cols) == 0) stop("Calibration matrix needs sensor columns")
+  
+  # Process sensor inputs
+  if (is.data.frame(sensor_channels)) {
+    sensor_data <- tryCatch(
+      dplyr::select(sensor_channels, dplyr::all_of(cal_cols)),
+      error = function(e) stop("Missing required sensor columns")
+    )
+    sensor_matrix <- as.matrix(sensor_data)
+  } else if (is.numeric(sensor_channels) && !is.null(names(sensor_channels))) {
+    if (!all(cal_cols %in% names(sensor_channels))) {
+      stop("Sensor names mismatch with calibration columns")
+    }
+    sensor_matrix <- matrix(
+      sensor_channels[cal_cols], 
+      nrow = 1,
+      dimnames = list(NULL, cal_cols)
+    )
+  } else {
+    stop("sensor_channels must be named vector or dataframe")
+  }
+  
+  # Matrix multiplication
+  calib_values <- as.matrix(calibration_df[, cal_cols])
+  irradiance_matrix <- calib_values %*% t(sensor_matrix)
+  
+  # Format output
+  wavelengths <- as.numeric(calibration_df$wavelength)
+  
+  if (format == "wide") {
+    wide_df <- as.data.frame(t(irradiance_matrix))
+    colnames(wide_df) <- wavelengths
+    return(wide_df)
+  } else {
+    result_list <- lapply(1:ncol(irradiance_matrix), function(i) {
+      dplyr::tibble(
+        wavelength = wavelengths,
+        irradiance = irradiance_matrix[, i]
+      )
+    })
+    if (ncol(irradiance_matrix) == 1) result_list[[1]] else result_list
+  }
+}

man/spectral_reconstruction.Rd

@@ -0,0 +1,104 @@
+# tests/testthat/test-spectral_reconstruction.R
+
+test_that("Valid inputs produce correct outputs", {
+  # Create 3-channel calibration matrix (R, G, B)
+  calib <- matrix(
+    c(0.1, 0.2, 0.3, 0.4, 0.5,
+      0.6, 0.7, 0.8, 0.9, 1.0,
+      1.1, 1.2, 1.3, 1.4, 1.5),
+    ncol = 3,
+    dimnames = list(400:404, c("R", "G", "B"))
+  )
+  
+  # Test named vector input
+  sensor_vec <- c(R = 1, G = 2, B = 3)
+  expect_silent(
+    result_vec <- spectral_reconstruction(sensor_vec, calib)
+  )
+  expected <- calib[,"R"]*1 + calib[,"G"]*2 + calib[,"B"]*3
+  expect_equal(result_vec$irradiance, as.numeric(expected))
+  
+  # Test dataframe input with tidyselect
+  df <- data.frame(R = 1, G = 2, B = 3, other = "x")
+  expect_silent(
+    result_df <- spectral_reconstruction(dplyr::select(df, R:B), calib)
+  )
+  expect_equal(result_df, result_vec)
+  
+  # Test wide format
+  wide_result <- spectral_reconstruction(df, calib, format = "wide")
+  expect_equal(nrow(wide_result), 1)
+  expect_equal(colnames(wide_result), as.character(400:404))
+  expect_equal(as.numeric(wide_result[1,]), as.numeric(expected))
+})
+
+test_that("Multi-row inputs return correct formats", {
+  # 4 wavelengths x 2 sensors calibration
+  calib <- matrix(
+    1:8, ncol = 2,
+    dimnames = list(400:403, c("S1", "S2"))
+  )
+  
+  multi_df <- data.frame(S1 = 1:3, S2 = 4:6)
+  
+  # Long format (list of tibbles)
+  long_result <- spectral_reconstruction(multi_df, calib)
+  expect_type(long_result, "list")
+  expect_length(long_result, 3)
+  
+  # Verify second spectrum calculation
+  expected_2 <- calib[,"S1"]*2 + calib[,"S2"]*5
+  expect_equal(long_result[[2]]$irradiance, as.numeric(expected_2))
+  
+  # Wide format (dataframe)
+  wide_result <- spectral_reconstruction(multi_df, calib, "wide")
+  expect_equal(nrow(wide_result), 3)
+  expect_equal(
+    as.numeric(wide_result[3,]),
+    as.numeric(calib[,"S1"]*3 + calib[,"S2"]*6)
+  )
+})
+
+test_that("Input validation works correctly", {
+  # Proper 3x3 calibration matrix
+  good_calib <- matrix(
+    1:9, ncol = 3, 
+    dimnames = list(400:402, c("R", "G", "B"))
+  )
+  
+  # Test calibration matrix without column names
+  bad_calib <- matrix(1:6, ncol = 2, dimnames = list(NULL, NULL))
+  expect_error(
+    spectral_reconstruction(c(R=1), bad_calib),
+    "Sensor names mismatch with calibration columns",
+    fixed = TRUE
+  )
+  
+  # Test calibration matrix with wrong column names
+  misnamed_calib <- matrix(1:6, ncol = 2, dimnames = list(NULL, c("X", "Y")))
+  expect_error(
+    spectral_reconstruction(c(R=1), misnamed_calib),
+    "Sensor names mismatch with calibration columns",
+    fixed = TRUE
+  )
+})
+
+
+test_that("Edge cases are handled properly", {
+  # Single wavelength calibration
+  calib_single <- matrix(
+    1:3, ncol = 3, nrow = 1,
+    dimnames = list(400, c("R", "G", "B"))
+  )
+  expect_silent(
+    spectral_reconstruction(c(R=1, G=2, B=3), calib_single)
+  )
+  
+  # Zero values
+  calib_zero <- matrix(
+    0, ncol = 3, nrow = 3,
+    dimnames = list(400:402, c("R", "G", "B"))
+  )
+  result_zero <- spectral_reconstruction(c(R=1, G=2, B=3), calib_zero)
+  expect_equal(result_zero$irradiance, rep(0,3))
+})