From 806bb766b6f134b6bfbf31829ad9f250d2d78bb0 Mon Sep 17 00:00:00 2001 From: "Yuhang (Tom) Lin" Date: Mon, 18 Mar 2024 16:56:53 -0500 Subject: [PATCH] Add fn_align_plot --- CITATION.cff | 24 +++++++++++++++++++++++- DESCRIPTION | 3 ++- NAMESPACE | 1 + R/x3p_shift.R | 13 +++++++++++++ README.md | 4 +++- man/x3p_shift.Rd | 1 + tests/testthat/test-x3p_shift.R | 3 +++ 7 files changed, 46 insertions(+), 3 deletions(-) diff --git a/CITATION.cff b/CITATION.cff index b2b7ad3..84b633c 100644 --- a/CITATION.cff +++ b/CITATION.cff @@ -59,7 +59,7 @@ references: title: spelling abstract: 'spelling: Tools for Spell Checking in R' notes: Suggests - url: https://docs.ropensci.org/spelling/ + url: https://ropensci.r-universe.dev/spelling repository: https://CRAN.R-project.org/package=spelling authors: - family-names: Ooms @@ -251,6 +251,9 @@ references: - family-names: Dunnington given-names: Dewey orcid: https://orcid.org/0000-0002-9415-4582 + - family-names: van den Brand + given-names: Teun + orcid: https://orcid.org/0000-0002-9335-7468 year: '2024' - type: software title: imager @@ -445,6 +448,25 @@ references: email: jenny@posit.co orcid: https://orcid.org/0000-0002-6983-2759 year: '2024' +- type: software + title: zoo + abstract: 'zoo: S3 Infrastructure for Regular and Irregular Time Series (Z''s Ordered + Observations)' + notes: Imports + url: https://zoo.R-Forge.R-project.org/ + repository: https://CRAN.R-project.org/package=zoo + authors: + - family-names: Zeileis + given-names: Achim + email: Achim.Zeileis@R-project.org + orcid: https://orcid.org/0000-0003-0918-3766 + - family-names: Grothendieck + given-names: Gabor + email: ggrothendieck@gmail.com + - family-names: Ryan + given-names: Jeffrey A. + email: jeff.a.ryan@gmail.com + year: '2024' - type: software title: 'R: A Language and Environment for Statistical Computing' notes: Depends diff --git a/DESCRIPTION b/DESCRIPTION index f786112..4774476 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -40,7 +40,8 @@ Imports: png, grDevices, graphics, - readr + readr, + zoo Remotes: heike/bulletxtrctr Depends: diff --git a/NAMESPACE b/NAMESPACE index fa9e9c6..e1b6695 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -68,3 +68,4 @@ importFrom(stringr,str_detect) importFrom(tidyr,nest) importFrom(tidyr,pivot_longer) importFrom(tidyr,unnest) +importFrom(zoo,na.trim) diff --git a/R/x3p_shift.R b/R/x3p_shift.R index 3f9b101..e502ff8 100644 --- a/R/x3p_shift.R +++ b/R/x3p_shift.R @@ -14,6 +14,7 @@ #' @importFrom purrr map_dbl map set_names #' @importFrom tidyr nest unnest #' @importFrom assertthat assert_that is.flag +#' @importFrom zoo na.trim #' @export #' @examples #' x3p <- x3p_subsamples[[2]] @@ -30,6 +31,7 @@ #' #' attr(x3p_approx, "x3p_before_shift_plot") #' attr(x3p_approx, "x3p_after_shift_plot") +#' attr(x3p_approx, "fn_align_plot") #' attr(x3p_approx, "MSE_plot") #' } #' @@ -49,6 +51,7 @@ x3p_shift <- function(x3p, ifplot = FALSE, delta = -5:5, x_shift_delta <- Dat <- value_approx <- + f <- NULL ggplot_attrs <- NA @@ -246,6 +249,16 @@ x3p_shift <- function(x3p, ifplot = FALSE, delta = -5:5, f1 <- x3p$surface.matrix[, yidx_mid] f2 <- x3p$surface.matrix[, yidx[j]] + attr(ggplot_attrs, "fn_align_plot") <- tibble(f1, f2) %>% + na.trim() %>% + mutate(x = 1:n()) %>% + pivot_longer(f1:f2, names_to = "f", names_prefix = "f") %>% + mutate(f = ifelse(f == "1", paste0(yidx_mid, " (ref)"), yidx[j])) %>% + ggplot(aes(x = x, y = value, color = f)) + + geom_line() + + scale_colour_brewer(palette = "Paired") + + theme_bw() + ### Mean squared error for all delta MSE <- map_dbl(delta, function(delta_i) { ### Too few non-missing values, cannot do anything diff --git a/README.md b/README.md index 6e4febe..31e2e5e 100644 --- a/README.md +++ b/README.md @@ -7,7 +7,7 @@ [![Lifecycle: experimental](https://img.shields.io/badge/lifecycle-experimental-orange.svg)](https://lifecycle.r-lib.org/articles/stages.html#experimental) -[![Last-changedate](https://img.shields.io/badge/last%20change-2024--03--02-yellowgreen.svg)](https://github.com/YuhangTom/wire/commits/main) +[![Last-changedate](https://img.shields.io/badge/last%20change-2024--03--18-yellowgreen.svg)](https://github.com/YuhangTom/wire/commits/main) [![CRAN status](https://www.r-pkg.org/badges/version/wire.png)](https://CRAN.R-project.org/package=wire) [![Codecov test @@ -168,6 +168,8 @@ attr(raw_sig_df, "sig_df_plot") ``` r shift_sig_df <- x3p_shift_sig_df(x3p_bin_rotate, ifplot = TRUE) +#> Error : Chromote: timed out waiting for event Page.loadEventFired +#> Error : Chromote: timed out waiting for event Page.loadEventFired attr(shift_sig_df, "x3p_before_shift_plot") ``` diff --git a/man/x3p_shift.Rd b/man/x3p_shift.Rd index c0ca266..3b1175d 100644 --- a/man/x3p_shift.Rd +++ b/man/x3p_shift.Rd @@ -36,6 +36,7 @@ if (interactive()) { attr(x3p_approx, "x3p_before_shift_plot") attr(x3p_approx, "x3p_after_shift_plot") + attr(x3p_approx, "fn_align_plot") attr(x3p_approx, "MSE_plot") } diff --git a/tests/testthat/test-x3p_shift.R b/tests/testthat/test-x3p_shift.R index 2b0df93..4eac154 100644 --- a/tests/testthat/test-x3p_shift.R +++ b/tests/testthat/test-x3p_shift.R @@ -45,6 +45,9 @@ test_that("output plot works", { expect_visible( attr(x3p_approx, "MSE_plot") ) + expect_visible( + attr(x3p_approx, "fn_align_plot") + ) })