From 1930a6d205288880ce340042c8d928ff861e7cd0 Mon Sep 17 00:00:00 2001 From: AG Damsbo Date: Wed, 25 Jan 2023 19:51:58 +0100 Subject: [PATCH] new function --- R/write_ical.R | 171 ++++++++++++++++++++++++++ docs/reference/write_ical.html | 198 +++++++++++++++++++++++++++++++ man/write_ical.Rd | 85 +++++++++++++ tests/testthat/test-write_ical.R | 44 +++++++ 4 files changed, 498 insertions(+) create mode 100644 R/write_ical.R create mode 100644 docs/reference/write_ical.html create mode 100644 man/write_ical.Rd create mode 100644 tests/testthat/test-write_ical.R diff --git a/R/write_ical.R b/R/write_ical.R new file mode 100644 index 0000000..05d9f93 --- /dev/null +++ b/R/write_ical.R @@ -0,0 +1,171 @@ + + +#' 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()`. +#' +#' @param df A data frame with the calendar data +#' @param date The name of the event date column in the data frame +#' @param date.end The name of the end date column in the data frame +#' @param title The name of the title column in the data frame +#' @param time.start The name of the start time column in the data frame +#' @param time.end The name of the end time column in the data frame +#' @param place The name of the place column in the data frame +#' @param place.def Default location to use when place is NA +#' @param time.def Default start time to use when time.start is NA +#' @param time.dur Default duration of the event in minutes, if time.end is NA +#' @param descr Name of description/notes column if any. +#' @param link Name of link column, if any. +#' @param t.zone A character string of time zone for events. The string must be +#' a time zone that is recognized by the user's OS. +#' +#' @return ical object +#' +#' @examples +#' df <- data.frame( +#' date = c("2020-02-10", "2020-02-11"), +#' end = c("2020-02-13",NA), +#' title = c("Conference", "Lunch"), +#' start = c("12:00:00", NA), +#' bye = c("13:00:00", NA), +#' note = c("Hi there","Remember to come"), +#' link = c("https://icalendar.org","https://agdamsbo.github.io/stRoke/") +#' ) +#' +#' write_ical( +#' df, +#' date = "date", +#' date.end = "end", +#' title = "title", +#' time.start = "start", +#' time.end = "bye", +#' place.def = "Conference Room", +#' descr = "note", +#' link = "link" +#' ) +#' +#' @export +#' +#' @importFrom lubridate ymd hms dminutes +#' @importFrom dplyr if_else +#' @importFrom calendar ic_guid ic_write +#' +#' @seealso +#' [calendar package](https://github.com/ATFutures/calendar/) +#' [icalendar standard webpage](https://icalendar.org) +#' +#' +write_ical <- + function(df, + date = "date", + date.end = NA, + title = "title", + time.start = "start", + time.end = "end", + place = NA, + place.def = NA, + time.def = "10:00:00", + time.dur = 60, + descr = NA, + link = NA, + t.zone = "CET") { + if (!date %in% colnames(df)) { + stop("Supplied date is not a valid column name") + } + + if (!title %in% colnames(df)) { + stop("Supplied title is not a valid column name") + } + + if (is.character(place) & !place %in% colnames(df)) { + stop("Supplied place is not a valid column name") + } + + if (is.character(time.start) & !time.start %in% colnames(df)) { + stop("Supplied time.start is not a valid column name") + } + + if (is.character(time.end) & !time.end %in% colnames(df)) { + stop("Supplied time.end is not a valid column name") + } + + # Both ifelse() and dplyr::if_else() has problems and gives errors + # handling NA's, as everything is evaluated. + # This is my take on a approach by row. + df <- do.call(rbind, + lapply( + split(df, + seq_len(nrow(df))), + function(i) { + if (is.na(i[time.start])) { + i$start_time <- + lubridate::ymd(i[, date], tz = t.zone) + + lubridate::hms(time.def) + } + else if (!is.na(i[, time.start])) { + i$start_time <- + lubridate::ymd(i[, date], tz = t.zone) + + lubridate::hms(i[, time.start]) + } + + + if (is.character(date.end) & + !is.na(i[, time.end]) & + is.na(i[, date.end])) { + stop("time.end is needed for entries + with supplied date.end") + } + else if (is.character(date.end) & + !is.na(i[, time.end]) & + !is.na(i[, date.end])) { + i$end_time <- + lubridate::ymd(i[, date.end], tz = t.zone) + + lubridate::hms(i[, time.end]) + } + else if (!is.na(i[, time.end])) { + i$end_time <- + lubridate::ymd(i[, date], tz = t.zone) + + lubridate::hms(i[, time.end]) + } else { + i$end_time <- + i$start_time + lubridate::dminutes(time.dur) + } + + i + + })) + + place_meet <- rep(NA, nrow(df)) + + if (!is.na(place)) { + place_meet <- df[, place] + } + + place_meet[is.na(place_meet)] <- place.def + + df_mod <- data.frame( + SUMMARY = df[, title], + DTSTART = df[, "start_time"], + DTEND = df[, "end_time"], + UID = replicate(nrow(df), calendar::ic_guid()), + stringsAsFactors = FALSE + ) + + if (!all(is.na(place_meet))) { + df_mod <- data.frame(df_mod, + LOCATION = place_meet) + } + + if (!is.na(link)) { + df_mod <- data.frame(df_mod, + URL = df[, link]) + } + + if (!is.na(descr)) { + df_mod <- data.frame(df_mod, + DESCRIPTION = df[, descr]) + } + + calendar::ical(df_mod) + } diff --git a/docs/reference/write_ical.html b/docs/reference/write_ical.html new file mode 100644 index 0000000..208eb2f --- /dev/null +++ b/docs/reference/write_ical.html @@ -0,0 +1,198 @@ + +Write ical object — write_ical • stRoke + Skip to contents + + +
+
+
+

Write ical object

+ Source: R/write_ical.R +
write_ical.Rd
+
+ +
+

This function creates an ical file based on a data frame with mixed events. +Export as .ics file using calendar::ic_write().

+
+ +
+

Usage

+ 
write_ical(
+  df,
+  date = "date",
+  date.end = NA,
+  title = "title",
+  time.start = "start",
+  time.end = "end",
+  place = NA,
+  place.def = NA,
+  time.def = "10:00:00",
+  time.dur = 60,
+  descr = NA,
+  link = NA,
+  t.zone = "CET"
+)
+
+ +
+

Arguments

+
df
+

A data frame with the calendar data

+ + +
date
+

The name of the event date column in the data frame

+ + +
date.end
+

The name of the end date column in the data frame

+ + +
title
+

The name of the title column in the data frame

+ + +
time.start
+

The name of the start time column in the data frame

+ + +
time.end
+

The name of the end time column in the data frame

+ + +
place
+

The name of the place column in the data frame

+ + +
place.def
+

Default location to use when place is NA

+ + +
time.def
+

Default start time to use when time.start is NA

+ + +
time.dur
+

Default duration of the event in minutes, if time.end is NA

+ + +
descr
+

Name of description/notes column if any.

+ + +
link
+

Name of link column, if any.

+ + +
t.zone
+

A character string of time zone for events. The string must be +a time zone that is recognized by the user's OS.

+ +
+
+

Value

+ + +

ical object

+
+
+

See also

+

calendar package +icalendar standard webpage

+
+ +
+

Examples

+ 
df <- data.frame(
+  date = c("2020-02-10", "2020-02-11"),
+  end = c("2020-02-13",NA),
+  title = c("Conference", "Lunch"),
+  start = c("12:00:00", NA),
+  bye = c("13:00:00", NA),
+  note = c("Hi there","Remember to come"),
+  link = c("https://icalendar.org","https://agdamsbo.github.io/stRoke/")
+)
+
+write_ical(
+  df,
+  date = "date",
+  date.end = "end",
+  title = "title",
+  time.start = "start",
+  time.end = "bye",
+  place.def = "Conference Room",
+  descr = "note",
+  link = "link"
+)
+#> # A tibble: 2 × 7
+#>   SUMMARY    DTSTART             DTEND               UID   LOCAT…¹ URL   DESCR…²
+#>   <chr>      <dttm>              <dttm>              <chr> <chr>   <chr> <chr>  
+#> 1 Conference 2020-02-10 12:00:00 2020-02-13 13:00:00 ical… Confer… http… Hi the…
+#> 2 Lunch      2020-02-11 10:00:00 2020-02-11 11:00:00 ical… Confer… http… Rememb…
+#> # … with abbreviated variable names ¹​LOCATION, ²​DESCRIPTION
+
+
+
+
+ + +
+ + + + + + + diff --git a/man/write_ical.Rd b/man/write_ical.Rd new file mode 100644 index 0000000..e48d34b --- /dev/null +++ b/man/write_ical.Rd @@ -0,0 +1,85 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/write_ical.R +\name{write_ical} +\alias{write_ical} +\title{Write ical object} +\usage{ +write_ical( + df, + date = "date", + date.end = NA, + title = "title", + time.start = "start", + time.end = "end", + place = NA, + place.def = NA, + time.def = "10:00:00", + time.dur = 60, + descr = NA, + link = NA, + t.zone = "CET" +) +} +\arguments{ +\item{df}{A data frame with the calendar data} + +\item{date}{The name of the event date column in the data frame} + +\item{date.end}{The name of the end date column in the data frame} + +\item{title}{The name of the title column in the data frame} + +\item{time.start}{The name of the start time column in the data frame} + +\item{time.end}{The name of the end time column in the data frame} + +\item{place}{The name of the place column in the data frame} + +\item{place.def}{Default location to use when place is NA} + +\item{time.def}{Default start time to use when time.start is NA} + +\item{time.dur}{Default duration of the event in minutes, if time.end is NA} + +\item{descr}{Name of description/notes column if any.} + +\item{link}{Name of link column, if any.} + +\item{t.zone}{A character string of time zone for events. The string must be +a time zone that is recognized by the user's OS.} +} +\value{ +ical object +} +\description{ +This function creates an ical file based on a data frame with mixed events. +Export as .ics file using \code{calendar::ic_write()}. +} +\examples{ +df <- data.frame( + date = c("2020-02-10", "2020-02-11"), + end = c("2020-02-13",NA), + title = c("Conference", "Lunch"), + start = c("12:00:00", NA), + bye = c("13:00:00", NA), + note = c("Hi there","Remember to come"), + link = c("https://icalendar.org","https://agdamsbo.github.io/stRoke/") +) + +write_ical( + df, + date = "date", + date.end = "end", + title = "title", + time.start = "start", + time.end = "bye", + place.def = "Conference Room", + descr = "note", + link = "link" +) + +} +\seealso{ +\href{https://github.com/ATFutures/calendar/}{calendar package} +\href{https://icalendar.org}{icalendar standard webpage} +} diff --git a/tests/testthat/test-write_ical.R b/tests/testthat/test-write_ical.R new file mode 100644 index 0000000..3645f87 --- /dev/null +++ b/tests/testthat/test-write_ical.R @@ -0,0 +1,44 @@ +test_that("write_ical() returns a ical object", { + df <- data.frame( + date = c("2020-02-10", "2020-02-11"), + date.end = c("2020-02-13",NA), + 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_s3_class(write_ical(df, + date.end = "date.end"), "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")) +}) \ No newline at end of file