feat: single-day event as point (if to is na)

R/add_events.R

@@ -57,11 +57,14 @@ add_events <- function(data, year, month, palette, weekend) {
 
     for (i in 1:nrow(data)) {
 
-      x_lft  <- calendar[which(calendar[ , "date"] == data[i, "from"]), "x"]
-      x_rght <- calendar[which(calendar[ , "date"] == data[i, "to"]), "x"]
+      from <- data[i, "from"]
+      to   <- ifelse(is.na(data[i, "to"]), data[i, "from"], data[i, "to"])
 
-      y_btm  <- calendar[which(calendar[ , "date"] == data[i, "from"]), "y"]
-      y_top <- calendar[which(calendar[ , "date"] == data[i, "to"]), "y"]
+      x_lft  <- calendar[which(calendar[ , "date"] == from), "x"]
+      x_rght <- calendar[which(calendar[ , "date"] == to), "x"]
+
+      y_btm  <- calendar[which(calendar[ , "date"] == from), "y"]
+      y_top  <- calendar[which(calendar[ , "date"] == to), "y"]
 
       if (i == 1) {
 
@@ -97,7 +100,7 @@ add_events <- function(data, year, month, palette, weekend) {
         y_line <- max(coords[which(coords$"key" %in% coord$"key"), "n"])
       }
 
-      # if (data[i, "from"] != data[i, "to"]) {
+      if (!is.na(data[i, "to"])) {
 
         rect(xleft   = x_lft - 1 + 0.025,
              xright  = x_rght - 0.025,
@@ -115,22 +118,22 @@ add_events <- function(data, year, month, palette, weekend) {
              font   = 2,
              col    = "#ffffff") 
 
-      # } else {
-
-        # points(x   = x_lft - 1 + 0.075,
-        #        y   = y_btm - (0.18 * y_line + 0.02 * (y_line - 1)) - 0.18 / 2,
-        #        pch = 19,
-        #        cex = 0.85,
-        #        col = data[i, "color"]) 
-        # 
-        # text(x      = x_lft - 1 + 0.075,
-        #      y      = y_btm - (0.18 * y_line + 0.02 * (y_line - 1)) - 0.18 / 2 - 0.01,
-        #      labels = data[i, "event"],
-        #      cex    = 0.65,
-        #      font   = 2,
-        #      pos    = 4,
-        #      col    = data[i, "color"]) 
-      # }
+      } else {
+
+      points(x   = x_lft - 1 + 0.05,
+             y   = y_btm - (0.18 * y_line + 0.02 * (y_line - 1)) - 0.18 / 2,
+             pch = 19,
+             cex = 0.85,
+             col = data[i, "color"])
+
+      text(x      = x_lft - 1 + 0.05,
+           y      = y_btm - (0.18 * y_line + 0.02 * (y_line - 1)) - 0.18 / 2 - 0.01,
+           labels = data[i, "name"],
+           cex    = 0.65,
+           font   = 2,
+           pos    = 4,
+           col    = "#333333")
+      }
     }
   }
 

R/check_events.R

@@ -24,8 +24,9 @@ check_events <- function(data) {
     }
 
     days <- unlist(lapply(1:nrow(data), function(i) {
-      as.character(seq(as.Date(data[i, "from"]), as.Date(data[i, "to"]), 
-                       by = "days"))
+      from <- data[i, "from"]
+      to   <- ifelse(is.na(data[i, "to"]), data[i, "from"], data[i, "to"])
+      as.character(seq(as.Date(from), as.Date(to), by = "days"))
     }))
 
     n_events_by_day <- table(days)

R/filter_events.R

@@ -110,11 +110,11 @@ filter_events <- function(data, year = format(Sys.Date(), "%Y"),
   }
 
 
-  if (any(is.na(data$"to"))) {
-    stop("Error in converting dates. Please use the argument 'format' to ", 
-         "specify the appropriate format. See '?strptime' for further ", 
-         "information", call. = FALSE)
-  }
+  # if (any(is.na(data$"to"))) {
+  #   stop("Error in converting dates. Please use the argument 'format' to ", 
+  #        "specify the appropriate format. See '?strptime' for further ", 
+  #        "information", call. = FALSE)
+  # }
 
   if (!is.character(format)) {
     stop("Argument 'format' must be a character", call. = FALSE)
@@ -143,25 +143,38 @@ filter_events <- function(data, year = format(Sys.Date(), "%Y"),
 
   for (i in 1:nrow(data)) {
 
-    dates <- seq(data[i, "from"], data[i, "to"], by = "days")
+    if (!is.na(data[i, "to"])) {
+
+      dates <- seq(data[i, "from"], data[i, "to"], by = "days")  
+      case  <- "multi_day"
+
+    } else {
+
+      dates <- data[i, "from"]
+      case  <- "single_day"
+    }
+
 
     dates <- dates[which(dates %in% calendar$"date")]
 
     if (length(dates) > 0) {
-
+
+      from <- as.character(min(dates, na.rm = TRUE))
+      to   <- ifelse(case == "single_day", NA, as.character(max(dates)))
+
       if ("category" %in% colnames(data)) {
 
         events <- rbind(events,
                         data.frame("name"     = data[i, "name"],
-                                   "from"     = as.character(min(dates)),
-                                   "to"       = as.character(max(dates)),
+                                   "from"     = from,
+                                   "to"       = to,
                                    "category" = data[i, "category"]))
       } else {
 
         events <- rbind(events,
                         data.frame("name"     = data[i, "name"],
-                                   "from"     = as.character(min(dates)),
-                                   "to"       = as.character(max(dates))))
+                                   "from"     = from,
+                                   "to"       = to))
       }
     }
   }

R/multiweek_events.R

@@ -16,10 +16,20 @@ multiweek_events <- function(data, year, month, weekend) {
 
     for (i in 1:nrow(data)) {
 
-      days <- data.frame("date" = as.character(seq(as.Date(data[i, "from"]), 
-                                                   as.Date(data[i, "to"]), 
-                                                   by = "days")))
+      case <- ifelse(is.na(data[i, "to"]), "single_day", "multi_day")
 
+      if (case == "single_day") {
+
+        days <- data.frame("date" = as.character(seq(as.Date(data[i, "from"]), 
+                                                     as.Date(data[i, "from"]), 
+                                                     by = "days")))
+      } else {
+
+        days <- data.frame("date" = as.character(seq(as.Date(data[i, "from"]), 
+                                                     as.Date(data[i, "to"]), 
+                                                     by = "days")))
+      }
+
       days <- merge(days, calendar, by = "date", all = FALSE)
 
       dates <- tapply(days$"date", days$"y", function(x) {
@@ -41,11 +51,15 @@ multiweek_events <- function(data, year, month, weekend) {
         days[-1, "name"] <- paste(days[-1, "name"], "(continued)")
       }
 
+      days$"n_days" <- (as.Date(days$"to") - as.Date(days$"from"))
+
+      if(case == "single_day") {
+        days$"to" <- NA 
+      }
+
       events <- rbind(events, days)
     }
 
-    events$"n_days" <- (as.Date(events$"to") - as.Date(events$"from"))
-
     events <- events[with(events, order(from, -n_days, name)), ]
 
     rownames(events) <- NULL