Merge branch 'feature_select_xvalues'

NAMESPACE

@@ -27,6 +27,7 @@ export(read_opus_univ)
 export(remove_outliers)
 export(resample_spc)
 export(select_ref_spc)
+export(select_spc_vars)
 export(slice_xvalues)
 export(split_df2l)
 export(summary_df)

R/select-spc.R

@@ -0,0 +1,45 @@
+#' Select every n-th spectral variable for all spectra and x-values in spectral
+#' tibble (`spc_tbl`)
+#'
+#' @param spc_tbl Tibble data.frame containing spectra in list-column
+#' @param lcol_spc List-column containing spectra, specified with column
+#' name as symbols or 1L character vector.
+#' @param lcol_xvalues List-column containing x-values, specified with
+#' column name as symbols or 1L character vector.
+#' @param every Every n-th spectral positions to keep as 1L integer vector.
+#'
+#' @return
+#' @export
+#'
+#' @examples
+select_spc_vars <- function(spc_tbl,
+                            lcol_spc = spc_pre,
+                            lcol_xvalues = xvalues_pre,
+                            every = NULL) {
+  lcol_spc <- rlang::enquo(lcol_spc)
+  lcol_spc_nm <- rlang::quo_name(lcol_spc)
+  lcol_xvalues <- rlang::enquo(lcol_xvalues)
+  lcol_xvalues_nm <- rlang::quo_name(lcol_xvalues)
+
+  stopifnot(tibble::is_tibble(spc_tbl))
+
+  if (is.null(every)) {return(spc_tbl);
+    message("Returning `spc_tbl` and keep all variables.")}
+
+  spc_lst <- dplyr::pull(spc_tbl, !!lcol_spc)
+  spc <- data.table::rbindlist(spc_lst)
+
+  pos_sel <- seq(1L, ncol(spc), every)
+
+  spc_sel <- spc[, ..pos_sel]
+
+  spc_lst_out <- stats::setNames(
+    map(purrr::transpose(spc_sel), data.table::as.data.table),
+      names(spc_lst))
+
+  xvalues <- dplyr::pull(spc_tbl, !!lcol_xvalues)
+  xvalues_sel <- map(xvalues, ~ .x[pos_sel])
+
+  dplyr::mutate(spc_tbl,
+    !!lcol_spc_nm := spc_lst_out, !!lcol_xvalues_nm := xvalues_sel)
+}

README.md

@@ -14,15 +14,16 @@ data and modeling workflow. Data inputs and outputs are stored in common S3 `R`
 4. `resample_spc()`: Resample spectra to new wavenumber intervals
 2. `average_spc()`: Average spectra for replicate scans
 5. `preprocess_spc()`: Perform pre-processing of spectra
-6. `join_chem_spc()`: Join chemical and spectral data sets by `sample_id`
-7. `plot_spc_ext()`: Extended spectral plotting; e.g. group spectra using different
+6. `select_spc_vars()`: Select every `n`-th spectral variable and corresponding x-units.
+7. `join_chem_spc()`: Join chemical and spectral data sets by `sample_id`
+8. `plot_spc_ext()`: Extended spectral plotting; e.g. group spectra using different
 panels or color spectra based on chemical reference values to explore trends.
-8. `fit_pls()`: Perform model tuning and evaluation based on Partial Least Squares (PLS) regression
-9. `select_ref_spc()`: Select a set of reference samples to measured by
+9. `fit_pls()`: Perform model tuning and evaluation based on Partial Least Squares (PLS) regression
+10. `select_ref_spc()`: Select a set of reference samples to measured by
 traditional analysis methods when no a priori sample data except spectra are 
 available (based on Kennard-Stones sampling)
-10. `predict_from_spc()`: Predict multiple chemical properties from a list of calibrated models and new soil spectra
-11. `assess_multimodels()`: Assess model performance given multiple pairs of predicted and measured variables.
+11. `predict_from_spc()`: Predict multiple chemical properties from a list of calibrated models and new soil spectra
+12. `assess_multimodels()`: Assess model performance given multiple pairs of predicted and measured variables.
 
 # Projects using simplerspec