mirror of
https://github.com/agdamsbo/stRoke.git
synced 2024-11-21 04:20:22 +01:00
migrated function tests with functions moved to agdamsbo/project.aid
This commit is contained in:
parent
7823d673bc
commit
34be1df31a
@ -4,8 +4,8 @@ Version: 24.10.1
|
||||
Authors@R:
|
||||
person("Andreas Gammelgaard", "Damsbo", , "agdamsbo@clin.au.dk", role = c("aut", "cre"),
|
||||
comment = c(ORCID = "0000-0002-7559-1154"))
|
||||
Description: This is an R-toolbox of custom functions for convenient data management
|
||||
and analysis in clinical health research and teaching.
|
||||
Description: A collection of tools for clinical trial data management and
|
||||
analysis in research and teaching.
|
||||
The package is mainly collected for personal use, but any use beyond that is encouraged.
|
||||
This package has migrated functions from 'agdamsbo/daDoctoR', and new functions has been added.
|
||||
Version follows months and year. See NEWS/Changelog for release notes.
|
||||
@ -34,7 +34,6 @@ Imports:
|
||||
calendar,
|
||||
dplyr,
|
||||
ggplot2,
|
||||
glue,
|
||||
grDevices,
|
||||
gtsummary,
|
||||
lubridate,
|
||||
|
||||
@ -11,7 +11,6 @@ export(cpr_check)
|
||||
export(cpr_dob)
|
||||
export(cpr_female)
|
||||
export(ds2dd)
|
||||
export(ds2ical)
|
||||
export(files_filter)
|
||||
export(generic_stroke)
|
||||
export(index_plot)
|
||||
|
||||
8
NEWS.md
8
NEWS.md
@ -2,13 +2,9 @@
|
||||
|
||||
### Functions:
|
||||
|
||||
* NEW: `ds2ical()` converts data set to ical format with easy glue string for summary and description. Export .ics file with `calendar::ic_write()`.
|
||||
* UPDATE: `pase_calc()` updated for uniform column naming in output as well as streamlining the function a bit.
|
||||
|
||||
* UPDATE: `pase_calc()` updated for uniform column naming in output as well as streamlining the function a bit.
|
||||
|
||||
* UPDATE: `add_padding()` updated to include option to add leading and/or tailing string with `lead` or `tail`.
|
||||
|
||||
* Moving: The following functions are moved to `agdamsbo/project.aid` to focus on (stroke) trial related functions: `str_extract()`.
|
||||
* Moving: The following functions are moved to `agdamsbo/project.aid` to focus on (stroke) trial related functions: `str_extract()`, `add_padding()`, `age_calc()`, `chunks_of_n()`, `contrast_text()`, `files_filter()`, `quantile_cut()`, `write_ical()`.
|
||||
|
||||
* NEW: `mfi_calc()` calculates domain scores from the MFI questionnaire. Takes data frame of 20 ordered as the questionnaire. Default is to reverse questions with reverse scoring.
|
||||
|
||||
|
||||
@ -1,4 +1,4 @@
|
||||
#' Add padding to string
|
||||
#' MOVED Add padding to string
|
||||
#'
|
||||
#' @param d vector of strings or numbers
|
||||
#' @param length final string length
|
||||
|
||||
@ -1,4 +1,4 @@
|
||||
#' Split to chunks of size n
|
||||
#' MOVED Split to chunks of size n
|
||||
#'
|
||||
#' @param d data. Can be vector or data frame.
|
||||
#' @param n number of chunks
|
||||
|
||||
@ -1,6 +1,4 @@
|
||||
|
||||
|
||||
#' @title Contrast Text Color
|
||||
#' MOVED Contrast Text Color
|
||||
#' @description Calculates the best contrast text color for a given
|
||||
#' background color.
|
||||
#' @param background A hex/named color value that represents the background.
|
||||
|
||||
66
R/ds2ical.R
66
R/ds2ical.R
@ -1,66 +0,0 @@
|
||||
utils::globalVariables(c("DTSTART"))
|
||||
#' Convert data set to ical file
|
||||
#'
|
||||
#' @param data data set
|
||||
#' @param start dplyr style event start datetime column name. Data or datetime
|
||||
#' object.
|
||||
#' @param end dplyr style event end datetime column name. Data or datetime
|
||||
#' object.
|
||||
#' @param location dplyr style event location column name
|
||||
#' @param summary.glue.string character string to pass to glue::glue() for event
|
||||
#' name (summary). Can take any column from data set.
|
||||
#' @param description.glue.string character string to pass to glue::glue() for
|
||||
#' event description. Can take any column from data set.
|
||||
#'
|
||||
#' @return tibble of class "ical"
|
||||
#' @export
|
||||
#'
|
||||
#' @examples
|
||||
#' df <- dplyr::tibble(
|
||||
#' start = c(Sys.time(), Sys.time() + lubridate::days(2)),
|
||||
#' id = c("1", 3), assessor = "A", location = "111", note = c(NA, "OBS")
|
||||
#' ) |>
|
||||
#' dplyr::mutate(end = start + lubridate::hours(2))
|
||||
#' df |> ds2ical()
|
||||
#' df |> ds2ical(summary.glue.string = "ID {id} [{assessor}] {note}")
|
||||
#' # Export .ics file: (not run)
|
||||
#' ical <- df |> ds2ical(start, end, location,
|
||||
#' description.glue.string = "{note}")
|
||||
#' # ical |> calendar::ic_write(file=here::here("calendar.ics"))
|
||||
ds2ical <- function(data,
|
||||
start = start,
|
||||
end = end,
|
||||
location = NULL,
|
||||
summary.glue.string = "ID {id} [{assessor}]",
|
||||
description.glue.string = NULL) {
|
||||
ds <- data |>
|
||||
dplyr::mutate(
|
||||
SUMMARY = glue::glue(summary.glue.string, .na = ""),
|
||||
DTSTART = {{ start }},
|
||||
DTEND = {{ end }},
|
||||
LOCATION = {{ location }}
|
||||
)
|
||||
|
||||
if (!is.null(description.glue.string)) {
|
||||
ds <- dplyr::mutate(ds,
|
||||
DESCRIPTION = glue::glue(
|
||||
description.glue.string,
|
||||
.na = ""
|
||||
)
|
||||
)
|
||||
}
|
||||
|
||||
ds |>
|
||||
dplyr::select(tidyselect::any_of(c("SUMMARY",
|
||||
"DTSTART",
|
||||
"DTEND",
|
||||
"LOCATION",
|
||||
"DESCRIPTION"))) |>
|
||||
(\(x){
|
||||
x |>
|
||||
dplyr::mutate(UID = replicate(nrow(x), calendar::ic_guid()))
|
||||
})() |>
|
||||
dplyr::filter(!is.na(DTSTART)) |>
|
||||
# dplyr::filter(dplyr::if_any(DTSTART, Negate(is.na))) |>
|
||||
calendar::ical()
|
||||
}
|
||||
@ -1,6 +1,6 @@
|
||||
|
||||
|
||||
#' @title Filter files in a folder
|
||||
#' MOVED Filter files in a folder
|
||||
#' @description This function filters files in a folder based on the
|
||||
#' provided filter.
|
||||
#' @param folder.path character. Path of the folder to be filtered
|
||||
|
||||
@ -1,4 +1,4 @@
|
||||
#' Easy function for splitting numeric variable in quantiles
|
||||
#' MOVED Easy function for splitting numeric variable in quantiles
|
||||
#'
|
||||
#' Using base/stats functions cut() and quantile().
|
||||
#'
|
||||
|
||||
@ -1,6 +1,6 @@
|
||||
|
||||
|
||||
#' Write ical object
|
||||
#' MOVED Write ical object
|
||||
#'
|
||||
#' This function creates an ical file based on a data frame with mixed events.
|
||||
#' Export as .ics file using `calendar::ic_write()`.
|
||||
|
||||
@ -2,7 +2,7 @@
|
||||
% Please edit documentation in R/add_padding.R
|
||||
\name{add_padding}
|
||||
\alias{add_padding}
|
||||
\title{Add padding to string}
|
||||
\title{MOVED Add padding to string}
|
||||
\usage{
|
||||
add_padding(
|
||||
d,
|
||||
@ -30,7 +30,7 @@ add_padding(
|
||||
vector or character strings of same length.
|
||||
}
|
||||
\description{
|
||||
Add padding to string
|
||||
MOVED Add padding to string
|
||||
}
|
||||
\examples{
|
||||
add_padding(sample(1:200,5),tail="AA",lead=c(2,3,"e"))
|
||||
|
||||
@ -2,7 +2,7 @@
|
||||
% Please edit documentation in R/chunks_of_n.R
|
||||
\name{chunks_of_n}
|
||||
\alias{chunks_of_n}
|
||||
\title{Split to chunks of size n}
|
||||
\title{MOVED Split to chunks of size n}
|
||||
\usage{
|
||||
chunks_of_n(d, n, label = NULL, even = FALSE, pattern = NULL)
|
||||
}
|
||||
@ -22,7 +22,7 @@ frame, will assume first column is name.}
|
||||
List of length n
|
||||
}
|
||||
\description{
|
||||
Split to chunks of size n
|
||||
MOVED Split to chunks of size n
|
||||
}
|
||||
\examples{
|
||||
tail(chunks_of_n(seq_len(100),7),3)
|
||||
|
||||
@ -2,7 +2,7 @@
|
||||
% Please edit documentation in R/contrast_text.R
|
||||
\name{contrast_text}
|
||||
\alias{contrast_text}
|
||||
\title{Contrast Text Color}
|
||||
\title{MOVED Contrast Text Color}
|
||||
\usage{
|
||||
contrast_text(
|
||||
background,
|
||||
|
||||
@ -1,51 +0,0 @@
|
||||
% Generated by roxygen2: do not edit by hand
|
||||
% Please edit documentation in R/ds2ical.R
|
||||
\name{ds2ical}
|
||||
\alias{ds2ical}
|
||||
\title{Convert data set to ical file}
|
||||
\usage{
|
||||
ds2ical(
|
||||
data,
|
||||
start = start,
|
||||
end = end,
|
||||
location = NULL,
|
||||
summary.glue.string = "ID {id} [{assessor}]",
|
||||
description.glue.string = NULL
|
||||
)
|
||||
}
|
||||
\arguments{
|
||||
\item{data}{data set}
|
||||
|
||||
\item{start}{dplyr style event start datetime column name. Data or datetime
|
||||
object.}
|
||||
|
||||
\item{end}{dplyr style event end datetime column name. Data or datetime
|
||||
object.}
|
||||
|
||||
\item{location}{dplyr style event location column name}
|
||||
|
||||
\item{summary.glue.string}{character string to pass to glue::glue() for event
|
||||
name (summary). Can take any column from data set.}
|
||||
|
||||
\item{description.glue.string}{character string to pass to glue::glue() for
|
||||
event description. Can take any column from data set.}
|
||||
}
|
||||
\value{
|
||||
tibble of class "ical"
|
||||
}
|
||||
\description{
|
||||
Convert data set to ical file
|
||||
}
|
||||
\examples{
|
||||
df <- dplyr::tibble(
|
||||
start = c(Sys.time(), Sys.time() + lubridate::days(2)),
|
||||
id = c("1", 3), assessor = "A", location = "111", note = c(NA, "OBS")
|
||||
) |>
|
||||
dplyr::mutate(end = start + lubridate::hours(2))
|
||||
df |> ds2ical()
|
||||
df |> ds2ical(summary.glue.string = "ID {id} [{assessor}] {note}")
|
||||
# Export .ics file: (not run)
|
||||
ical <- df |> ds2ical(start, end, location,
|
||||
description.glue.string = "{note}")
|
||||
# ical |> calendar::ic_write(file=here::here("calendar.ics"))
|
||||
}
|
||||
@ -2,7 +2,7 @@
|
||||
% Please edit documentation in R/files_filter.R
|
||||
\name{files_filter}
|
||||
\alias{files_filter}
|
||||
\title{Filter files in a folder}
|
||||
\title{MOVED Filter files in a folder}
|
||||
\usage{
|
||||
files_filter(folder.path, filter.by, full.names = TRUE)
|
||||
}
|
||||
|
||||
@ -2,7 +2,7 @@
|
||||
% Please edit documentation in R/quantile_cut.R
|
||||
\name{quantile_cut}
|
||||
\alias{quantile_cut}
|
||||
\title{Easy function for splitting numeric variable in quantiles}
|
||||
\title{MOVED Easy function for splitting numeric variable in quantiles}
|
||||
\usage{
|
||||
quantile_cut(
|
||||
x,
|
||||
|
||||
@ -8,7 +8,7 @@
|
||||
\description{
|
||||
\if{html}{\figure{logo.png}{options: style='float: right' alt='logo' width='120'}}
|
||||
|
||||
This is an R-toolbox of custom functions for convenient data management and analysis in clinical health research and teaching. The package is mainly collected for personal use, but any use beyond that is encouraged. This package has migrated functions from 'agdamsbo/daDoctoR', and new functions has been added. Version follows months and year. See NEWS/Changelog for release notes. This package includes sampled data from the TALOS trial (Kraglund et al (2018) \doi{10.1161/STROKEAHA.117.020067}). The win_prob() function is based on work by Zou et al (2022) \doi{10.1161/STROKEAHA.121.037744}. The age_calc() function is based on work by Becker (2020) \doi{10.18637/jss.v093.i02}.
|
||||
A collection of tools for clinical trial data management and analysis in research and teaching. The package is mainly collected for personal use, but any use beyond that is encouraged. This package has migrated functions from 'agdamsbo/daDoctoR', and new functions has been added. Version follows months and year. See NEWS/Changelog for release notes. This package includes sampled data from the TALOS trial (Kraglund et al (2018) \doi{10.1161/STROKEAHA.117.020067}). The win_prob() function is based on work by Zou et al (2022) \doi{10.1161/STROKEAHA.121.037744}. The age_calc() function is based on work by Becker (2020) \doi{10.18637/jss.v093.i02}.
|
||||
}
|
||||
\seealso{
|
||||
Useful links:
|
||||
|
||||
@ -2,7 +2,7 @@
|
||||
% Please edit documentation in R/write_ical.R
|
||||
\name{write_ical}
|
||||
\alias{write_ical}
|
||||
\title{Write ical object}
|
||||
\title{MOVED Write ical object}
|
||||
\usage{
|
||||
write_ical(
|
||||
df,
|
||||
|
||||
Binary file not shown.
|
Before Width: | Height: | Size: 32 KiB |
Binary file not shown.
|
Before Width: | Height: | Size: 17 KiB |
Binary file not shown.
|
Before Width: | Height: | Size: 8.4 KiB |
@ -1,17 +0,0 @@
|
||||
test_that("chunks_of_n returns correct", {
|
||||
expect_length(add_padding(sample(1:200,5)),5)
|
||||
|
||||
expect_equal(nchar(add_padding(sample(1:200,5),5)), rep(5,5))
|
||||
|
||||
expect_equal(nchar(add_padding(
|
||||
sample(1:200, 5), length = 5, after = TRUE
|
||||
)), rep(5, 5))
|
||||
|
||||
|
||||
## Errors
|
||||
expect_error(add_padding(matrix(sample(1:200,5)),5))
|
||||
|
||||
expect_error(add_padding(matrix(sample(1:200,5)),5,pad = "123"))
|
||||
|
||||
|
||||
})
|
||||
@ -1,72 +0,0 @@
|
||||
test_that("age_calc works for vectors of length 1 (scalars)", {
|
||||
result <- age_calc(as.Date("1945-10-23"), as.Date("2018-09-30"))
|
||||
expect_equal(round(result), 73)
|
||||
})
|
||||
|
||||
################################################################################
|
||||
|
||||
# Unit Test - gpttools
|
||||
|
||||
test_that("age_calc works correctly for years", {
|
||||
expect_equal(age_calc(as.Date("2000-01-01"), as.Date("2020-01-01"),
|
||||
units = "years"), 20)
|
||||
})
|
||||
|
||||
test_that("age_calc gives error if enddate < dob", {
|
||||
expect_error(age_calc(as.Date("2020-01-01"), as.Date("2000-01-01"),
|
||||
units = "years"))
|
||||
})
|
||||
|
||||
test_that("age_calc works correctly for months", {
|
||||
expect_equal(age_calc(as.Date("2000-01-01"), as.Date("2020-01-01"),
|
||||
units = "months"), 240)
|
||||
})
|
||||
|
||||
test_that("age_calc works correctly for months", {
|
||||
expect_equal(round(age_calc(
|
||||
as.Date("2000-07-07"), as.Date("2020-01-01"), units = "months"
|
||||
)), 234)
|
||||
})
|
||||
|
||||
test_that("age_calc works correctly for days", {
|
||||
expect_equal(age_calc(as.Date("2000-01-01"), as.Date("2020-01-01"),
|
||||
units = "days"), 7305)
|
||||
expect_length(age_calc(as.Date("2000-01-01"), as.Date("2020-01-01"),
|
||||
units = "days"), 1)
|
||||
})
|
||||
|
||||
test_that("age_calc works correctly with leap years and precise set to TRUE", {
|
||||
expect_equal(age_calc(
|
||||
as.Date("2000-02-29"),
|
||||
as.Date("2020-02-29"),
|
||||
units = "years",
|
||||
precise = TRUE
|
||||
),
|
||||
20)
|
||||
})
|
||||
|
||||
test_that("age_calc throws an error when enddate is before dob", {
|
||||
expect_equal(age_calc(
|
||||
as.Date("2000-01-01"),
|
||||
as.Date("2014-05-11"),
|
||||
precise = FALSE,
|
||||
units = "years"
|
||||
),
|
||||
14)
|
||||
})
|
||||
|
||||
test_that("age_calc throws an error when wrong unit", {
|
||||
expect_error(age_calc(as.Date("2020-01-01"), as.Date("2000-01-01"),
|
||||
units = "hours"))
|
||||
})
|
||||
|
||||
test_that("age_calc throws an error when wrong format", {
|
||||
expect_error(age_calc("2020-01-01", as.Date("2000-01-01"), units = "hours"))
|
||||
})
|
||||
|
||||
test_that("age_calc throws an error when wrong format", {
|
||||
expect_error(age_calc(as.Date("2020-01-01"), as.Date("2000-01-01"),
|
||||
units = "years"))
|
||||
expect_error(age_calc(as.Date("1982-01-01"), as.Date("2000-01-01"),
|
||||
units = "seconds"))
|
||||
})
|
||||
@ -1,69 +0,0 @@
|
||||
library(testthat)
|
||||
test_that("chunks_of_n returns correct", {
|
||||
expect_length(chunks_of_n(seq_len(100), 7),15)
|
||||
|
||||
expect_equal(lengths(chunks_of_n(seq_len(30), 7, even = TRUE),
|
||||
use.names = FALSE), c(6, 6, 6, 6, 6))
|
||||
|
||||
# This is the example from the function, but I believe it fails in GitHub testing
|
||||
ds <- data.frame(nm = paste0("Sub",
|
||||
add_padding(rownames(stRoke::talos))),
|
||||
stRoke::talos)
|
||||
|
||||
# ds <- data.frame(nm = paste0("Sub",rownames(stRoke::talos)),
|
||||
# stRoke::talos)
|
||||
|
||||
expect_equal(head(names(chunks_of_n(ds, 7,
|
||||
pattern = "Sub[0-9]{3}", label = "grp")),
|
||||
1),"grp-Sub038-Sub011")
|
||||
|
||||
expect_equal(
|
||||
ds[order(ds$nm),] |>
|
||||
chunks_of_n(7, pattern = "Sub([0-9]+)", label = "grp") |>
|
||||
head(1) |> names(),
|
||||
"grp-Sub001-Sub020"
|
||||
)
|
||||
|
||||
expect_equal(
|
||||
ds[order(ds$nm),] |>
|
||||
chunks_of_n(7, pattern = "Sub[0-9]{3}", label = "grp") |>
|
||||
head(1) |> names(),
|
||||
"grp-Sub001-Sub020"
|
||||
)
|
||||
|
||||
## Errors
|
||||
expect_error(chunks_of_n(list(ds), 7, pattern = "Sub[0-9]{3}", label = "grp"))
|
||||
|
||||
|
||||
})
|
||||
|
||||
test_that("n_chunks returns correct", {
|
||||
expect_length(n_chunks(seq_len(100), 7),7)
|
||||
|
||||
expect_equal(lengths(n_chunks(seq_len(30), 7, even = TRUE),
|
||||
use.names = FALSE), rep(5,6))
|
||||
|
||||
## This is the example from the function, but I believe it fails in GitHub testing
|
||||
ds <- data.frame(nm = paste0("Sub",
|
||||
add_padding(rownames(stRoke::talos))),
|
||||
stRoke::talos)
|
||||
|
||||
# ds <- data.frame(nm = paste0("Sub",rownames(stRoke::talos)),
|
||||
# stRoke::talos)
|
||||
|
||||
expect_equal(head(names(n_chunks(ds, 7,
|
||||
pattern = "Sub([0-9]+)", label = "grp")),
|
||||
1),"grp-Sub038-Sub603")
|
||||
|
||||
expect_equal(
|
||||
ds[order(ds$nm), ] |>
|
||||
n_chunks(7, pattern = "Sub([0-9]+)", label = "grp") |>
|
||||
head(1) |> names(),
|
||||
"grp-Sub001-Sub072"
|
||||
)
|
||||
|
||||
## Errors
|
||||
expect_error(n_chunks(list(ds), 7, pattern = "Sub([0-9]+)", label = "grp"))
|
||||
|
||||
|
||||
})
|
||||
@ -1,60 +0,0 @@
|
||||
# Unit test for contrast_text()
|
||||
|
||||
library(testthat)
|
||||
|
||||
|
||||
test_that("contrast_text() returns the correct text color", {
|
||||
expect_equal(contrast_text("#FFFFFF"), "black")
|
||||
expect_equal(contrast_text("#000000"), "white")
|
||||
expect_equal(contrast_text("#FFFFFF", light_text="blue", dark_text="green"),
|
||||
"green")
|
||||
expect_equal(contrast_text("#000000", light_text="blue", dark_text="green"),
|
||||
"blue")
|
||||
})
|
||||
|
||||
################################################################################
|
||||
|
||||
# library(devtools)
|
||||
#
|
||||
# install_github("MangoTheCat/visualTest")
|
||||
# library(visualTest)
|
||||
#
|
||||
# test_that("New test of color_plot()", {
|
||||
# par(bg=NULL)
|
||||
# colors <- colors()[34:53]
|
||||
#
|
||||
# # old <- getwd()
|
||||
# # setwd("/Users/au301842/stRoke/tests/testthat")
|
||||
# # setwd(old)
|
||||
#
|
||||
# png(filename = "data/test1.png")
|
||||
# color_plot(colors,method="relative")
|
||||
# dev.off()
|
||||
#
|
||||
# # getFingerprint("data/test1.png")
|
||||
#
|
||||
# expect_equal(getFingerprint("data/test1.png"), "AD07D27813E1D867")
|
||||
# # isSimilar(tmp, "AD07D27813E1D867", threshold = 8)
|
||||
#
|
||||
# #############################
|
||||
#
|
||||
# # colors <- colors()[51:70]
|
||||
# png(filename = "data/test2.png")
|
||||
# color_plot(colors,labels = TRUE, borders = FALSE,cex_label = .5, ncol = 3, method="perceived_2")
|
||||
# dev.off()
|
||||
#
|
||||
# # getFingerprint("data/test2.png")
|
||||
#
|
||||
# expect_equal(getFingerprint("data/test2.png"), "8B0B54D4E4AF2BB1")
|
||||
#
|
||||
# #############################
|
||||
#
|
||||
# png(filename = "data/test3.png")
|
||||
# color_plot(colors,labels = FALSE, borders = TRUE, ncol = 6, method="perceived")
|
||||
# dev.off()
|
||||
#
|
||||
# # getFingerprint("data/test3.png")
|
||||
#
|
||||
# expect_equal(getFingerprint("data/test3.png"), "B706F0F1C119CCF8")
|
||||
# })
|
||||
################################################################################
|
||||
@ -1,40 +0,0 @@
|
||||
talos$id <- seq_len(nrow(talos))
|
||||
|
||||
test_that("ds2dd gives desired output", {
|
||||
expect_equal(ncol(ds2dd(talos, record.id = "id")), 18)
|
||||
expect_s3_class(ds2dd(talos, record.id = "id"), "data.frame")
|
||||
expect_s3_class(ds2dd(talos, record.id = 7), "data.frame")
|
||||
})
|
||||
|
||||
|
||||
test_that("ds2dd gives output with list of length two", {
|
||||
expect_equal(length(ds2dd(
|
||||
talos,
|
||||
record.id = "id",
|
||||
include.column.names = TRUE
|
||||
)), 2)
|
||||
})
|
||||
|
||||
|
||||
test_that("ds2dd gives correct errors", {
|
||||
expect_error(ds2dd(talos))
|
||||
expect_error(ds2dd(talos, form.name = c("basis", "incl")))
|
||||
expect_error(ds2dd(talos, field.type = c("text", "dropdown")))
|
||||
expect_error(ds2dd(talos, field.label = c("Name", "Age")))
|
||||
})
|
||||
|
||||
|
||||
|
||||
colnames(talos) <-
|
||||
c("rtreat",
|
||||
"mRS 1",
|
||||
"mRS 6",
|
||||
"hypertension",
|
||||
"diabetes",
|
||||
"civil",
|
||||
"id")
|
||||
|
||||
test_that("ds2dd correctly renames", {
|
||||
expect_equal(ncol(ds2dd(talos, record.id = "id")), 18)
|
||||
expect_s3_class(ds2dd(talos, record.id = "id"), "data.frame")
|
||||
})
|
||||
@ -1,4 +0,0 @@
|
||||
test_that("files_filter() correctly filters files", {
|
||||
expect_type(files_filter(getwd(),"tests"),
|
||||
"character")
|
||||
})
|
||||
@ -1,62 +0,0 @@
|
||||
test_that("quatile_cut() works for detail.list==FALSE", {
|
||||
result <- quantile_cut(iris$Sepal.Length, 3, detail.list = FALSE)
|
||||
expect_equal(length(levels(result)), 3)
|
||||
expect_s3_class(result, "factor")
|
||||
})
|
||||
|
||||
################################################################################
|
||||
|
||||
test_that("quatile_cut() works for inc.outs==TRUE", {
|
||||
result <-
|
||||
quantile_cut(iris$Sepal.Length,
|
||||
3,
|
||||
y = iris$Sepal.Length + 3,
|
||||
inc.outs = FALSE)
|
||||
expect_true(any(is.na(result)))
|
||||
|
||||
result <-
|
||||
quantile_cut(iris$Sepal.Length,
|
||||
3,
|
||||
y = iris$Sepal.Length + 3,
|
||||
inc.outs = TRUE)
|
||||
expect_false(any(is.na(result)))
|
||||
expect_equal(length(levels(result)), 3)
|
||||
expect_s3_class(result, "factor")
|
||||
})
|
||||
|
||||
################################################################################
|
||||
|
||||
test_that("quatile_cut() works for detail.list==TRUE", {
|
||||
result <- quantile_cut(iris$Sepal.Length, 3, detail.list = TRUE)
|
||||
expect_length(result, 2)
|
||||
expect_type(result, "list")
|
||||
})
|
||||
|
||||
################################################################################
|
||||
|
||||
# Test created using remotes::install_github("JamesHWade/gpttools")
|
||||
# unit test addin.
|
||||
test_that("quantile_cut works correctly", {
|
||||
x <- runif(100)
|
||||
groups <- 5
|
||||
y <- runif(100)
|
||||
expect_equal(
|
||||
quantile_cut(x, groups, y, na.rm = TRUE),
|
||||
cut(
|
||||
x,
|
||||
quantile(
|
||||
y,
|
||||
probs = seq(0, 1, 1 / groups),
|
||||
na.rm = TRUE,
|
||||
names = TRUE,
|
||||
type = 7
|
||||
),
|
||||
include.lowest = TRUE,
|
||||
labels = NULL,
|
||||
ordered_result = FALSE
|
||||
)
|
||||
)
|
||||
})
|
||||
|
||||
################################################################################
|
||||
|
||||
@ -1,15 +0,0 @@
|
||||
# library(testthat)
|
||||
test_that("str_extract returns correct", {
|
||||
ls <- do.call(c, lapply(sample(4:8, 20, T), function(i) {
|
||||
paste(sample(letters, i, T), collapse = "")
|
||||
}))
|
||||
|
||||
ds <- do.call(c, lapply(1:20, function(i) {
|
||||
paste(sample(ls, 1), i, sample(ls, 1), "23", sep = "_")
|
||||
}))
|
||||
|
||||
expect_equal(nchar(str_extract(ds, "([0-9]+)")),c(rep(1,9),rep(2,11)))
|
||||
|
||||
expect_error(str_extract(data.frame(ds), "([0-9]+)"))
|
||||
|
||||
})
|
||||
@ -1,92 +0,0 @@
|
||||
test_that("write_ical() returns a ical object", {
|
||||
df <- data.frame(
|
||||
date = c("2020-02-10", "2020-02-11", "2020-02-11"),
|
||||
date.end = c("2020-02-13",NA,NA),
|
||||
title = c("Conference", "Lunch", "Walk"),
|
||||
start = c("12:00:00", NA, "08:00:00"),
|
||||
time.end = c("13:00:00", NA, "17:30:00"),
|
||||
note = c("Hi there","Remember to come", ""),
|
||||
link = c("https://icalendar.org","https://agdamsbo.github.io/stRoke/", "")
|
||||
)
|
||||
|
||||
expect_s3_class(
|
||||
write_ical(
|
||||
df,
|
||||
date.end = "date.end",
|
||||
time.end = "time.end",
|
||||
place.def = "Home",
|
||||
descr = "note",
|
||||
link = "link"
|
||||
),
|
||||
"ical"
|
||||
)
|
||||
})
|
||||
|
||||
test_that("write_ical() returns a ical object", {
|
||||
df <- data.frame(
|
||||
date = c("2020-02-10", "2020-02-11", "2020-02-11"),
|
||||
date.end = c("2020-02-13",NA,NA),
|
||||
title = c("Conference", "Lunch", "Walk"),
|
||||
start = c("12:00:00", NA, "08:00:00"),
|
||||
time.end = c("13:00:00", NA, "17:30:00"),
|
||||
place = c("Home", "Work", NA),
|
||||
note = c("Hi there","Remember to come", ""),
|
||||
link = c("https://icalendar.org","https://agdamsbo.github.io/stRoke/", "")
|
||||
)
|
||||
|
||||
expect_s3_class(
|
||||
write_ical(
|
||||
df,
|
||||
date.end = "date.end",
|
||||
time.end = "time.end",
|
||||
place = "place",
|
||||
descr = "note",
|
||||
link = "link"
|
||||
),
|
||||
"ical"
|
||||
)
|
||||
})
|
||||
|
||||
test_that("write_ical() returns error", {
|
||||
df <- data.frame(
|
||||
date = c("2020-02-10", "2020-02-11"),
|
||||
title = c("Conference", "Lunch"),
|
||||
start = c("12:00:00", NA),
|
||||
end = c("13:00:00", NA),
|
||||
note = c("Hi there","Remember to come"),
|
||||
link = c("https://icalendar.org","https://agdamsbo.github.io/stRoke/")
|
||||
)
|
||||
expect_error(write_ical(df, date = "wrong"))
|
||||
expect_error(write_ical(df, place = "wrong"))
|
||||
expect_error(write_ical(df, title = "wrong"))
|
||||
expect_error(write_ical(df, time.start = "wrong"))
|
||||
expect_error(write_ical(df, time.end = "wrong"))
|
||||
})
|
||||
|
||||
test_that("write_ical() returns error", {
|
||||
df <- data.frame(
|
||||
date = c("2020-02-10", "2020-02-11"),
|
||||
date.end = c(NA,"2020-02-13"),
|
||||
title = c("Conference", "Lunch"),
|
||||
start = c("12:00:00", NA),
|
||||
end = c("13:00:00", NA),
|
||||
note = c("Hi there","Remember to come"),
|
||||
link = c("https://icalendar.org","https://agdamsbo.github.io/stRoke/")
|
||||
)
|
||||
expect_error(write_ical(df,
|
||||
date.end = "date.end"))
|
||||
})
|
||||
|
||||
test_that("write_ical() returns error", {
|
||||
df <- data.frame(
|
||||
date = c("2020-02-10", "2020-02-11"),
|
||||
date.end = c("2020-02-13",NA),
|
||||
title = c(NA, "Lunch"),
|
||||
start = c("12:00:00", NA),
|
||||
end = c("13:00:00", NA),
|
||||
note = c("Hi there","Remember to come"),
|
||||
link = c("https://icalendar.org","https://agdamsbo.github.io/stRoke/")
|
||||
)
|
||||
expect_error(write_ical(df,
|
||||
date.end = "date.end"))
|
||||
})
|
||||
Loading…
Reference in New Issue
Block a user