Plotting Functions

[spsanderson]

This package is in need of some nice plots that can either be ggplot2 or plotly plots, interactivity is nice. Since this package will have in the future support to generate 3D walks I think plotly would be good to have, where 1D and 2D plots are made with ggplot2 and exported as .interactive via ggplotly and 3D walks are just made in plotly.

Here are some ideas as an issue

#33

Here are some ideas from code to viz:

library(RandomWalker)

df <- rw30()
head(df)
atb <- attributes(df)

df |>
  dplyr::group_by(walk_number) |>
  dplyr::mutate(
    distance = sqrt((x - dplyr::lag(x,1))^2 + (y - dplyr::lag(y,1))^2)
  ) |>
  dplyr::mutate(distance = ifelse(is.na(distance), NA_real_, distance)) |>
  dplyr::ungroup() |> 
  tidyr::drop_na() |>
  ggplot2::ggplot(ggplot2::aes(x = x, y = distance, group = walk_number)) +
  ggplot2::geom_line(alpha = .2) +
  ggplot2::theme_minimal() +
  ggplot2::theme(legend.position = "none") +
  ggplot2::labs(
    title = paste0(atb$num_walks, " Random Walks"),
    subtitle = paste0("Distance between steps for each walk ",
                      "calculated as the Euclidean distance between ",
                      "consecutive steps."),
    caption = paste0(atb$dimension, " dimensions, ", atb$num_steps, " steps, ",
                     "mu = ", atb$mu, ", sd = ", atb$sd, "."),
    x = "Step",
    y = "Distance",
    color = "Walk Number"
  )
  
df |>
  dplyr::group_by(walk_number) |>
  dplyr::mutate(
    distance = sqrt((x - dplyr::lag(x,1))^2 + (y - dplyr::lag(y,1))^2)
  ) |>
  dplyr::mutate(distance = ifelse(is.na(distance), NA_real_, distance)) |>
  dplyr::ungroup() |> 
  tidyr::drop_na() |>
  ggplot2::ggplot(ggplot2::aes(x = x, y = distance, group = walk_number,
                               color = as.numeric(walk_number))) +
  ggplot2::geom_line(alpha = .2) +
  ggplot2::theme_minimal() +
  ggplot2::theme(legend.position = "none") +
  ggplot2::labs(
    title = paste0(atb$num_walks, " Random Walks"),
    subtitle = paste0("Distance between steps for each walk ",
                      "calculated as the Euclidean distance between ",
                      "consecutive steps."),
    caption = paste0(atb$dimension, " dimensions, ", atb$num_steps, " steps, ",
                     "mu = ", atb$mu, ", sd = ", atb$sd, "."),
    x = "Step",
    y = "Distance",
    color = "Walk Number"
  )

df |>
  ggplot2::ggplot(ggplot2::aes(x = x, y = y, group = walk_number,
                               color = as.numeric(walk_number))) +
  ggplot2::geom_line(alpha = (1/atb$num_walks)*10) +
  ggplot2::theme_minimal() +
  ggplot2::theme(legend.position = "none") +
  ggplot2::labs(
    title = paste0(atb$num_walks, " Random Walks"),
    subtitle = paste0("Function: ", atb$fns),
    caption = paste0(atb$dimension, " dimensions, ", atb$num_steps, " steps, ",
                     "mu = ", atb$mu, ", sd = ", atb$sd, "."),
    x = "Step",
    y = "Random Value",
    color = "Walk Number"
  )

df |>
  ggplot2::ggplot(ggplot2::aes(x = x, y = y, group = walk_number,
                               color = walk_number)) +
  ggplot2::geom_line(alpha = (1/atb$num_walks)*10) +
  ggplot2::theme_minimal() +
  ggplot2::theme(legend.position = "none") +
  ggplot2::labs(
    title = paste0(atb$num_walks, " Random Walks"),
    subtitle = paste0("Function: ", atb$fns),
    caption = paste0(atb$dimension, " dimensions, ", atb$num_steps, " steps, ",
                     "mu = ", atb$mu, ", sd = ", atb$sd, "."),
    x = "Step",
    y = "Random Value",
    color = "Walk Number"
  )

df |>
  dplyr::group_by(x) |>
  dplyr::mutate(
    ci_lo = ifelse(y != 0, -1.96 * sqrt(x), 0),
    ci_hi = ifelse(y != 0, 1.96 * sqrt(x), 0)
  ) |>
  dplyr::ungroup() |>
  ggplot2::ggplot(ggplot2::aes(x = x, y = y,
                               group = walk_number, 
                               color = as.numeric(walk_number))) +
  ggplot2::geom_line(alpha = (1/atb$num_walks)*10) +
  ggplot2::geom_line(ggplot2::aes(y = ci_lo), linetype = "dashed", color = "black") +
  ggplot2::geom_line(ggplot2::aes(y = ci_hi), linetype = "dashed", color = "black") +
  ggplot2::theme_minimal() +
  ggplot2::theme(legend.position = "none") +
  ggplot2::labs(
    title = paste0(atb$num_walks, " Random Walks"),
    subtitle = paste0("Function: ", atb$fns),
    caption = paste0(atb$dimension, " dimensions, ", atb$num_steps, " steps, ",
                     "mu = ", atb$mu, ", sd = ", atb$sd, "."),
    x = "Step",
    y = "Random Value",
    color = "Walk Number"
  )

df |>
  dplyr::group_by(walk_number) |>
  dplyr::mutate(
    max_y = max(y),
    min_y = min(y)
  ) |>
  dplyr::filter(walk_number %in% c(1, 30)) |>
  dplyr::mutate(
    ci_lo = y - 1.96 * y / sqrt(x),
    ci_hi = y + 1.96 * y / sqrt(x)
  ) |>
  dplyr::ungroup() |>
  ggplot2::ggplot(ggplot2::aes(x = x, y = y,
                               group = walk_number, 
                               color = walk_number)) +
  ggplot2::geom_line(alpha = (1/atb$num_walks)*10) +
  ggplot2::geom_line(ggplot2::aes(y = ci_lo), linetype = "dashed"
                     , linewidth = 1/atb$num_walks) +
  ggplot2::geom_line(ggplot2::aes(y = ci_hi), linetype = "dashed"
                     , linewidth = 1/atb$num_walks) +
  ggplot2::theme_minimal() +
  ggplot2::theme(legend.position = "none") +
  ggplot2::labs(
    title = paste0(atb$num_walks, " Random Walks"),
    subtitle = paste0("Function: ", atb$fns),
    caption = paste0(atb$dimension, " dimensions, ", atb$num_steps, " steps, ",
                     "mu = ", atb$mu, ", sd = ", atb$sd, "."),
    x = "Step",
    y = "Random Value",
    color = "Walk Number"
  )

walks <- df |>
  dplyr::mutate(
    max_y = max(y),
    min_y = min(y)
  ) |>
  dplyr::filter(y == min_y | y == max_y) |>
  dplyr::select(walk_number)

df |>
  dplyr::filter(walk_number %in% walks[["walk_number"]]) |>
  dplyr::mutate(
    ci_lo = y - 1.96 * y / sqrt(x),
    ci_hi = y + 1.96 * y / sqrt(x)
  ) |>
  dplyr::ungroup() |>
  ggplot2::ggplot(ggplot2::aes(x = x, y = y,
                               group = walk_number, 
                               color = walk_number)) +
  ggplot2::geom_line(alpha = (1/atb$num_walks)*10) +
  ggplot2::geom_line(ggplot2::aes(y = ci_lo), linetype = "dashed"
                     , linewidth = 1/atb$num_walks) +
  ggplot2::geom_line(ggplot2::aes(y = ci_hi), linetype = "dashed"
                     , linewidth = 1/atb$num_walks) +
  ggplot2::theme_minimal() +
  ggplot2::theme(legend.position = "none") +
  ggplot2::labs(
    title = paste0(atb$num_walks, " Random Walks"),
    subtitle = paste0("Function: ", atb$fns),
    caption = paste0(atb$dimension, " dimensions, ", atb$num_steps, " steps, ",
                     "mu = ", atb$mu, ", sd = ", atb$sd, "."),
    x = "Step",
    y = "Random Value",
    color = "Walk Number"
  )

walks <- df |>
  dplyr::group_by(x) |>
  dplyr::mutate(
    ci_lo = ifelse(y != 0, -1.96 * sqrt(x), 0),
    ci_hi = ifelse(y != 0, 1.96 * sqrt(x), 0)
  ) |>
  dplyr::ungroup() |>
  dplyr::mutate(
    under_ci_lo = y < ci_lo,
    over_ci_hi = y > ci_hi
  ) |>
  dplyr::filter(under_ci_lo | over_ci_hi) |>
  dplyr::select(walk_number) |>
  dplyr::distinct()

df |>
  dplyr::group_by(x) |>
  dplyr::mutate(
    ci_lo = ifelse(y != 0, -1.96 * sqrt(x), 0),
    ci_hi = ifelse(y != 0, 1.96 * sqrt(x), 0)
  ) |>
  dplyr::ungroup() |>
  dplyr::filter(!walk_number %in% walks[["walk_number"]]) |>
  ggplot2::ggplot(ggplot2::aes(x = x, y = y, group = walk_number, color = walk_number)) +
  ggplot2::geom_line(alpha = (1/atb$num_walks)*10) +
  ggplot2::geom_line(ggplot2::aes(y = ci_lo), linetype = "dashed", color = "black") +
  ggplot2::geom_line(ggplot2::aes(y = ci_hi), linetype = "dashed", color = "black") +
  ggplot2::theme_minimal() +
  #ggplot2::theme(legend.position = "none") +
  ggplot2::labs(
    title = paste0(atb$num_walks, " Random Walks"),
    subtitle = paste0("Function: ", atb$fns),
    caption = paste0(atb$dimension, " dimensions, ", atb$num_steps, " steps, ",
                     "mu = ", atb$mu, ", sd = ", atb$sd, "."),
    x = "Step",
    y = "Random Value",
    color = "Walk Number"
  )

And compliment of walks %in% ...

[spsanderson]

I am not sure if each of these should be different functions that are callable or should be called inside a main plotting function that calls one from some argument, like .plot_type = 1 or something like that.

[AnttiRask]

@spsanderson, I started with the basic visualization function. It works with all the different functions in the package.

EDIT: I edited the caption to reflect the chosen function.

visualize_walks <- function(data, walk_number_as_numeric = TRUE) {
    
    atb <- attributes(data)
    
    # Colors
    if (walk_number_as_numeric == TRUE) { 
        data$.color <- as.numeric(data$walk_number)
    } else {
        data$.color <- data$walk_number
    }
    
    # Caption
    
    if (atb$fns == "rw30") {
        .caption <- paste0(
            atb$dimension,
            " dimensions, ",
            atb$num_steps,
            " steps, ",
            "mu = ",
            atb$mu,
            ", sd = ",
            atb$sd,
            "."
        )
    } else if (atb$fns %in% c("random_normal_drift_walk", "random_normal_walk")) {
        .caption <- paste0(
            atb$dimension,
            " dimensions, ",
            "mu = ",
            atb$mu,
            ", sd = ",
            atb$sd,
            "."
        )
    } else if (atb$fns %in% c("brownian_motion", "discrete_walk", "geometric_brownian_motion")) {
        .caption <- paste0(
            atb$dimension,
            " dimensions, ",
            "."
        )
    }
    
    ggplot2::ggplot(
        data = data,
        ggplot2::aes(
            x     = x,
            y     = y,
            group = walk_number,
            color = .color
        )
    ) +
        ggplot2::geom_line(alpha = (1/atb$num_walks)*10) +
        ggplot2::theme_minimal() +
        ggplot2::theme(legend.position = "none") +
        ggplot2::labs(
            title    = paste0(atb$num_walks, " Random Walks"),
            subtitle = paste0("Function: ", atb$fns),
            caption  = .caption,
            x        = "Step",
            y        = "Random Value"
        )
}

And here's what the plots look like:

rw30() |>
    visualize_walks(walk_number_as_numeric = TRUE)

rw30() |>
    visualize_walks(walk_number_as_numeric = FALSE)

And the rest of the functions with the default settings (walk_number_as_numeric = TRUE):

random_normal_walk() |>
    visualize_walks()

random_normal_drift_walk() |>
    visualize_walks()

geometric_brownian_motion() |>
    visualize_walks()

discrete_walk() |> 
    visualize_walks()

brownian_motion() |>
    visualize_walks()

I would start by creating the other plot types individually. And after that, I would see whether it would make sense to combine them or not. What do you think?

[spsanderson]

Something is off with the discrete one, but awesome first attempt. Let me read it over and think on it and play with it! The user should also be able to select what y is i think as some functions return more than just y

[AnttiRask]

Thanks!

And I think I got it. Where the other ones want to use y as y, the discrete one wants to use cum_sum as y. Here's the updated code that does the trick (also for the axis labels).

If there are other instances where y could/should, in fact, be something else, it's easy to tweak the code to accommodate that. Since I'm not an expert on random walks, what are the cases where you would want to choose something different?

visualize_walks <- function(data, walk_number_as_numeric = TRUE) {
    
    atb <- attributes(data)
    
    # Y
    if (atb$fns == "discrete_walk") {
        .y     <- data$cum_sum
        .y_lab <- "Cumulative Sum"
    } else {
        .y <- data$y
        .y_lab <- "Random Value"
    }
    
    # Color
    if (walk_number_as_numeric == TRUE) { 
        data$.color <- as.numeric(data$walk_number)
    } else {
        data$.color <- data$walk_number
    }
    
    # Caption
    if (atb$fns == "rw30") {
        .caption <- paste0(
            atb$dimension,
            " dimensions, ",
            atb$num_steps,
            " steps, ",
            "mu = ",
            atb$mu,
            ", sd = ",
            atb$sd,
            "."
        )
    } else if (atb$fns %in% c("random_normal_drift_walk", "random_normal_walk")) {
        .caption <- paste0(
            atb$dimension,
            " dimensions, ",
            "mu = ",
            atb$mu,
            ", sd = ",
            atb$sd,
            "."
        )
    } else if (atb$fns %in% c("brownian_motion", "discrete_walk", "geometric_brownian_motion")) {
        .caption <- paste0(
            atb$dimension,
            " dimensions, ",
            "."
        )
    }
    
    ggplot2::ggplot(
        data = data,
        ggplot2::aes(
            x     = x,
            y     = .y,
            group = walk_number,
            color = .color
        )
    ) +
        ggplot2::geom_line(alpha = (1/atb$num_walks)*10) +
        ggplot2::theme_minimal() +
        ggplot2::theme(legend.position = "none") +
        ggplot2::labs(
            title    = paste0(atb$num_walks, " Random Walks"),
            subtitle = paste0("Function: ", atb$fns),
            caption  = .caption,
            x        = "Step",
            y        = .y_lab
        )
}

discrete_walk() |>
visualize_walks()

[spsanderson]

Here are the functions that return more than just y

> head(discrete_walk(), 1)
# A tibble: 1 × 7
  walk_number     x     y cum_sum cum_prod cum_min cum_max
  <fct>       <int> <dbl>   <dbl>    <dbl>   <dbl>   <dbl>
1 1               1    -1      99        0      99      99

> head(random_normal_walk(), 1)
# A tibble: 1 × 7
  walk_number     x      y cum_sum cum_prod cum_min cum_max
  <fct>       <int>  <dbl>   <dbl>    <dbl>   <dbl>   <dbl>
1 1               1 -0.118  -0.118        0  -0.118  -0.118

Maybe it is a design flaw to have these other columns returned, maybe it should really only be walk_number, x and y and things like cum_sum, cum_prod, etc should be functions that mutate y, or cum_sum, cum_prod, cum_min and cum_max should just be standard output on all functions.

Then whatever column is passed as y we could have a parameter for color and then generate the walk. I see things like the confidence intervals and resulting bands as add on layers

What do you think on that?

[AnttiRask]

@spsanderson, the only problem is that I've never done this part before.

I can look at some of the functions you've created and copy the idea, but if there's anything else that needs to be done or I should know, I don't.

But maybe I'll try it and make a pull request for you to review and we'll go on from there. I'll also try to create those helper functions on their own, using that naming convention.

If I've understood my role correctly, here's my information for the DESCRIPTION file. Feel free to disagree and/or correct the role(s) if necessary:

c(
person(
"Antti",
"Rask",
email = "[email protected]",
role = c("aut", "cph"),
comment = c(ORCID = "0009-0006-7661-8247")
)
)

I will try to get this done tomorrow, but it might not happen until the weekend.

And one last thing, I'm not super happy about the colour part, yet. If you don't mind, I'll take away the option to switch between the two in this first version. I think it should be rethought a bit. And I need to understand better what the use case and user need for using colors are.

[spsanderson]

Just give it a try! I didn't know anything when i started but it's been a fun journey learning.

[AnttiRask]

I will. By the way, here's what's coming. The only customization for the user at the moment is the alpha value. I'm happy with the default, but it's now super easy to change it to whatever.

visualize_walks <- function(data, alpha = 0.7) {

  # Retrieve the attributes of the data
  atb <- attributes(data)

  # Function to generate a plot for a given variable
  generate_plot <- function(y_var) {

    # Convert y_label to a pretty format if it's not "y"
    y_label_pretty <- if (y_var == "y") "y" else convert_snake_to_title_case(y_var)

    # Create a ggplot object
    ggplot2::ggplot(data, ggplot2::aes(x = x, y = get(y_var), color = walk_number)) +
      # Plot lines with some transparency
      ggplot2::geom_line(alpha = alpha) +
      # Use a minimal theme
      ggplot2::theme_minimal() +
      # Remove the legend
      ggplot2::theme(legend.position = "none") +
      # Set the labels for the plot
      ggplot2::labs(title = y_label_pretty, x = "Step", y = NULL)
  }

  # Identify variables to plot, excluding 'walk_number' and 'x'
  plot_vars <- setdiff(atb$names, c("walk_number", "x"))

  # Generate a list of plots for each variable
  plots <- lapply(plot_vars, generate_plot)

  # Generate a subtitle for the combined plot based on the function name
  .subtitle <- paste0("Function: ", if (atb$fns == "rw30") "rw30" else convert_snake_to_title_case(atb$fns))

  # Generate the plot caption dynamically based on attributes
  .caption <- generate_caption(atb)

  # Define annotations for the combined plot
  plot_annotations <- patchwork::plot_annotation(
    title    = paste0(atb$num_walks, " Random Walks"),
    subtitle = .subtitle,
    caption  = .caption
  )

  # Combine the individual plots into a single plot, or return the single plot with annotations
  combined_plot <- if (length(plots) > 1) {
    patchwork::wrap_plots(plots) + plot_annotations
  } else {
    plots[[1]] + plot_annotations
  }

  # Return the final combined plot
  return(combined_plot)
}

I'm sure there are minor things to be tweaked still, but I'm quite happy about this for version 1.

You can also already let me know which direction you want us to go next! 3D or interactive? Both were on the table if I remember correctly...

[spsanderson]

Awesome! when you are ready to push the files, do one function at a time. Interactive would be next, as 3D is going to require us to get up to the 3D walks. Looking for to the PR :)

[AnttiRask]

I was too fast! Pushed all three in the same go...

[spsanderson]

I just pushed a fix

…

On Tue, Jul 30, 2024 at 3:22 PM Antti Rask ***@***.***> wrote: I tested the functions after you made the updates. brownian_motion(), discrete_walk(), geometric_brownian_motion(), random_normal_walk(), and rw30() seem to be working fine. random_normal_drift_walk() seems to be causing problems. I get this error message: Error in random_normal_drift_walk() : object 'initial_value' not found Called from: rand_walk_helper(dplyr::ungroup(dplyr::arrange(dplyr::select(dplyr::mutate(tidyr::pivot_longer(walks_tibble, cols = -x, names_to = "walk_number", values_to = "y"), walk_number = factor(walk_number, levels = 1:num_walks)), walk_number, x, y, dplyr::everything()), walk_number, x)), .value = initial_value) This from the debugger: function (.data, .value) { initial_value = as.numeric(.value) df <- dplyr::ungroup(dplyr::mutate(dplyr::group_by(.data, walk_number), cum_sum = initial_value + cumsum(y), cum_prod = initial_value * cumprod(1 + y), cum_min = initial_value + cummin(y), cum_max = initial_value + cummax(y), cum_mean = initial_value + cmean(y))) return(df) } In other news, cumulative mean looks good to me (with random_normal_walk() and discrete_walk()): image.png (view on web) <https://github.com/user-attachments/assets/fc4e1cee-293c-483c-bde3-e61eecae9246> — Reply to this email directly, view it on GitHub <#36 (reply in thread)>, or unsubscribe <https://github.com/notifications/unsubscribe-auth/AAPCNS7F7HEQNHG5I7LTEVTZO7RZDAVCNFSM6AAAAABLIPM3CKVHI2DSMVQWIX3LMV43URDJONRXK43TNFXW4Q3PNVWWK3TUHMYTAMJZGQYTIMI> . You are receiving this because you were mentioned.Message ID: ***@***.*** com>

-- Steven P Sanderson II, MPH Amazon Author Profile <https://www.amazon.com/stores/Steven-P.-Sanderson/author/B0CZ157DHK?ref_=pe_2466670_811284380&isDramIntegrated=true&shoppingPortalEnabled=true> Book on Lulu <http://goo.gl/lmrlFI> Personal Site <http://www.spsanderson.com>

[spsanderson]

site and main/developement branches are up to date :)

[AnttiRask]

Awesome!