New function `select_spc_vars()`

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

man/select_spc_vars.Rd

@@ -0,0 +1,17 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/select-spc.R
+\name{select_spc_vars}
+\alias{select_spc_vars}
+\title{Select every n-th spectral variable for all spectra and x-values in spectral
+tibble (`spc_tbl`)}
+\usage{
+select_spc_vars(spc_tbl, lcol_spc = spc_pre,
+  lcol_xvalues = xvalues_pre, every = NULL)
+}
+\arguments{
+\item{every}{}
+}
+\description{
+Select every n-th spectral variable for all spectra and x-values in spectral
+tibble (`spc_tbl`)
+}