added support for discrete x axis

R/geom_bump.R

@@ -1,13 +1,37 @@
 # ** StatBump ------------------------------------------------------------------
 StatBump <- ggplot2::ggproto("StatBump", ggplot2::Stat,
-                             compute_group = function(data, scales, smooth, direction = direction) {
-                               if(nrow(data) == 1) {
-                                 warning("'StatBump' needs at least two observations per group")
-                                 return(data %>% dplyr::slice(0))
-                               }
+                             setup_data = function(data, params) {
+                               # Create x_lag, and y_lag to be passed to `compute_group`
+                               # Factors need this to be able to compute a sigmoid function
+                               data <- data %>%
+                                 dplyr::mutate(r = dplyr::row_number()) %>%
+                                 dplyr::arrange(x) %>%
+                                 dplyr::group_by_at(vars(-PANEL, -group, -x, -y, -r)) %>%
+                                 dplyr::mutate(x_lag = dplyr::lag(x),
+                                               y_lag = dplyr::lag(y)) %>%
+                                 dplyr::ungroup() %>%
+                                 dplyr::arrange(r) %>%
+                                 dplyr::select(-.data$r) %>%
+                                 as.data.frame()
+                               data
+                             },
+                             compute_group = function(data, scales, smooth, direction) {
                                data <- data %>%
                                  dplyr::arrange(x)
 
+                               # Handling of the special case of factors
+                               # Factors come as a df with one row
+                               if(nrow(data) == 1) {
+                                 if(is.na(data$x_lag) | is.na(data$y_lag)) {
+                                   return(data %>% dplyr::slice(0))
+                                 } else {
+                                   out <- sigmoid(data$x_lag, data$x, data$y_lag, data$y,
+                                                  smooth = smooth, direction = direction)
+                                   return(as.data.frame(out))
+                                 }
+                               }
+
+                               # Normal case
                                out <-rank_sigmoid(data$x, data$y, smooth = smooth, direction = direction) %>%
                                  dplyr::mutate(key = 1) %>%
                                  dplyr::left_join(data %>%
@@ -28,6 +52,8 @@ StatBump <- ggplot2::ggproto("StatBump", ggplot2::Stat,
 #'
 #' Creates a ggplot that makes a smooth rank over time. To change the `smooth`
 #' argument you need to put it outside of the `aes` of the geom. Uses the x and y aestethics.
+#' Usually you want to compare multiple lines and if so, use the `color` aestethic.
+#' To change the direction of the curve to 'vertical' set `direction = "y`
 #'
 #' @param mapping provide you own mapping. both x and y need to be numeric.
 #' @param data provide you own data
@@ -44,6 +70,7 @@ StatBump <- ggplot2::ggproto("StatBump", ggplot2::Stat,
 #'
 #' @examples
 #' library(ggplot2)
+#' library(ggbump)
 #' df <- data.frame(country = c(
 #'   "India", "India", "India",
 #'   "Sweden", "Sweden", "Sweden",
@@ -53,12 +80,21 @@ StatBump <- ggplot2::ggproto("StatBump", ggplot2::Stat,
 #' 2011, 2012, 2013,
 #' 2011, 2012, 2013,
 #' 2011, 2012, 2013),
+#' month = c("January", "July", "November",
+#'           "January", "July", "November",
+#'           "January", "July", "November",
+#'           "January", "July", "November"),
 #' rank = c(4, 2, 2, 3, 1, 4, 2, 3, 1, 1, 4, 3))
 #'
+#' # Contingous x axis
 #' ggplot(df, aes(year, rank, color = country)) +
 #'   geom_point(size = 10) +
 #'   geom_bump(size = 2)
 #'
+#' # Discrete x axis
+#' ggplot(df, aes(month, rank, color = country)) +
+#'   geom_bump(size = 2)
+#'
 #' @export
 geom_bump <- function(mapping = NULL, data = NULL, geom = "line",
                       position = "identity", na.rm = FALSE, show.legend = NA,

R/geom_sigmoid.R

@@ -6,6 +6,8 @@ StatSigmoid <- ggplot2::ggproto("StatSigmoid", ggplot2::Stat,
                                     dplyr::group_by(PANEL) %>%
                                     dplyr::mutate(group = dplyr::row_number()) %>%
                                     as.data.frame()
+                                  data %>% print()
+                                  data
                                 },
                                 compute_group = function(data, scales, smooth, direction) {
                                   out <- sigmoid(data$x, data$xend, data$y, data$yend,

README.Rmd

@@ -170,56 +170,41 @@ ggplot(df, aes(year, rank, color = country)) +
   scale_color_manual(values = wes_palette(n = 4, name = "GrandBudapest1"))
 ```
 
-## geom_bump with factors
+## geom_bump with factors (development version only)
 
-To use `geom_bump` with factors or character axis you need to prepare the data frame before. You need to prepare one column for the numeric position and one column with the name. If you want to have character/factor on both y and x you need to prepare 4 columns.
+You can use `geom_bump` with factors or character as x axis. Just remember to keep an eye on factor order. 
 
 ```{r, fig.height=2.5, fig.width = 7, echo = TRUE}
 # Original df
-df <- tibble(season = c("Spring", "Summer", "Autumn", "Winter", 
-                        "Spring", "Summer", "Autumn", "Winter", 
-                        "Spring", "Summer", "Autumn", "Winter"),
-             position = c("Gold", "Gold", "Bronze", "Gold",
-                          "Silver", "Bronze", "Gold", "Silver",
-                          "Bronze", "Silver", "Silver", "Bronze"),
-             player = c(rep("David", 4),
-                        rep("Anna", 4),
-                        rep("Franz", 4)))
-
-# Create factors and numeric columns
+df <- tibble(season = c("Spring", "Pre-season", "Summer", "Season finale", "Autumn", "Winter", 
+                        "Spring", "Pre-season", "Summer", "Season finale", "Autumn", "Winter", 
+                        "Spring", "Pre-season", "Summer", "Season finale", "Autumn", "Winter",
+                        "Spring", "Pre-season", "Summer", "Season finale", "Autumn", "Winter"),
+             rank = c(1, 3, 4, 2, 1, 4,
+                      2, 4, 1, 3, 2, 3,
+                      4, 1, 2, 4, 4, 1,
+                      3, 2, 3, 1, 3, 2),
+             player = c(rep("David", 6),
+                        rep("Anna", 6),
+                        rep("Franz", 6),
+                        rep("Ika", 6)))
+
+# Create factors and order factor
 df <- df %>% 
-  mutate(season = factor(season, 
-                         levels = c("Spring", "Summer", "Autumn", "Winter")),
-         x = as.numeric(season),
-         position = factor(position, 
-                           levels = c("Gold", "Silver", "Bronze")),
-         y = as.numeric(position))
+  mutate(season = factor(season, levels = unique(season)))
 
 # Add manual axis labels to plot
-p <- ggplot(df, aes(x, y, color = player)) +
-  geom_bump(size = 2, smooth = 8, show.legend = F) +
+ggplot(df, aes(season, rank, color = player)) +
+  geom_bump(size = 2, smooth = 20, show.legend = F) +
   geom_point(size = 5, aes(shape = player)) +
-  scale_x_continuous(breaks = df$x %>% unique(),
-                     labels = df$season %>% levels()) +
-  scale_y_reverse(breaks = df$y %>% unique(),
-                     labels = df$position %>% levels())
-p
-```
-
-### And some nice theme features
-
-```{r, fig.height=3, fig.width = 7, echo = TRUE}
-p +
-  theme_minimal_grid(font_size = 14, line_size = 0) +
+  theme_minimal_grid(font_size = 10, line_size = 0) +
   theme(panel.grid.major = element_blank(),
         axis.ticks = element_blank()) +
-  labs(y = "Medal",
-       x = "Season",
-       color = NULL,
-       shape = NULL) +
-  scale_color_manual(values = wes_palette(n = 3, name = "IsleofDogs1"))
+  scale_color_manual(values = wes_palette(n = 4, name = "IsleofDogs1"))
+
 ```
 
+
 ## Feedback
 
 If you find any error or have suggestions for improvements you are more than welcome to contact me :)

README.md

@@ -170,62 +170,41 @@ ggplot(df, aes(year, rank, color = country)) +
 
 <img src="man/figures/README-unnamed-chunk-3-1.png" width="100%" />
 
-## geom\_bump with factors
+## geom\_bump with factors (development version only)
 
-To use `geom_bump` with factors or character axis you need to prepare
-the data frame before. You need to prepare one column for the numeric
-position and one column with the name. If you want to have
-character/factor on both y and x you need to prepare 4 columns.
+You can use `geom_bump` with factors or character as x axis. Just
+remember to keep an eye on factor order.
 
 ``` r
 # Original df
-df <- tibble(season = c("Spring", "Summer", "Autumn", "Winter", 
-                        "Spring", "Summer", "Autumn", "Winter", 
-                        "Spring", "Summer", "Autumn", "Winter"),
-             position = c("Gold", "Gold", "Bronze", "Gold",
-                          "Silver", "Bronze", "Gold", "Silver",
-                          "Bronze", "Silver", "Silver", "Bronze"),
-             player = c(rep("David", 4),
-                        rep("Anna", 4),
-                        rep("Franz", 4)))
-
-# Create factors and numeric columns
+df <- tibble(season = c("Spring", "Pre-season", "Summer", "Season finale", "Autumn", "Winter", 
+                        "Spring", "Pre-season", "Summer", "Season finale", "Autumn", "Winter", 
+                        "Spring", "Pre-season", "Summer", "Season finale", "Autumn", "Winter",
+                        "Spring", "Pre-season", "Summer", "Season finale", "Autumn", "Winter"),
+             rank = c(1, 3, 4, 2, 1, 4,
+                      2, 4, 1, 3, 2, 3,
+                      4, 1, 2, 4, 4, 1,
+                      3, 2, 3, 1, 3, 2),
+             player = c(rep("David", 6),
+                        rep("Anna", 6),
+                        rep("Franz", 6),
+                        rep("Ika", 6)))
+
+# Create factors and order factor
 df <- df %>% 
-  mutate(season = factor(season, 
-                         levels = c("Spring", "Summer", "Autumn", "Winter")),
-         x = as.numeric(season),
-         position = factor(position, 
-                           levels = c("Gold", "Silver", "Bronze")),
-         y = as.numeric(position))
+  mutate(season = factor(season, levels = unique(season)))
 
 # Add manual axis labels to plot
-p <- ggplot(df, aes(x, y, color = player)) +
-  geom_bump(size = 2, smooth = 8, show.legend = F) +
+ggplot(df, aes(season, rank, color = player)) +
+  geom_bump(size = 2, smooth = 20, show.legend = F) +
   geom_point(size = 5, aes(shape = player)) +
-  scale_x_continuous(breaks = df$x %>% unique(),
-                     labels = df$season %>% levels()) +
-  scale_y_reverse(breaks = df$y %>% unique(),
-                     labels = df$position %>% levels())
-p
-```
-
-<img src="man/figures/README-unnamed-chunk-4-1.png" width="100%" />
-
-### And some nice theme features
-
-``` r
-p +
-  theme_minimal_grid(font_size = 14, line_size = 0) +
+  theme_minimal_grid(font_size = 10, line_size = 0) +
   theme(panel.grid.major = element_blank(),
         axis.ticks = element_blank()) +
-  labs(y = "Medal",
-       x = "Season",
-       color = NULL,
-       shape = NULL) +
-  scale_color_manual(values = wes_palette(n = 3, name = "IsleofDogs1"))
+  scale_color_manual(values = wes_palette(n = 4, name = "IsleofDogs1"))
 ```
 
-<img src="man/figures/README-unnamed-chunk-5-1.png" width="100%" />
+<img src="man/figures/README-unnamed-chunk-4-1.png" width="100%" />
 
 ## Feedback