diff --git a/.lintr b/.lintr index 3647f7c..feea4e1 100644 --- a/.lintr +++ b/.lintr @@ -1,11 +1,10 @@ linters: linters_with_defaults( - # lintr defaults: https://github.com/jimhester/lintr#available-linters + # lintr defaults: https://lintr.r-lib.org/reference/default_linters.html # the following setup changes/removes certain linters assignment_linter = NULL, # do not force using <- for assignments object_name_linter = object_name_linter(c("snake_case", "CamelCase")), # only allow snake case and camel case object names cyclocomp_linter = NULL, # do not check function complexity commented_code_linter = NULL, # allow code in comments - todo_comment_linter = NULL, # allow todo in comments - line_length_linter = line_length_linter(120), - object_length_linter = object_length_linter(40) + line_length_linter = line_length_linter(120L), + object_length_linter = object_length_linter(40L) ) diff --git a/DESCRIPTION b/DESCRIPTION index 50be2fa..bab9d5c 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -39,6 +39,7 @@ Collate: 'PipeOpFDAFlatten.R' 'PipeOpFDAInterpol.R' 'PipeOpFDASmooth.R' + 'PipeOpFPCA.R' 'TaskClassif_phoneme.R' 'TaskRegr_dti.R' 'TaskRegr_fuel.R' diff --git a/NAMESPACE b/NAMESPACE index 267a24d..9c6c9e1 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -6,6 +6,7 @@ export(PipeOpFDAExtract) export(PipeOpFDAFlatten) export(PipeOpFDAInterpol) export(PipeOpFDASmooth) +export(PipeOpFPCA) import(R6) import(checkmate) import(data.table) diff --git a/R/PipeOpFDAExtract.R b/R/PipeOpFDAExtract.R index 20c2f41..acc0b0d 100644 --- a/R/PipeOpFDAExtract.R +++ b/R/PipeOpFDAExtract.R @@ -36,6 +36,7 @@ #' @export #' @examples #' library(mlr3pipelines) +#' #' task = tsk("fuel") #' po_fmean = po("fda.extract", features = "mean") #' task_fmean = po_fmean$train(list(task))[[1L]] @@ -57,6 +58,7 @@ PipeOpFDAExtract = R6Class("PipeOpFDAExtract", #' Identifier of resulting object, default is `"fda.extract"`. #' @param param_vals (named `list`)\cr #' List of hyperparameter settings, overwriting the hyperparameter settings that would + #' otherwise be set during construction. Default `list()`. initialize = function(id = "fda.extract", param_vals = list()) { param_set = ps( drop = p_lgl(tags = c("train", "predict", "required")), @@ -156,14 +158,7 @@ PipeOpFDAExtract = R6Class("PipeOpFDAExtract", }) fextractor = make_fextractor(features) - features = map( - cols, - function(col) { - x = dt[[col]] - invoke(fextractor, x = x, left = left, right = right) - } - ) - + features = map(cols, function(col) invoke(fextractor, x = dt[[col]], left = left, right = right)) features = unlist(features, recursive = FALSE) features = set_names(features, feature_names) features = as.data.table(features) @@ -188,9 +183,7 @@ make_fextractor = function(features) { upper = interval[[2L]] if (is.na(lower) || is.na(upper)) { - res = map(features, function(f) { - rep(NA_real_, length(x)) # no observation in the given interval [left, right] - }) + res = map(features, function(f) rep(NA_real_, length(x))) # no observation in the given interval [left, right] return(res) } @@ -198,9 +191,7 @@ make_fextractor = function(features) { arg = args[lower:upper] res = map(seq_along(x), function(i) { value = values[[i]] - map(features, function(f) { - f(arg = arg, value = value[lower:upper]) - }) + map(features, function(f) f(arg = arg, value = value[lower:upper])) }) return(transform_list(res)) } @@ -217,9 +208,7 @@ make_fextractor = function(features) { if (is.na(lower) || is.na(upper)) { rep(NA_real_, length(features)) # no observation in the given interval [left, right] } else { - map(features, function(f) { - f(arg = arg[lower:upper], value = value[lower:upper]) - }) + map(features, function(f) f(arg = arg[lower:upper], value = value[lower:upper])) } }) transform_list(res) diff --git a/R/PipeOpFDAFlatten.R b/R/PipeOpFDAFlatten.R index 0b94961..fe8719a 100644 --- a/R/PipeOpFDAFlatten.R +++ b/R/PipeOpFDAFlatten.R @@ -19,6 +19,7 @@ #' @export #' @examples #' library(mlr3pipelines) +#' #' task = tsk("fuel") #' pop = po("fda.flatten") #' task_flat = pop$train(list(task)) diff --git a/R/PipeOpFDAInterpol.R b/R/PipeOpFDAInterpol.R index 83edd61..2fcb49f 100644 --- a/R/PipeOpFDAInterpol.R +++ b/R/PipeOpFDAInterpol.R @@ -42,9 +42,10 @@ #' @export #' @examples #' library(mlr3pipelines) +#' #' task = tsk("fuel") #' pop = po("fda.interpol") -#' task_interpol = pop$train(list(task))[[1]] +#' task_interpol = pop$train(list(task))[[1L]] #' task_interpol$data() PipeOpFDAInterpol = R6Class("PipeOpFDAInterpol", inherit = mlr3pipelines::PipeOpTaskPreprocSimple, diff --git a/R/PipeOpFDASmooth.R b/R/PipeOpFDASmooth.R index 400cae2..98b73f1 100644 --- a/R/PipeOpFDASmooth.R +++ b/R/PipeOpFDASmooth.R @@ -27,6 +27,7 @@ #' @export #' @examples #' library(mlr3pipelines) +#' #' task = tsk("fuel") #' po_smooth = po("fda.smooth", method = "rollmean", args = list(k = 5)) #' task_smooth = po_smooth$train(list(task))[[1L]] diff --git a/R/PipeOpFPCA.R b/R/PipeOpFPCA.R new file mode 100644 index 0000000..6b0263a --- /dev/null +++ b/R/PipeOpFPCA.R @@ -0,0 +1,91 @@ +#' @title Functional Principal Component Analysis +#' @name mlr_pipeops_fda.fpca +#' +#' @description +#' This `PipeOp` applies a functional principal component analysis (FPCA) to functional columns and then +#' extracts the principal components as features. This is done using a (truncated) weighted SVD. +#' +#' To apply this `PipeOp` to irregualr data, convert it to a regular grid first using [`PipeOpFDAInterpol`]. +#' +#' For more details, see [`tfb_fpc()`][tf::tfb_fpc], which is called internally. +#' +#' +#' @section Parameters: +#' The parameters are the parameters inherited from [`PipeOpTaskPreproc`], as well as the following parameters: +#' * `pve` :: `numeric(1)` \cr +#' The percentage of variance explained that should be retained. Default is `0.995`. +#' * `n_components` :: `integer(1)` \cr +#' The number of principal components to extract. This parameter is initialized to `Inf`. +#' +#' @section Naming: +#' The new names generally append a `_pc_{number}` to the corresponding column name. +#' If a column was called `"x"` and the there are three principcal components, the corresponding +#' new columns will be called `"x_pc_1", "x_pc_2", "x_pc_3"`. +#' +#' @export +#' @examples +#' library(mlr3pipelines) +#' +#' task = tsk("fuel") +#' po_fpca = po("fda.fpca") +#' task_fpca = po_fpca$train(list(task))[[1L]] +#' task_fpca$data() +PipeOpFPCA = R6Class("PipeOpFPCA", + inherit = mlr3pipelines::PipeOpTaskPreproc, + public = list( + #' @description Initializes a new instance of this Class. + #' @param id (`character(1)`)\cr + #' Identifier of resulting object, default is `"fda.fpca"`. + #' @param param_vals (named `list`)\cr + #' List of hyperparameter settings, overwriting the hyperparameter settings that would + #' otherwise be set during construction. Default `list()`. + initialize = function(id = "fda.fpca", param_vals = list()) { + param_set = ps( + pve = p_dbl(default = 0.995, lower = 0, upper = 1, tags = "train"), + n_components = p_int(1L, special_vals = list(Inf), tags = c("train", "required")) + ) + param_set$set_values(n_components = Inf) + + super$initialize( + id = id, + param_set = param_set, + param_vals = param_vals, + packages = c("mlr3fda", "mlr3pipelines", "tf"), + feature_types = "tfd_reg", + tags = "fda" + ) + } + ), + private = list( + .train_dt = function(dt, levels, target) { + pars = self$param_set$get_values(tags = "train") + + dt = map_dtc(dt, function(x, nm) invoke(tf::tfb_fpc, data = x, .args = remove_named(pars, "n_components"))) + self$state = list(fpc = dt) + + dt = imap_dtc(dt, function(col, nm) { + map(col, function(x) { + pc = as.list(x[2:min(pars$n_components + 1L, length(x))]) + set_names(pc, sprintf("%s_pc_%d", nm, seq_along(pc))) + }) + }) + unnest(dt, colnames(dt)) + }, + + .predict_dt = function(dt, levels) { + pars = self$param_set$get_values() + + dt = imap_dtc(dt, function(col, nm) { + fpc = tf::tf_rebase(col, self$state$fpc[[nm]], arg = tf::tf_arg(col)) + map(fpc, function(x) { + pc = as.list(x[2:min(pars$n_components + 1L, length(x))]) + set_names(pc, sprintf("%s_pc_%d", nm, seq_along(pc))) + }) + }) + unnest(dt, colnames(dt)) + } + ) +) + +#' @include zzz.R +register_po("fda.fpca", PipeOpFPCA) diff --git a/R/TaskRegr_dti.R b/R/TaskRegr_dti.R index 9a6cf91..8a1fe48 100644 --- a/R/TaskRegr_dti.R +++ b/R/TaskRegr_dti.R @@ -36,7 +36,7 @@ load_task_dti = function(id = "dti") { rcst = tf::tfd(dti$rcst, arg = seq(0L, 1L, length.out = 55L)), sex = dti$sex ) - dti = na.omit(dti) + dti = stats::na.omit(dti) b = as_data_backend(dti) task = TaskRegr$new( diff --git a/README.Rmd b/README.Rmd index 238206f..1a6891b 100644 --- a/README.Rmd +++ b/README.Rmd @@ -25,7 +25,6 @@ Package Website: [dev](https://mlr3fda.mlr-org.com/) Extending mlr3 to functional data. -[![Lifecycle: experimental](https://img.shields.io/badge/lifecycle-experimental-orange.svg)](https://lifecycle.r-lib.org/articles/stages.html#experimental) [![RCMD Check](https://github.com/mlr-org/mlr3fda/actions/workflows/rcmdcheck.yaml/badge.svg)](https://github.com/mlr-org/mlr3fda/actions/workflows/rcmdcheck.yaml) [![CRAN status](https://www.r-pkg.org/badges/version/mlr3fda)](https://CRAN.R-project.org/package=mlr3fda) [![StackOverflow](https://img.shields.io/badge/stackoverflow-mlr3-orange.svg)](https://stackoverflow.com/questions/tagged/mlr3) diff --git a/README.md b/README.md index 4352aa3..5550338 100644 --- a/README.md +++ b/README.md @@ -7,8 +7,6 @@ Extending mlr3 to functional data. -[![Lifecycle: -experimental](https://img.shields.io/badge/lifecycle-experimental-orange.svg)](https://lifecycle.r-lib.org/articles/stages.html#experimental) [![RCMD Check](https://github.com/mlr-org/mlr3fda/actions/workflows/rcmdcheck.yaml/badge.svg)](https://github.com/mlr-org/mlr3fda/actions/workflows/rcmdcheck.yaml) [![CRAN @@ -127,6 +125,7 @@ glrn$predict(task, row_ids = ids$test) |:-------------------------------------------------------------------------------|:-------------------------------------------------|:---------------------------------------------------|:--------------------| | [fda.extract](https://mlr3fda.mlr-org.com/reference/mlr_pipeops_fda.extract) | Extracts Simple Features from Functional Columns | [tf](https://cran.r-project.org/package=tf) | fda, data transform | | [fda.flatten](https://mlr3fda.mlr-org.com/reference/mlr_pipeops_fda.flatten) | Flattens Functional Columns | [tf](https://cran.r-project.org/package=tf) | fda, data transform | +| [fda.fpca](https://mlr3fda.mlr-org.com/reference/mlr_pipeops_fda.fpca) | Functional Principal Component Analysis | [tf](https://cran.r-project.org/package=tf) | fda, data transform | | [fda.interpol](https://mlr3fda.mlr-org.com/reference/mlr_pipeops_fda.interpol) | Interpolate Functional Columns | [tf](https://cran.r-project.org/package=tf) | fda, data transform | | [fda.smooth](https://mlr3fda.mlr-org.com/reference/mlr_pipeops_fda.smooth) | Smoothing Functional Columns | [tf](https://cran.r-project.org/package=tf), stats | fda, data transform | diff --git a/man/mlr_pipeops_fda.extract.Rd b/man/mlr_pipeops_fda.extract.Rd index bb38901..33192ae 100644 --- a/man/mlr_pipeops_fda.extract.Rd +++ b/man/mlr_pipeops_fda.extract.Rd @@ -43,6 +43,7 @@ a warning is given. \examples{ library(mlr3pipelines) + task = tsk("fuel") po_fmean = po("fda.extract", features = "mean") task_fmean = po_fmean$train(list(task))[[1L]] @@ -93,7 +94,8 @@ Initializes a new instance of this Class. Identifier of resulting object, default is \code{"fda.extract"}.} \item{\code{param_vals}}{(named \code{list})\cr -List of hyperparameter settings, overwriting the hyperparameter settings that would} +List of hyperparameter settings, overwriting the hyperparameter settings that would +otherwise be set during construction. Default \code{list()}.} } \if{html}{\out{}} } diff --git a/man/mlr_pipeops_fda.flatten.Rd b/man/mlr_pipeops_fda.flatten.Rd index 6f845cf..a49f9c6 100644 --- a/man/mlr_pipeops_fda.flatten.Rd +++ b/man/mlr_pipeops_fda.flatten.Rd @@ -25,6 +25,7 @@ a warning is given. \examples{ library(mlr3pipelines) + task = tsk("fuel") pop = po("fda.flatten") task_flat = pop$train(list(task)) diff --git a/man/mlr_pipeops_fda.fpca.Rd b/man/mlr_pipeops_fda.fpca.Rd new file mode 100644 index 0000000..bf760bd --- /dev/null +++ b/man/mlr_pipeops_fda.fpca.Rd @@ -0,0 +1,100 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/PipeOpFPCA.R +\name{mlr_pipeops_fda.fpca} +\alias{mlr_pipeops_fda.fpca} +\alias{PipeOpFPCA} +\title{Functional Principal Component Analysis} +\description{ +This \code{PipeOp} applies a functional principal component analysis (FPCA) to functional columns and then +extracts the principal components as features. This is done using a (truncated) weighted SVD. + +To apply this \code{PipeOp} to irregualr data, convert it to a regular grid first using \code{\link{PipeOpFDAInterpol}}. + +For more details, see \code{\link[tf:tfb_fpc]{tfb_fpc()}}, which is called internally. +} +\section{Parameters}{ + +The parameters are the parameters inherited from \code{\link{PipeOpTaskPreproc}}, as well as the following parameters: +\itemize{ +\item \code{pve} :: \code{numeric(1)} \cr +The percentage of variance explained that should be retained. Default is \code{0.995}. +\item \code{n_components} :: \code{integer(1)} \cr +The number of principal components to extract. This parameter is initialized to \code{Inf}. +} +} + +\section{Naming}{ + +The new names generally append a \verb{_pc_\{number\}} to the corresponding column name. +If a column was called \code{"x"} and the there are three principcal components, the corresponding +new columns will be called \verb{"x_pc_1", "x_pc_2", "x_pc_3"}. +} + +\examples{ +library(mlr3pipelines) + +task = tsk("fuel") +po_fpca = po("fda.fpca") +task_fpca = po_fpca$train(list(task))[[1L]] +task_fpca$data() +} +\section{Super classes}{ +\code{\link[mlr3pipelines:PipeOp]{mlr3pipelines::PipeOp}} -> \code{\link[mlr3pipelines:PipeOpTaskPreproc]{mlr3pipelines::PipeOpTaskPreproc}} -> \code{PipeOpFPCA} +} +\section{Methods}{ +\subsection{Public methods}{ +\itemize{ +\item \href{#method-PipeOpFPCA-new}{\code{PipeOpFPCA$new()}} +\item \href{#method-PipeOpFPCA-clone}{\code{PipeOpFPCA$clone()}} +} +} +\if{html}{\out{ +
Inherited methods + +
+}} +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-PipeOpFPCA-new}{}}} +\subsection{Method \code{new()}}{ +Initializes a new instance of this Class. +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{PipeOpFPCA$new(id = "fda.fpca", param_vals = list())}\if{html}{\out{
}} +} + +\subsection{Arguments}{ +\if{html}{\out{
}} +\describe{ +\item{\code{id}}{(\code{character(1)})\cr +Identifier of resulting object, default is \code{"fda.fpca"}.} + +\item{\code{param_vals}}{(named \code{list})\cr +List of hyperparameter settings, overwriting the hyperparameter settings that would +otherwise be set during construction. Default \code{list()}.} +} +\if{html}{\out{
}} +} +} +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-PipeOpFPCA-clone}{}}} +\subsection{Method \code{clone()}}{ +The objects of this class are cloneable with this method. +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{PipeOpFPCA$clone(deep = FALSE)}\if{html}{\out{
}} +} + +\subsection{Arguments}{ +\if{html}{\out{
}} +\describe{ +\item{\code{deep}}{Whether to make a deep clone.} +} +\if{html}{\out{
}} +} +} +} diff --git a/man/mlr_pipeops_fda.interpol.Rd b/man/mlr_pipeops_fda.interpol.Rd index 473b4e8..84ef683 100644 --- a/man/mlr_pipeops_fda.interpol.Rd +++ b/man/mlr_pipeops_fda.interpol.Rd @@ -52,9 +52,10 @@ The right boundary of the window. \examples{ library(mlr3pipelines) + task = tsk("fuel") pop = po("fda.interpol") -task_interpol = pop$train(list(task))[[1]] +task_interpol = pop$train(list(task))[[1L]] task_interpol$data() } \section{Super classes}{ diff --git a/man/mlr_pipeops_fda.smooth.Rd b/man/mlr_pipeops_fda.smooth.Rd index 658838d..922843b 100644 --- a/man/mlr_pipeops_fda.smooth.Rd +++ b/man/mlr_pipeops_fda.smooth.Rd @@ -35,6 +35,7 @@ Is initialized to \code{FALSE}. \examples{ library(mlr3pipelines) + task = tsk("fuel") po_smooth = po("fda.smooth", method = "rollmean", args = list(k = 5)) task_smooth = po_smooth$train(list(task))[[1L]] diff --git a/tests/testthat/test_PipeOpFDAExtract.R b/tests/testthat/test_PipeOpFDAExtract.R index cd225ff..14e83f4 100644 --- a/tests/testthat/test_PipeOpFDAExtract.R +++ b/tests/testthat/test_PipeOpFDAExtract.R @@ -1,14 +1,20 @@ +test_that("PipeOpFDAExtract - basic properties", { + pop = po("fda.extract") + expect_pipeop(pop) + expect_equal(pop$id, "fda.extract") +}) + test_that("PipeOpFDAExtract works", { # tf_reg works - dat = data.table( + dt = data.table( id = c("Ann", "Ann", "Ann", "Bob", "Bob", "Bob"), arg = rep(1:3, 2L), value = 1:6 ) - f = tf::tfd(dat, id = "id", arg = "arg", value = "value") + f = tf::tfd(dt, id = "id", arg = "arg", value = "value") y = 1:2 - dat = data.table(f = f, y = y) - task = as_task_regr(dat, target = "y") + dt = data.table(f = f, y = y) + task = as_task_regr(dt, target = "y") po_fmean = po("fda.extract", features = "mean", drop = TRUE) task_fmean = po_fmean$train(list(task))[[1L]] @@ -49,15 +55,15 @@ test_that("PipeOpFDAExtract works", { expect_equal(task_pop$data(), expected) # tf_irreg works - dat = data.table( + dt = data.table( id = c("Ann", "Ann", "Ann", "Bob", "Bob"), arg = c(1, 7, 2, 3, 5), value = c(1, 2, 3, 4, 5) ) - f = tf::tfd(dat, id = "id", arg = "arg", value = "value") + f = tf::tfd(dt, id = "id", arg = "arg", value = "value") y = c(1, 2) - dat = data.table(f = f, y = y) - task = as_task_regr(dat, target = "y") + dt = data.table(f = f, y = y) + task = as_task_regr(dt, target = "y") po_fmean = po("fda.extract", features = list("mean", "median", custom = custom), drop = TRUE) task_fmean = po_fmean$train(list(task))[[1L]] @@ -117,16 +123,16 @@ test_that("PipeOpFDAExtract input validation works", { }) test_that("PipeOpFDAExtract works with name clashes", { - dat = data.table( + dt = data.table( id = c("Ann", "Ann", "Ann", "Bob", "Bob"), arg = c(1, 7, 2, 3, 5), value = c(1, 2, 3, 4, 5) ) - f = tf::tfd(dat, id = "id", arg = "arg", value = "value") + f = tf::tfd(dt, id = "id", arg = "arg", value = "value") y = c(1, 2) - dat = data.table(f = f, y = y) - dat$f_mean = c(-1, -1) - task = as_task_regr(dat, target = "y") + dt = data.table(f = f, y = y) + dt$f_mean = c(-1, -1) + task = as_task_regr(dt, target = "y") pop = po("fda.extract", features = list("mean"), drop = FALSE) taskout = pop$train(pop$train(list(task)))[[1L]] expect_permutation(taskout$feature_names, c("f", "f_mean", "f_mean_1", "f_mean_2")) diff --git a/tests/testthat/test_PipeOpFDAFlatten.R b/tests/testthat/test_PipeOpFDAFlatten.R index e51a2c8..c43e591 100644 --- a/tests/testthat/test_PipeOpFDAFlatten.R +++ b/tests/testthat/test_PipeOpFDAFlatten.R @@ -1,3 +1,9 @@ +test_that("PipeOpFDAFlatten - basic properties", { + pop = po("fda.flatten") + expect_pipeop(pop) + expect_equal(pop$id, "fda.flatten") +}) + test_that("PipeOpFDAFlatten works", { task = tsk("fuel") pop = po("fda.flatten") diff --git a/tests/testthat/test_PipeOpFDAInterpolate.R b/tests/testthat/test_PipeOpFDAInterpolate.R index da94732..bd7c669 100644 --- a/tests/testthat/test_PipeOpFDAInterpolate.R +++ b/tests/testthat/test_PipeOpFDAInterpolate.R @@ -1,3 +1,9 @@ +test_that("PipeOpFDAInterpol - basic properties", { + pop = po("fda.interpol") + expect_pipeop(pop) + expect_equal(pop$id, "fda.interpol") +}) + test_that("PipeOpFDAInterpol input validation works", { expect_error(po("fda.interpol", grid = c("union", "intersect"))) expect_error(po("fda.interpol", grid = "unionh")) diff --git a/tests/testthat/test_PipeOpFPCA.R b/tests/testthat/test_PipeOpFPCA.R new file mode 100644 index 0000000..daca086 --- /dev/null +++ b/tests/testthat/test_PipeOpFPCA.R @@ -0,0 +1,86 @@ +test_that("PipeOpFPCA - basic properties", { + pop = po("fda.fpca") + expect_pipeop(pop) + expect_equal(pop$id, "fda.fpca") +}) + +test_that("PipeOpPCA works", { + set.seed(1234L) + # single col works + dt = data.table( + id = c("Ann", "Ann", "Ann", "Bob", "Bob", "Bob"), + arg = rep(1:3, 2L), + value = 1:6 + ) + f = tf::tfd(dt, id = "id", arg = "arg", value = "value") + y = c(1, 2) + dt = data.table(f = f, y = y) + task = as_task_regr(dt, target = "y") + + pop = po("fda.fpca") + task_fpc = pop$train(list(task))[[1L]] + expect_equal(nrow(task_fpc$data()), 2L) + expect_equal(ncol(task_fpc$data()), 2L) + expect_named(task_fpc$data(), c("y", "f_pc_1")) + fpc = task_fpc$data()$f_pc_1 + expect_equal(fpc, c(-2.12132030, 2.12132000), tolerance = 1e-6) + + # n_components works + dt = data.table(y = rnorm(15L), f = tf::tf_rgp(15L)) + task = as_task_regr(dt, target = "y") + pop = po("fda.fpca", n_components = 2L) + task_fpc = pop$train(list(task))[[1L]] + expect_equal(ncol(task_fpc$data()), 3L) + expect_equal(nrow(task_fpc$data()), 15L) + expect_named(task_fpc$data(), c("y", "f_pc_1", "f_pc_2")) + + # multiple cols work + dt = data.table( + id = rep(1:10, each = 3L), + arg = rep(1:3, 10L), + value = 1:10 + rnorm(1L) + ) + f = tf::tfd(dt, id = "id", arg = "arg", value = "value") + dt = data.table(y = rnorm(10L), f = f, g = f, h = f) + task = as_task_regr(dt, target = "y") + pop = po("fda.fpca") + task_fpc = pop$train(list(task))[[1L]] + expect_equal(ncol(task_fpc$data()), 10L) + expect_equal(nrow(task_fpc$data()), 10L) + nms = c( + "y", "f_pc_1", "f_pc_2", "f_pc_3", + "g_pc_1", "g_pc_2", "g_pc_3", + "h_pc_1", "h_pc_2", "h_pc_3" + ) + expect_named(task_fpc$data(), nms) + + # n_components works + pop = po("fda.fpca", n_components = 2L) + task_fpc = pop$train(list(task))[[1L]] + expect_equal(ncol(task_fpc$data()), 7L) + expect_equal(nrow(task_fpc$data()), 10L) + nms = c( + "y", "f_pc_1", "f_pc_2", + "g_pc_1", "g_pc_2", + "h_pc_1", "h_pc_2" + ) + expect_named(task_fpc$data(), nms) + + # affect_columns works + pop = po("fda.fpca", affect_columns = selector_name("f")) + task_fpc = pop$train(list(task))[[1L]] + expect_set_equal(task_fpc$feature_names, c("f_pc_1", "f_pc_2", "f_pc_3", "g", "h")) + + # does not touch irreg + dt = data.table( + id = c("Ann", "Ann", "Ann", "Bob", "Bob"), + arg = c(1L, 7L, 2L, 3L, 5L), + value = 1:5 + ) + f = tf::tfd(dt, id = "id", arg = "arg", value = "value") + y = 1:2 + dt = data.table(f = f, y = y) + task = as_task_regr(dt, target = "y") + task_fpca = pop$train(list(task))[[1L]] + expect_set_equal(task$feature_names, task_fpca$feature_names) +}) diff --git a/tests/testthat/test_tf.R b/tests/testthat/test_tf.R index 5f77e45..b7ff85f 100644 --- a/tests/testthat/test_tf.R +++ b/tests/testthat/test_tf.R @@ -5,7 +5,7 @@ test_that("tf does not support NAs", { # https://github.com/tidyfun/tf/issues/33 # Currently, NA functions are dropped d = data.frame(time = 1, value = NA_real_, id = "1") - x = invisible(tfd(d, arg = "time", value = "value", id = "id")) + x = invisible(tf::tfd(d, arg = "time", value = "value", id = "id")) expect_true(length(x) == 0) })