Merge remote-tracking branch 'swirldev/master'

Data_Analysis/Dispersion/lesson.yaml

@@ -161,7 +161,7 @@
 - Class: text
   Output: Let's take a closer look at how quartiles are calculated. We start by sorting
     the data from least to greatest, just like when calculating the median. The first
-    quartile (Q1), also known at the 25th PERCENTILE (since 25% of the data points
+    quartile (Q1), also known as the 25th PERCENTILE (since 25% of the data points
     fall at or below this value), is simply the median of the first half of the sorted
     data. Likewise, the third quartile (Q3), also known as the 75th percentile, is
     the median of the second half of the sorted data.

Getting_and_Cleaning_Data/Dates_and_Times_with_lubridate/customTests.R

@@ -0,0 +1,94 @@
+func_uses_args <- function(...) {
+  e <- get("e", parent.frame())
+  # Get user's expression
+  expr <- e$expr
+  # Capture names of correct args
+  correct_args <- list(...)
+  # If expr is assignment, just get the rhs
+  if(is(expr, "<-")) expr <- expr[[3]]
+  # Check for the presence of each correct arg in the expr names
+  match_found <- try(sapply(correct_args, function(arg) arg %in% names(expr)))
+  # If something is weird, return FALSE
+  if(!all(is.logical(match_found))) {
+    return(FALSE)
+  }
+  # Did we find all desired args?
+  all(match_found)
+}
+
+match_call <- function(correct_call = NULL) {
+  e <- get("e", parent.frame())
+  # Trivial case
+  if(is.null(correct_call)) return(TRUE)
+  # Get full correct call
+  full_correct_call <- expand_call(correct_call)
+  # Expand user's expression
+  expr <- deparse(e$expr)
+  full_user_expr <- try(expand_call(expr), silent = TRUE)
+  # Check if expansion went okay
+  if(is(full_user_expr, "try-error")) return(FALSE)
+  # Compare function calls with full arg names
+  identical(full_correct_call, full_user_expr)
+}
+
+# Utility function for match_call answer test
+# Fills out a function call with full argument names
+expand_call <- function(call_string) {
+  # Quote expression
+  qcall <- parse(text=call_string)[[1]]
+  # If expression is not greater than length 1...
+  if(length(qcall) <= 1) return(qcall)
+  # See if it's an assignment
+  is_assign <- is(qcall, "<-")
+  # If assignment, process righthandside
+  if(is_assign) {
+    # Get righthand side
+    rhs <- qcall[[3]]
+    # If righthand side is not a call, can't use match.fun()
+    if(!is.call(rhs)) return(qcall)
+    # Get function from function name
+    fun <- match.fun(rhs[[1]])
+    # match.call() does not support primitive functions
+    if(is.primitive(fun)) return(qcall)
+    # Get expanded call
+    full_rhs <- match.call(fun, rhs)
+    # Full call
+    qcall[[3]] <- full_rhs
+  } else { # If not assignment, process whole thing
+    # Get function from function name
+    fun <- match.fun(qcall[[1]])
+    # match.call() does not support primitive functions
+    if(is.primitive(fun)) return(qcall)
+    # Full call
+    qcall <- match.call(fun, qcall)
+  }
+  # Return expanded function call
+  qcall
+}
+
+test_arrive_val <- function() {
+  # Get user's value
+  e <- get('e', parent.frame())
+  user_val <- e$val
+  # Get correct value
+  depart <- get('depart', globalenv())
+  correct_val <- depart + hours(15) + minutes(50)
+  # Compare
+  identical(user_val, correct_val)
+}
+
+start_timer <- function() {
+  e <- get('e', parent.frame())
+  e$`__lesson_start_time` <- now()
+  TRUE
+}
+
+stop_timer <- function() {
+  e <- get('e', parent.frame())
+  if(deparse(e$expr) == "stopwatch()") {
+    start_time <- e$`__lesson_start_time`
+    stop_time <- now()
+    print(as.period(new_interval(start_time, stop_time)))
+  }
+  TRUE
+}

Getting_and_Cleaning_Data/Dates_and_Times_with_lubridate/dependson.txt

@@ -0,0 +1 @@
+lubridate

Getting_and_Cleaning_Data/Dates_and_Times_with_lubridate/initLesson.R

@@ -0,0 +1,10 @@
+# Handles time info with ymd_hms()
+dt1 <- '2014-08-23 17:23:02'
+
+# Also handles vectors of date-times
+dt2 <- c('2014-05-14', '2014-09-22', '2014-07-11')
+
+# For last unit of the lesson
+stopwatch <- function() {
+  invisible()
+}

Getting_and_Cleaning_Data/Dates_and_Times_with_lubridate/outline.R

@@ -0,0 +1,89 @@
+library(lubridate)
+help(package=lubridate)
+
+# Huge number of possibilities with lubridate.
+# We'll just cover the basics in this lesson.
+# Give you the confidence to explore further.
+
+# Dates and date-times
+today() # Current day
+now() # Current time
+
+# Pick a date in the past
+ymd('1985-08-25') # most common - big to small
+ymd('1985/08/25') # alternative
+ymd('85-8-25') # make sure you specify year fully
+
+# Also handles vectors of dates
+ymd(c('2014-05-14', '2014-09-22'))
+
+# Often in the US, we refer to mm/dd/yyyy
+mdy('08.25.1985')
+mdy('Aug 25, 1985')
+mdy(08251985)
+
+# Do whatever you want
+dmy('25 August 1985')
+dmy('25081985')
+
+# But be careful, it's not magic!
+ymd('1985825')
+
+# What if we've got time too
+now()
+now(tzone = 'UTC')
+ymd_hms('2014-08-23 17:23:02')
+
+rn <- now()
+rn_tz <- now(tzone = 'UTC')
+
+tz(rn)
+tz(rn_tz)
+
+year(rn)
+month(rn)
+day(rn)
+hour(rn)
+minute(rn)
+second(rn)
+
+wday(rn)
+wday(rn, label = TRUE)
+
+rn
+
+hour(rn) <- 8
+rn
+
+update(rn, year = 2050, second = 0)
+
+
+# Instants - exact moment in time
+
+# Intervals - An interval is a span of time that occurs between two specific instants. The length of an interval is never ambiguous, because we know when it occurs. Moreover, we can calculate the exact length of any unit of time that occurs during it.
+
+# Durations - If we record the time span in seconds, it will have an exact length since seconds always have the same length.
+
+# Periods - Periods record a time span in units larger than seconds, such as years, months, weeks, days, hours, and minutes. For convenience, we can also create a period that only uses seconds, but such a period would have the same properties as a duration.
+
+round_date()
+floor_date()
+ceiling_date()
+
+
+
+
+
+#
+# - Class: text
+# Output: It's been a long time since you've seen your friend, so you are both counting down the hours until you reunite.
+#
+#
+#
+# count down the minutes until you leave
+# friend wants to know when to pick you up from the airport
+#
+
+
+
+