migrated function tests with functions moved to agdamsbo/project.aid

This commit is contained in:
Andreas Gammelgaard Damsbo 2024-10-24 09:19:55 +02:00
parent 7823d673bc
commit 34be1df31a
No known key found for this signature in database
30 changed files with 19 additions and 575 deletions

View File

@ -4,8 +4,8 @@ Version: 24.10.1
Authors@R: Authors@R:
person("Andreas Gammelgaard", "Damsbo", , "agdamsbo@clin.au.dk", role = c("aut", "cre"), person("Andreas Gammelgaard", "Damsbo", , "agdamsbo@clin.au.dk", role = c("aut", "cre"),
comment = c(ORCID = "0000-0002-7559-1154")) comment = c(ORCID = "0000-0002-7559-1154"))
Description: This is an R-toolbox of custom functions for convenient data management Description: A collection of tools for clinical trial data management and
and analysis in clinical health research and teaching. analysis in research and teaching.
The package is mainly collected for personal use, but any use beyond that is encouraged. 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. 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. Version follows months and year. See NEWS/Changelog for release notes.
@ -34,7 +34,6 @@ Imports:
calendar, calendar,
dplyr, dplyr,
ggplot2, ggplot2,
glue,
grDevices, grDevices,
gtsummary, gtsummary,
lubridate, lubridate,

View File

@ -11,7 +11,6 @@ export(cpr_check)
export(cpr_dob) export(cpr_dob)
export(cpr_female) export(cpr_female)
export(ds2dd) export(ds2dd)
export(ds2ical)
export(files_filter) export(files_filter)
export(generic_stroke) export(generic_stroke)
export(index_plot) export(index_plot)

View File

@ -2,13 +2,9 @@
### Functions: ### 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. * 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()`.
* 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()`.
* 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. * 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.

View File

@ -1,4 +1,4 @@
#' Add padding to string #' MOVED Add padding to string
#' #'
#' @param d vector of strings or numbers #' @param d vector of strings or numbers
#' @param length final string length #' @param length final string length

View File

@ -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 d data. Can be vector or data frame.
#' @param n number of chunks #' @param n number of chunks

View File

@ -1,6 +1,4 @@
#' MOVED Contrast Text Color
#' @title Contrast Text Color
#' @description Calculates the best contrast text color for a given #' @description Calculates the best contrast text color for a given
#' background color. #' background color.
#' @param background A hex/named color value that represents the background. #' @param background A hex/named color value that represents the background.

View File

@ -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()
}

View File

@ -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 #' @description This function filters files in a folder based on the
#' provided filter. #' provided filter.
#' @param folder.path character. Path of the folder to be filtered #' @param folder.path character. Path of the folder to be filtered

View File

@ -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(). #' Using base/stats functions cut() and quantile().
#' #'

View File

@ -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. #' This function creates an ical file based on a data frame with mixed events.
#' Export as .ics file using `calendar::ic_write()`. #' Export as .ics file using `calendar::ic_write()`.

View File

@ -2,7 +2,7 @@
% Please edit documentation in R/add_padding.R % Please edit documentation in R/add_padding.R
\name{add_padding} \name{add_padding}
\alias{add_padding} \alias{add_padding}
\title{Add padding to string} \title{MOVED Add padding to string}
\usage{ \usage{
add_padding( add_padding(
d, d,
@ -30,7 +30,7 @@ add_padding(
vector or character strings of same length. vector or character strings of same length.
} }
\description{ \description{
Add padding to string MOVED Add padding to string
} }
\examples{ \examples{
add_padding(sample(1:200,5),tail="AA",lead=c(2,3,"e")) add_padding(sample(1:200,5),tail="AA",lead=c(2,3,"e"))

View File

@ -2,7 +2,7 @@
% Please edit documentation in R/chunks_of_n.R % Please edit documentation in R/chunks_of_n.R
\name{chunks_of_n} \name{chunks_of_n}
\alias{chunks_of_n} \alias{chunks_of_n}
\title{Split to chunks of size n} \title{MOVED Split to chunks of size n}
\usage{ \usage{
chunks_of_n(d, n, label = NULL, even = FALSE, pattern = NULL) 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 List of length n
} }
\description{ \description{
Split to chunks of size n MOVED Split to chunks of size n
} }
\examples{ \examples{
tail(chunks_of_n(seq_len(100),7),3) tail(chunks_of_n(seq_len(100),7),3)

View File

@ -2,7 +2,7 @@
% Please edit documentation in R/contrast_text.R % Please edit documentation in R/contrast_text.R
\name{contrast_text} \name{contrast_text}
\alias{contrast_text} \alias{contrast_text}
\title{Contrast Text Color} \title{MOVED Contrast Text Color}
\usage{ \usage{
contrast_text( contrast_text(
background, background,

View File

@ -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"))
}

View File

@ -2,7 +2,7 @@
% Please edit documentation in R/files_filter.R % Please edit documentation in R/files_filter.R
\name{files_filter} \name{files_filter}
\alias{files_filter} \alias{files_filter}
\title{Filter files in a folder} \title{MOVED Filter files in a folder}
\usage{ \usage{
files_filter(folder.path, filter.by, full.names = TRUE) files_filter(folder.path, filter.by, full.names = TRUE)
} }

View File

@ -2,7 +2,7 @@
% Please edit documentation in R/quantile_cut.R % Please edit documentation in R/quantile_cut.R
\name{quantile_cut} \name{quantile_cut}
\alias{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{ \usage{
quantile_cut( quantile_cut(
x, x,

View File

@ -8,7 +8,7 @@
\description{ \description{
\if{html}{\figure{logo.png}{options: style='float: right' alt='logo' width='120'}} \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{ \seealso{
Useful links: Useful links:

View File

@ -2,7 +2,7 @@
% Please edit documentation in R/write_ical.R % Please edit documentation in R/write_ical.R
\name{write_ical} \name{write_ical}
\alias{write_ical} \alias{write_ical}
\title{Write ical object} \title{MOVED Write ical object}
\usage{ \usage{
write_ical( write_ical(
df, 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

View File

@ -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"))
})

View File

@ -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"))
})

View File

@ -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"))
})

View File

@ -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")
# })
################################################################################

View File

@ -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")
})

View File

@ -1,4 +0,0 @@
test_that("files_filter() correctly filters files", {
expect_type(files_filter(getwd(),"tests"),
"character")
})

View File

@ -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
)
)
})
################################################################################

View File

@ -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]+)"))
})

View File

@ -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"))
})