R/benjamini_leaves.R

In urswilke/ggbenjamini: Generate ficus benjamina leaf shapes with bezier curves

#' Generate bezier coordinates of a leaf
#'
#' Except the start point coordinates of the leaf origin `x0` & `y0`
#' (arbitrarily set to 10 and 40) all coordinates are relative to this origin.
#' Most of the parameters are random generated, except for some of them (e.g.,
#' to close polygons, or to keep the stalk and the mid vein on the same
#' line).
#'
#'
#' @param x0,y0 coordinates of the leaf origin
#' @param dx10,dy10,dx21,dy21,dx32,dy32,dx43,dy43 coordinates of the other
#'   bezier start & end points
#' @param sx0,sx1,sx2,sx3,sx4 x coordinates of the control points
#' @param sy0,sy1,sy2,sy3,sy4 y coordinates of the control points
#' @param smx1,smx2,smy1,smy2 x & y coordinates of the mid vein control points
#'
#' @return named list of all parameters
#' @export
#'
#' @examples
#' gen_leaf_parameters()
gen_leaf_parameters <- function(
  # starting point (absolute coordinates)
  x0 = 10,
  y0 = 40,
  # distances to starting point (relative coordinates)
  dx10 = sample(8:12, 1),
  dy10 = 0, #For "historic" reasons, because changing it breaks everything...
  dx21 = sample(12:20, 1),
  dy21 = sample(-4:-10, 1),
  dx32 = sample(10:18, 1),
  dy32 = stats::runif(1, 0.92 * (-dy21 - 1), 0.95 * (-dy21 - 1)),
  dx43 = sample(4:6, 1),
  dy43 = y0 + dy10 + dy21 + dy32,
  # slopes
  sx0 = stats::runif(1, 0, 0.1),
  sx1 = sample(1:3, 1),
  sx2 = sample(4:6, 1),
  sx3 = sample(2:4, 1),
  sx4 = stats::runif(1, 0, 0.2),
  sy0 = stats::runif(1, 0.5, 1),
  sy1 = sample(-4:-6, 1),
  sy2 = stats::runif(1, -0.5, 0.5),
  sy3 = stats::runif(1, 0.5, 1.5),
  sy4 = stats::runif(1, 0.2, 0.7),
  # middle vein slopes:
  smx1 = sample(-5:-15, 1),
  smx2 = sample(-5:-15, 1),
  smy1 = stats::runif(1, -1, 1),
  smy2 = stats::runif(1, -1, 1)
) {
  tibble::lst(
    x0, y0, dx10, dy10, dx21, dy21, dx32, dy32, dx43, dy43, sx0, sx1, sx2, sx3, sx4, sy0, sy1, sy2, sy3, sy4, smx1, smx2, smy1, smy2)
}

#' Generate bezier end points
#'
#' @param leaf_params parameters generated by `gen_leaf_parameters()`
#'
#' @return tibble with absolute coordinates
#' @export
#'
#' @examples
#' gen_benjamini_points()
gen_benjamini_points <- function(
  leaf_params = gen_leaf_parameters()
) {
  x0   = leaf_params$x0
  y0   = leaf_params$y0
  dx10 = leaf_params$dx10
  dy10 = leaf_params$dy10
  dx21 = leaf_params$dx21
  dy21 = leaf_params$dy21
  dx32 = leaf_params$dx32
  dy32 = leaf_params$dy32
  dx43 = leaf_params$dx43
  dy43 = leaf_params$dy43

  x1 <- x0 + dx10
  y1 <- y0 + dy10
  x2 <- x1 + dx21
  y2 <- y1 + dy21
  x3 <- x2 + dx32
  y3 <- y2 + dy32
  x4 <- x3 + dx43
  y4 <- y0

  tibble::tibble(
    x = c(x0, x1, x2, x3, x4),
    y = c(y0, y1, y2, y3, y4)
  )
}

#' Generate bezier slopes coordinates
#'
#' @param leaf_params parameters generated by `gen_leaf_parameters()`
#'
#' @return dataframe with sx1-4 in the x variable and sy1-4 in the y variable
#' @export
#'
#' @examples
#' gen_benjamini_slopes()
gen_benjamini_slopes <- function(
  leaf_params = gen_leaf_parameters()
) {
  sx0 = leaf_params$sx0
  sx1 = leaf_params$sx1
  sx2 = leaf_params$sx2
  sx3 = leaf_params$sx3
  sx4 = leaf_params$sx4
  sy0 = leaf_params$sy0
  sy1 = leaf_params$sy1
  sy2 = leaf_params$sy2
  sy3 = leaf_params$sy3
  sy4 = leaf_params$sy4

  tibble::tibble(
    x = c(sx0, sx1, sx2, sx3, sx4),
    y = c(sy0, sy1, sy2, sy3, sy4)
  )
}

#' Generate bezier slopes of the line in the middle of the leaf
#'
#' @param leaf_params parameters generated by `gen_leaf_parameters()`
#'
#' @return A dataframe containing the coordinates of the two control points of
#'   the bezier curve defining the midvein of the leaf.
#' @export
#'
#' @examples
#' gen_middle_line_slopes()
gen_middle_line_slopes <- function(
  leaf_params = gen_leaf_parameters()
)
  {
  smx1 = leaf_params$smx1
  smx2 = leaf_params$smx2
  smy1 = leaf_params$smy1
  smy2 = leaf_params$smy2
  tibble::tibble(
    x = c(smx1, smx2),
    y = c(smy1, smy2)
  )
}

#' Generate a dataframe of one bezier curve
#'
#' @param i number of the bezier
#' @param points_df dataframe generated by `gen_benjamini_points()` (see
#'   example).
#' @param slopes_df dataframe generated by `gen_benjamini_slopes()` (see
#'   example).
#'
#' @return A dataframe containing the information for one bezier curve in the format as needed by `ggforce::geom_bezier`.
#' @export
#'
#' @examples
#' set.seed(123)
#' leaf_params <- gen_leaf_parameters()
#' points_df <- gen_benjamini_points()
#' slopes_df <- gen_benjamini_slopes()
#' df_bezier <- get_one_bezier(1, points_df, slopes_df)
#' ggplot2::ggplot(df_bezier, ggplot2::aes(x = x, y = y)) + ggforce::geom_bezier()
get_one_bezier <- function(i, points_df, slopes_df) {
  dplyr::bind_rows(
    # points_df %>% dplyr::slice(i),
    points_df[i, ],
    # slopes_df %>% dplyr::slice(i) + points_df %>% dplyr::slice(i),
    slopes_df[i, ] + points_df[i, ],
    # -slopes_df %>% dplyr::slice(i + 1) + points_df %>% dplyr::slice(i + 1),
    -slopes_df[i + 1, ] + points_df[i + 1, ],
    # points_df %>% dplyr::slice(i + 1)
    points_df[i + 1, ]
  ) %>%
    add_bezier_point_type_column()

}

add_bezier_point_type_column <- function(df) {
  dplyr::mutate(df,
    param_type = c(
      "bezier start point",
      "bezier control point 1",
      "bezier control point 2",
      "bezier end point"
    ))
}

gen_middle_line_points <- function(points_df) {
  dplyr::bind_rows(
    points_df %>% dplyr::slice_tail(),
    points_df[2, ]
  )
}


#' Generate bezier curve coordinates of a benjamini leaf
#' @param leaf_params parameter that control the leaf shape
#' @param omega rotation angle of the leaf
#' @param xrot x coordinate of pivot point (preset to leaf origin).
#' @param yrot x coordinate of pivot point (preset to leaf origin).
#' @param precision numeric precision of the output
#'
#'
#' @return A dataframe conaining the data for the bezier curves of a leaf (see example).
#' @export
#' @importFrom rlang .data
#' @examples
#' df <- benjamini_leaf()
#' df
#' df %>%
#'   # This generated a unique identifier for the 4 rows of each bezier curve:
#'   tidyr::unite(b, element, i_part, remove = FALSE) %>%
#'   ggplot2::ggplot() +
#'   ggforce::geom_bezier(ggplot2::aes(x = x, y = y, group = b))
benjamini_leaf <- function(
    leaf_params = gen_leaf_parameters(),
    omega = 0,
    xrot = leaf_params$x0,
    yrot = leaf_params$y0,
    precision = 2
  ) {
  points_df = gen_benjamini_points(leaf_params)
  slopes_df = gen_benjamini_slopes(leaf_params)
  slopes_middle_df = gen_middle_line_slopes(leaf_params)
  points_middle_df = gen_middle_line_points(points_df)
  stalk_df <- get_one_bezier(1, points_df[1:2, ], slopes_df[c(1, 5), ])
  middle_line_df <- get_one_bezier(1, points_middle_df, slopes_middle_df)
  upper_half <- 2:4 %>%
    purrr::map_dfr(
      ~get_one_bezier(
        .x,
        points_df,
        slopes_df
      ),
      .id = "i_part"
    )  %>%
    dplyr::mutate(
      i_part = as.numeric(.data$i_part)
    ) %>%
    dplyr::bind_rows(
      middle_line_df %>% dplyr::mutate(i_part = 4)) %>%
    dplyr::mutate(element = "half 2")
  lower_half <-  2:4 %>%
    purrr::map_dfr(
      ~get_one_bezier(
        .x,
        points_df %>% rev_points(),
        slopes_df %>% dplyr::mutate(y = -y)
      ),
      .id = "i_part"
    ) %>%
    dplyr::mutate(i_part = as.numeric(.data$i_part))  %>%
    dplyr::bind_rows(middle_line_df %>% dplyr::mutate(i_part = 4)) %>%
      dplyr::mutate(element = "half 1")

  df <- dplyr::bind_rows(
    stalk_df %>%
      dplyr::mutate(
        i_part = 0,
        element = "stalk"
      ),
    upper_half,
    lower_half
  ) %>%
    dplyr::relocate(c("element", "i_part"))
  if (omega %% 360 != 0) {
    return(
      rotate_bezier_df(df, alpha = omega, xrot = xrot, yrot = yrot, precision = precision)
    )
  }
  df
}


rev_points <- function(points_df) {
  points_df_rev <- points_df
  points_df_rev$y[-c(1, 2, 5)] <- - points_df_rev$y[-c(1, 2, 5)] + 2 * points_df_rev$y[1]
  points_df_rev
}

# from here: https://stackoverflow.com/a/15464420
rotate_bezier_df <- function(bezier_df, alpha = 30, xrot = bezier_df$x[1], yrot = bezier_df$y[1], precision = 2) {

  alpha_rad <- alpha / 90 * pi / 2
  rotm <- matrix(c(cos(alpha_rad),sin(alpha_rad),-sin(alpha_rad),cos(alpha_rad)),ncol=2)
  #shift, rotate, shift back

  M <- bezier_df %>%
    dplyr::select(c("x", "y")) %>%
    as.matrix()

  bezier_df[c("x", "y")] <-
  t(rotm %*% (t(M) - c(xrot, yrot)) + c(xrot, yrot)) %>%
    round(precision)

  bezier_df
}

resize_leaf_params <- function(leaf_params, multiplicator) {
  leaf_params[-c(1:2)] <- leaf_params[-c(1:2)] %>%
    purrr::map(~.x * multiplicator)
  leaf_params
}