diff --git a/DESCRIPTION b/DESCRIPTION index 8c9250c..39f91d7 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -79,7 +79,9 @@ Suggests: pak, rsconnect, knitr, - rmarkdown + rmarkdown, + testthat (>= 3.0.0) URL: https://github.com/agdamsbo/FreesearchR, https://agdamsbo.github.io/FreesearchR/ BugReports: https://github.com/agdamsbo/FreesearchR/issues VignetteBuilder: knitr +Config/testthat/edition: 3 diff --git a/NAMESPACE b/NAMESPACE index 681aa37..d1f911b 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -30,6 +30,8 @@ export(data_description) export(data_summary_server) export(data_summary_ui) export(data_type) +export(data_type_filter) +export(data_types) export(data_visuals_server) export(data_visuals_ui) export(default_format_arguments) diff --git a/R/cut-variable-dates.R b/R/cut-variable-dates.R index 1e83426..240d755 100644 --- a/R/cut-variable-dates.R +++ b/R/cut-variable-dates.R @@ -55,8 +55,10 @@ cut_var.hms <- function(x, breaks, ...) { #' readr::parse_datetime(c("1992-02-01 01:00:20", "1992-02-06 03:00:20", "1992-05-01 01:20:20", "1992-09-01 08:20:20", "1999-02-01 21:20:20", "1992-12-01 03:02:20")) |> cut_var(2) #' readr::parse_datetime(c("1992-02-01 01:00:20", "1992-02-06 03:00:20", "1992-05-01 01:20:20", "1992-09-01 08:20:20", "1999-02-01 21:20:20", "1992-12-01 03:02:20")) |> cut_var(breaks = "weekday") #' readr::parse_datetime(c("1992-02-01 01:00:20", "1992-02-06 03:00:20", "1992-05-01 01:20:20", "1992-09-01 08:20:20", "1999-02-01 21:20:20", "1992-12-01 03:02:20")) |> cut_var(breaks = "month_only") +#' readr::parse_datetime(c("1992-02-01 01:00:20", "1992-02-06 03:00:20", "1992-05-01 01:20:20", "1992-09-01 08:20:20", "1999-02-01 21:20:20", "1992-12-01 03:02:20")) |> cut_var(breaks=NULL,format = "%A-%H") cut_var.POSIXt <- function(x, breaks, right = FALSE, include.lowest = TRUE, start.on.monday = TRUE, ...) { breaks_o <- breaks + args <- list(...) # browser() if (is.numeric(breaks)) { breaks <- quantile( @@ -68,16 +70,23 @@ cut_var.POSIXt <- function(x, breaks, right = FALSE, include.lowest = TRUE, star ) } - if (identical(breaks, "weekday")) { - days <- c( - "Monday", "Tuesday", "Wednesday", "Thursday", "Friday", "Saturday", - "Sunday" - ) - if (!start.on.monday) { - days <- days[c(7, 1:6)] + if ("format" %in% names(args)){ + assertthat::assert_that(is.character(args$format)) + out <- forcats::as_factor(format(x,format=args$format)) + } else if (identical(breaks, "weekday")) { + ## This is + ds <- as.Date(1:7) |> + (\(.x){ + sort_by(format(.x,"%A"),as.numeric(format(.x,"%w"))) + })() + + if (start.on.monday) { + ds <- ds[c(7, 1:6)] } - out <- factor(weekdays(x), levels = days) |> forcats::fct_drop() + out <- factor(weekdays(x), levels = ds) |> forcats::fct_drop() } else if (identical(breaks, "month_only")) { + ## Simplest way to create a vector of all months in order + ## which will also follow the locale of the machine ms <- paste0("1970-", 1:12, "-01") |> as.Date() |> months() @@ -118,15 +127,19 @@ cut_var.POSIXct <- cut_var.POSIXt #' as.Date(c("1992-02-01 01:00:20", "1992-02-06 03:00:20", "1992-05-01 01:20:20", "1992-09-01 08:20:20", "1999-02-01 21:20:20", "1992-12-01 03:02:20")) |> cut_var(2) #' as.Date(c("1992-02-01 01:00:20", "1992-02-06 03:00:20", "1992-05-01 01:20:20", "1992-09-01 08:20:20", "1999-02-01 21:20:20", "1992-12-01 03:02:20")) |> cut_var(breaks = "weekday") cut_var.Date <- function(x, breaks, start.on.monday = TRUE, ...) { - if (identical(breaks, "weekday")) { - days <- c( - "Monday", "Tuesday", "Wednesday", "Thursday", "Friday", "Saturday", - "Sunday" - ) - if (!start.on.monday) { - days <- days[c(7, 1:6)] + if ("format" %in% names(args)){ + assertthat::assert_that(is.character(args$format)) + out <- forcats::as_factor(format(x,format=args$format)) + } else if (identical(breaks, "weekday")) { + ds <- as.Date(1:7) |> + (\(.x){ + sort_by(format(.x,"%A"),as.numeric(format(.x,"%w"))) + })() + + if (start.on.monday) { + ds <- ds[c(7, 1:6)] } - out <- factor(weekdays(x), levels = days) |> forcats::fct_drop() + out <- factor(weekdays(x), levels = ds) |> forcats::fct_drop() } else if (identical(breaks, "month_only")) { ms <- paste0("1970-", 1:12, "-01") |> as.Date() |> diff --git a/README.md b/README.md index 3e827c8..2ef78f1 100644 --- a/README.md +++ b/README.md @@ -15,6 +15,10 @@ the ***FreesearchR***-tool is online and accessible here: [link to the app freel Initiatives for funding continued development of the tool and surrounding initiatives is ongoing. +## Motivation + + + ## Install locally diff --git a/man/data_type.Rd b/man/data_type.Rd index af3716a..cf287f2 100644 --- a/man/data_type.Rd +++ b/man/data_type.Rd @@ -2,26 +2,31 @@ % Please edit documentation in R/regression_model.R \name{data_type} \alias{data_type} -\title{Data type assessment} +\title{Data type assessment.} \usage{ data_type(data) } \arguments{ -\item{data}{data} +\item{data}{vector or data.frame. if data frame, each column is evaluated.} } \value{ outcome type } \description{ -Data type assessment +These are more overall than the native typeof. This is used to assess a more +meaningful "clinical" data type. } \examples{ mtcars |> default_parsing() |> lapply(data_type) +mtcars |> + default_parsing() |> + data_type() c(1, 2) |> data_type() 1 |> data_type() c(rep(NA, 10)) |> data_type() sample(1:100, 50) |> data_type() factor(letters[1:20]) |> data_type() +as.Date(1:20) |> data_type() } diff --git a/man/data_type_filter.Rd b/man/data_type_filter.Rd new file mode 100644 index 0000000..4dab22b --- /dev/null +++ b/man/data_type_filter.Rd @@ -0,0 +1,25 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/helpers.R +\name{data_type_filter} +\alias{data_type_filter} +\title{Filter function to filter data set by variable type} +\usage{ +data_type_filter(data, type) +} +\arguments{ +\item{data}{data frame} + +\item{type}{vector of data types (recognised: data_types)} +} +\value{ +data.frame +} +\description{ +Filter function to filter data set by variable type +} +\examples{ +default_parsing(mtcars) |> data_type_filter(type=c("categorical","continuous")) |> attributes() +\dontrun{ +default_parsing(mtcars) |> data_type_filter(type=c("test","categorical","continuous")) +} +} diff --git a/man/data_types.Rd b/man/data_types.Rd new file mode 100644 index 0000000..b37a81b --- /dev/null +++ b/man/data_types.Rd @@ -0,0 +1,17 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/regression_model.R +\name{data_types} +\alias{data_types} +\title{Recognised data types from data_type} +\usage{ +data_types() +} +\value{ +vector +} +\description{ +Recognised data types from data_type +} +\examples{ +data_types() +} diff --git a/tests/testthat.R b/tests/testthat.R new file mode 100644 index 0000000..7fd7562 --- /dev/null +++ b/tests/testthat.R @@ -0,0 +1,12 @@ +# This file is part of the standard setup for testthat. +# It is recommended that you do not modify it. +# +# Where should you do additional test configuration? +# Learn more about the roles of various files in: +# * https://r-pkgs.org/testing-design.html#sec-tests-files-overview +# * https://testthat.r-lib.org/articles/special-files.html + +library(testthat) +library(FreesearchR) + +test_check("FreesearchR") diff --git a/tests/testthat/test-app_version.R b/tests/testthat/test-app_version.R new file mode 100644 index 0000000..935dd2b --- /dev/null +++ b/tests/testthat/test-app_version.R @@ -0,0 +1,4 @@ +test_that("Version is character string", { + expect_equal(length(app_version()), 1) + expect_true(is.character(app_version())) +}) diff --git a/tests/testthat/test-baseline_table.R b/tests/testthat/test-baseline_table.R new file mode 100644 index 0000000..7b392a9 --- /dev/null +++ b/tests/testthat/test-baseline_table.R @@ -0,0 +1,42 @@ +## With snapshots +## + +test_that("Creates correct table",{ + expect_snapshot(create_baseline(mtcars,by.var = "gear", add.p = "yes" == "yes",add.overall = TRUE, theme = "lancet")) +}) + +test_that("Creates table", { + tbl <- mtcars |> baseline_table(fun.args = list(by = "gear")) + + expect_equal(length(tbl), 5) + + expect_equal(NROW(tbl$table_body), 19) + + expect_equal(NCOL(tbl$table_body), 8) + + expect_equal(names(tbl), c("table_body", "table_styling", "call_list", "cards", "inputs")) +}) + +test_that("Creates table", { + tbl <- mtcars |> create_baseline(by.var = "gear", add.p = "yes" == "yes") + + expect_equal(length(tbl), 5) + + expect_equal(NROW(tbl$table_body), 19) + + expect_equal(NCOL(tbl$table_body), 13) + + expect_equal(names(tbl), c("table_body", "table_styling", "call_list", "cards", "inputs")) +}) + +test_that("Creates table", { + tbl <- mtcars |> create_baseline(by.var = "gear", add.p = "yes" == "yes") + + expect_equal(length(tbl), 5) + + expect_equal(NROW(tbl$table_body), 19) + + expect_equal(NCOL(tbl$table_body), 13) + + expect_equal(names(tbl), c("table_body", "table_styling", "call_list", "cards", "inputs")) +}) diff --git a/tests/testthat/test-custom_SelectInput.R b/tests/testthat/test-custom_SelectInput.R new file mode 100644 index 0000000..044a8ba --- /dev/null +++ b/tests/testthat/test-custom_SelectInput.R @@ -0,0 +1,3 @@ +test_that("Create columnSelectInput", { + expect_snapshot(columnSelectInput("x",label = "X",data = mtcars)) +})