Expanded functionality

R/Individual_plot_map.R

@@ -0,0 +1,132 @@
+#' Individual plot of selected activity by date on google map
+#'
+#' Plots activities over time by month
+#' @param data A data frame output from process_activities()
+#' @param activity_date Date of activity
+#' @param zoom Zoom used by google maps. Depending on activity range it will need to be adjusted. Higher value is higher zoom.
+#' @param label If TRUE each km will be labeled on a map
+#'
+#' @return A plot of activities over time by month
+#' @export
+#'
+# Creates an individual plot of selected activity on google map
+individual_plot_map <- function(data, activity_date = "last", zoom = 14, color = "pace", label = FALSE) {
+
+  # Constants
+  possible_values_color<- c("pace", "elevation", "speed")
+
+  # Check if the color argument is correct
+  if (!(color %in% possible_values_color)) {
+    stop("This argument value for `color` is not available! Use 'pace', 'elevation' or 'speed' instead.")
+  }
+
+  # Check if there is a ele column in the data frame
+  if (color == "ele") {
+    if (sum(colnames(data) == "ele") == 0) {
+      stop("The data frame does not contain 'ele' column! Try running process_data function with argument 'old_gpx_format' = TRUE or use 'pace' or 'speed' instead.")
+    }
+  }
+
+  # Check if the activity_date argument is correct
+  if (activity_date == "last") {
+    data_individual <- data %>%
+      dplyr::filter(Activity.Date == max(Activity.Date))
+  } else if (is.Date(as.Date(activity_date)) == TRUE) { # Check if the argument is given as a date format
+    if(as.Date(activity_date) %in% as.Date(data$Activity.Date)) { # Filter data frame for a given date
+      data_individual <- data %>%
+        dplyr::filter(format(Activity.Date, "%Y-%m-%d") == activity_date)
+    } else {
+      stop("There is no activity found on this date! Change the activity_date argument.")
+    }
+  } else {
+    stop("The date format is wrong! You need to type 'YYYY-MM-DD' in the activity_date argument instead.")
+  }
+
+  # Load time formatter. Source: https://r-graphics.org/recipe-axes-time-rel
+  timeHMS_formatter <- function(x) {
+    h <- floor(x/60)
+    m <- floor(x %% 60)
+    s <- round(60*(x %% 1))                   # Round to nearest second
+    lab <- sprintf('%02d:%02d:%02d', h, m, s) # Format the strings as HH:MM:SS
+    lab <- gsub('^00:', '', lab)              # Remove leading 00: if present
+    lab <- gsub('^0', '', lab)                # Remove leading 0 if present
+  }
+
+  # Adjusting a data frame
+  data_individual<- data_individual %>%
+    dplyr::ungroup() %>%
+    dplyr::select(lon, lat, Activity.Date, dist_to_prev, time_diff_to_prev, cumdist, time, Activity.Type, if (color == "ele") {ele} ) %>%
+    dplyr:: mutate(Activity.Date = as_date(Activity.Date),
+                   pace = (time_diff_to_prev / dist_to_prev / 60), # Add a pace variable in min/km
+                   speed = (1000 * dist_to_prev / time_diff_to_prev) * 3.6, # Add a speed variable in km/h
+                   floor_distance = floor(cumdist)) # Add a floored distance in order to add labels to a plot. It is necessary in data_individual_points.
+
+  # Calculate necessary values for a plot
+  if (color == "pace") {
+    data_individual<- data_individual %>%
+      dplyr::filter(pace < 11.5, pace > 2)
+    mean_pace <- round(mean(data_individual$pace))
+    seq <- seq(mean_pace - 2, mean_pace + 2, by = 1) # Make a sequence to use as a scale in a plot
+    seq_hms <- timeHMS_formatter(seq) # Transform a sequence to time
+    unit = "[min/km]"
+    title = "Pace"
+  } else if (color == "speed"){ #
+    data_individual<- data_individual %>%
+      dplyr::filter(speed < 60, speed > 4)
+    mean_speed <- round(mean(data_individual$speed))
+    unit = "[km/h]"
+    title = "Speed"
+
+    if (max(data_individual$speed) > 35) { # This is done mainly for activities where there are lots of outliers. This makes a scale to take mean speed in a center.
+      seq <- seq(floor(mean_speed * 0.5), ceiling(mean_speed * 1.5), length.out = 5)
+    } else {
+      seq <- seq(0, ceiling(max(data_individual$speed)), length.out = 5)
+    }
+  } else {
+    color = "ele"
+    unit = "[m]"
+    title = "Elevation"
+  }
+
+  # Transform data to use as a label in a plot
+  data_individual_points <- data_individual %>%
+    dplyr::select(lon, lat, floor_distance) %>%
+    dplyr::group_by(floor_distance) %>%
+    dplyr::filter(floor_distance > 0, row_number() == 1)  %>%
+    dplyr::ungroup()
+
+  # Google map plot. Right now Google requires API key to enable using Google Maps.
+  p <- ggmap::ggmap(get_googlemap(center = c(
+    lon = mean_lon <- mean(range(data_individual$lon)),
+    lat = mean(range(data_individual$lat))),
+    zoom = zoom, scale = 2,
+    maptype ='terrain',
+    color = 'color')) +
+    ggplot2::geom_path(data = data_individual, aes(lon, lat, color = !!sym(color)), size = 0.7,
+                       lineend = "round") +
+    labs(title = paste(title, unit, "of", tolower(data_individual$Activity.Type), "activity on", format(as.Date(data_individual$Activity.Date), "%A, %d %B %Y")),
+         y = NULL,
+         x = NULL) +
+    theme(legend.key.width = unit(1.6, "cm"),
+          legend.key.height = unit(0.4, "cm"),
+          legend.title = element_blank(),
+          plot.title = element_text(vjust = 2, hjust = 0.5),
+          axis.ticks = element_blank(),
+          axis.text = element_blank(),
+          legend.position = "bottom")
+
+  # Add a scale on a given color argument
+  if(color == "pace") {
+    p <- p + scale_colour_viridis_c(option = "inferno", direction = -1, labels = seq_hms, limits = c(min(seq), max(seq)))
+  } else if (color == "speed") {
+    p <- p + scale_colour_viridis_c(option = "inferno", direction = 1, labels = seq, limits = c(min(seq), max(seq)), breaks = seq)
+  } else {
+    p <- p + scale_colour_viridis_c(option = "inferno")
+  }
+
+  # Add km labels for progress in the activity
+  if (label) {
+    p  <- p + geom_label(data = data_individual_points, mapping = aes(lon, lat, label = floor_distance), size = 3)
+  }
+  p
+}

R/Month_history_plot.R

@@ -0,0 +1,165 @@
+#' Plots activities over time by month
+#'
+#' Plots activities over time by month
+#' @param data A data frame output from process_activities()
+#' @param by_unit Unit type
+#' @param by_activity Activity type
+#' @param from_date Filtering a date to start from given argument
+#'
+#' @return A plot of activities over time by month
+#' @export
+#'
+# Month history plot
+month_history_plot <- function(data = activities, by_unit = "Distance", by_activity = "All", from_date = "Last 12 months") {
+
+  # Constants
+  possible_values_unit <- c("Distance", "Time", "Count")
+  possible_values_activity <- c("All",
+                                activities %>% dplyr::select(Activity.Type) %>% unique() %>% dplyr::pull())
+
+  if (!(by_unit %in% possible_values_unit)) {
+    stop("This argument value for 'by_activity' is not available! Use 'Distance', 'Time' or 'Count' instead.")
+  }
+
+  # Check if the by_activity argument is correct
+  if (!(by_activity %in% possible_values_activity)) {
+    available_activity_types <- paste0("'", possible_values_activity, "'", collapse  = ", ")
+    stop(paste("This argument value for `by_unit` is not available! Use one of those activities instead:", available_activity_types))
+  }
+
+  # Check if the from_date argument is correct
+  if (!from_date %in% c("All", "Last 12 months")) {
+    if_error <- tryCatch(as.Date(from_date), error = function(i) i)
+    if (any(class(if_error) == "error") == TRUE && is.Date(as_date(from_date)) == TRUE) {
+      stop("This argument value for 'from_date' is not available! Use 'All', 'Last 12 months' or format date as 'YYYY-MM-DD' instead.")
+    }
+  }
+
+  # Adjusting data frame used in further calculations
+  activities_month <- activities %>%
+    dplyr::select(2,4,7, Moving.Time) %>%
+    dplyr::arrange(Activity.Date) %>%
+    dplyr::mutate(Activity.Date = as.Date(lubridate::floor_date(Activity.Date, "month")), Count = 1,)
+
+  # Checking if the from_date argument is correctly formatted
+  if (!from_date %in% c("All", "Last 12 months")) {
+    if (as_date(from_date) > max(activities_month$Activity.Date)) {
+      stop(paste0("This argument value for `from_date` does not contain any activities! The last activity was in ", format(max(activities_month$Activity.Date), format = "%B %Y"), ". Change the starting month before this date."))
+    }
+  }
+
+  # Filtering by activity
+  if (by_activity != "All") {
+    activities_month <- activities_month %>%
+      dplyr::filter(Activity.Type == by_activity)
+  }
+
+  # Make a data frame of months to add months when there was no activity.
+  month_data <- data.frame(Activity.Date = seq.Date(
+    from = floor_date(min(as.Date(activities$Activity.Date)), "month"),
+    to = (floor_date(max(as.Date(activities$Activity.Date)), "month")),
+    by = "month"))
+
+  # Joining two data frames
+  activities_month <- activities_month %>%
+    dplyr::right_join(month_data, by = "Activity.Date") %>%
+    dplyr::arrange(Activity.Date)
+
+  # Adjusting data frame
+  activities_month <- activities_month %>%
+    dplyr::mutate(year = lubridate::year(Activity.Date),
+                  month_int = lubridate::month(Activity.Date),
+                  month = toupper(as.factor(month(Activity.Date, label = TRUE))),
+                  Axis.labels = paste(month, year)) %>% # Making x axis labels
+    dplyr::group_by(year, month_int) %>%
+    dplyr::mutate(Distance = max(cumsum(Distance)),
+                  Time = max(cumsum(Moving.Time) / 3600),
+                  Count = max(cumsum(Count))) %>%
+    tidyr::replace_na(list(Distance = 0, Time = 0, Count = 0)) %>%
+    dplyr::filter(row_number() == 1) %>%
+    dplyr::select(-Moving.Time) %>%
+    dplyr::ungroup()
+
+  # Filter activities by a  given from_date argument
+  if (from_date == "Last 12 months") {
+    activities_month <- activities_month %>%
+      dplyr::filter(Activity.Date >= as.Date(lubridate::floor_date(now(), "month")) - lubridate::years(1))
+  }  else if (from_date !=  "All") {
+    activities_month <- activities_month %>%
+      dplyr::filter(Activity.Date >= as_date(from_date))
+  }
+
+  # Stop if there were no activities in given from_date argument period
+  if (sum(activities_month$Count != 0) == 0) {
+    stop(paste("There were no", tolower(by_activity), "activities in this time period! Choose different argument values."))
+  }
+
+  # Filtering for last month
+  last_activity <- activities_month %>%
+    dplyr::select(Activity.Date, !!sym(by_unit)) %>%
+    dplyr::filter(Activity.Date == last(Activity.Date))
+
+  # Getting value for last month
+  last <- last_activity %>%
+    dplyr::select(-Activity.Date)
+
+  #  Filtering for max in possible units and filter for max in selected unit
+  max_activities_month <- activities_month %>%
+    dplyr::filter(Time == max(Time) | Count == max(Count) | Distance == max(Distance)) %>%
+    dplyr::filter(!!sym(by_unit) == max(!!sym(by_unit)))
+
+  # Getting max value for max month
+  max <- max_activities_month %>%
+    dplyr::select(!!sym(by_unit))
+
+  # Determine units used in a plot
+  if (by_unit == "Distance") {
+    unit_max <- "km"
+    unit <- "km"
+  } else if (by_unit == "Count") {
+    if (max > 1) {
+      unit_max <- "activities"
+    } else {
+      unit_max <- "activity"
+    }
+    if (last > 1) {
+      unit <- "activities"
+    } else {
+      unit <- "activity"
+    }
+  } else {
+    unit_max <- "hours"
+    if (round(last == 1)) {
+      unit <- "hour"
+    } else {
+      unit <- "hours"
+    }
+  }
+
+  # Remove x axis labels to avoid overlapping
+  if(nrow(activities_month) > 24)  {
+    activities_month <- activities_month %>%
+      mutate(Axis.labels = ifelse(!month_int %in% c(1, 4, 7, 10), "", Axis.labels))
+  }
+
+  p <- activities_month %>%
+    ggplot() +
+    geom_col(aes(Activity.Date, !!sym(by_unit)), color = "black", fill = "black", width = 1) +
+    geom_col(data = last_activity, aes(Activity.Date, !!sym(by_unit)), color = "#fc4c02", fill = "#fc4c02", width = 1.1) +
+    geom_point(data = max_activities_month, aes(Activity.Date, !!sym(by_unit)), color = "black", size = 1) +
+    geom_text(data = max_activities_month, aes(Activity.Date, !!sym(by_unit)), size = 3.4, hjust = -0.2, angle = 90, color = "black", label = paste(round(max), unit_max)) +
+    geom_point(data = last_activity, aes(Activity.Date, !!sym(by_unit)), color = "#fc4c02", size = 1) +
+    geom_text(data = last_activity, aes(Activity.Date, !!sym(by_unit)), size = 3.4, hjust = -0.2, angle = 90, color = "#fc4c02", label = paste(round(last), unit)) +
+    theme_minimal() +
+    scale_x_continuous(breaks = activities_month$Activity.Date, labels = activities_month$Axis.labels) +
+    labs(title = "", y = "", x = "") +
+    theme(axis.text.x = element_text(angle = 90, hjust = 1, vjust = 0.5, color = "black"),
+          axis.text.y = element_blank(),
+          panel.grid = element_blank(),
+          panel.background = element_rect(color = "white"),
+          plot.background = element_rect(color = "white"),
+          panel.border = element_blank()) +
+    coord_cartesian(ylim = c(0, 1.4*as.integer(max)))
+
+  p
+}

R/join_data_activities.R

@@ -0,0 +1,16 @@
+#' Joins data and activities data frames
+#'
+#' @export
+#'
+# Join data and activities
+join_data_activities <- function() {
+  activities <- activities[!(activities$Filename==""),]
+  activities <- activities[grepl("gpx$", activities$Filename),]
+
+  #Correcting ID
+  activities <- rowid_to_column(activities, "id")
+
+  #Joining data frames
+  data <- data %>%
+    inner_join(activities, by = "id")
+}

R/plot_facets.R

@@ -5,7 +5,25 @@
 #' @param labels If TRUE, adds distance labels to each facet
 #' @param scales If "fixed", track size reflects absolute distance travelled
 #' @export
-plot_facets <- function(data, labels = FALSE, scales = "free") {
+#'
+# Plot of activities as small multiples
+plot_facets <- function(data, labels = FALSE, scales = "free", color = FALSE) {
+
+  # Constants
+  possible_values_scales<- c("free", "fixed")
+
+  # Check if the scales argument is correct
+  if (!(scales %in% possible_values_scales)) {
+    stop("This argument value for `scales` is not available! Use 'free' or 'fixed' instead!")
+  }
+
+  # Check if the data is joined with activities.
+  if (color) {
+    if (sum(colnames(data) == "Activity.Type") == 0) {
+      stop("The data frame does not contain 'Activity.Type' column. Load activities with process_activities function and run join_data_activities function first!")
+    }
+  }
+
   # Summarise data
   summary <- data %>%
     dplyr::group_by(id) %>%
@@ -16,22 +34,26 @@ plot_facets <- function(data, labels = FALSE, scales = "free") {
   # Decide if tracks will all be scaled to similar size ("free") or if
   # track sizes reflect absolute distance in each dimension ("fixed")
   if (scales == "fixed") {
-    data <- data %>% dplyr::group_by(id) %>% # for each track,
+    data <- data %>%
+      dplyr::group_by(id) %>% # for each track,
       dplyr::mutate(lon = lon - mean(lon), # centre data on zero so facets can
                     lat = lat - mean(lat)) # be plotted on same distance scale
   } else {
     scales = "free" # default, in case a non-valid option was specified
   }
 
-  # Create plot
-  p <- ggplot2::ggplot() +
-    ggplot2::geom_path(ggplot2::aes(lon, lat, group = id), data, size = 0.35, lineend = "round") +
-    ggplot2::facet_wrap(~id, scales = scales) +
-    ggplot2::theme_void() +
+  # Decide if plot is colored by activity type or not and create a plot
+  if (color) {
+    p <- ggplot2::ggplot() + ggplot2::geom_path(ggplot2::aes(lon, lat, group = id, color = Activity.Type), data, size = 0.35, lineend = "round", alpha = 0.5) + ggplot2::scale_color_brewer(palette = "Dark2", name = NULL) # color by activity type
+  } else {
+    p <- ggplot2::ggplot() + ggplot2::geom_path(ggplot2::aes(lon, lat, group = id), data, size = 0.35, lineend = "round")
+  }
+
+  p <- p + ggplot2::facet_wrap(~id, scales = scales) + ggplot2::theme_void() +
     ggplot2::theme(panel.spacing = ggplot2::unit(0, "lines"),
-                   strip.background = ggplot2::element_blank(),
-                   strip.text = ggplot2::element_blank(),
-                   plot.margin = ggplot2::unit(rep(1, 4), "cm"))
+                   strip.background = ggplot2::element_blank(), strip.text = ggplot2::element_blank(),
+                   plot.margin = ggplot2::unit(rep(1, 4), "cm"),
+                   legend.position = "bottom") # place a legend on the bottom of a plot
 
   if (scales == "fixed") {
     p <- p + ggplot2::coord_fixed() # make aspect ratio == 1