expand entries in existing dataframe

Viewed 40

I have a bit of code in a function that I hope to use to create a heatmap-like effect around points in ggplot. The [col, row] coordinates are coming from a 2D map mockup done in Excel... admittedly janky but that's what I have to work with right now.

In any case, the below reprex produces the desired effect when passing point values, but I get an error non-numeric argument to binary operator when I attempt to apply to vectors of points stored in a dataframe. Thanks for any insights!

  library(dplyr)
#> 
#> Attaching package: 'dplyr'
#> The following objects are masked from 'package:stats':
#> 
#>     filter, lag
#> The following objects are masked from 'package:base':
#> 
#>     intersect, setdiff, setequal, union
  library(tidyr)
  library(purrr)
  library(tibble)
  library(stringr)
  
  get_circle_kernel <- function(col_pts = 10,
                                row_pts = 10,
                                radius = 5L,
                                jitter = 5L) {
    # sample the row and column jitter to move the circle center
    col_jitter <- sample(-jitter:jitter, size = 1)
    row_jitter <- sample(-jitter:jitter, size = 1)
    
    # update col_pts and row_pts to move circle center
    col_pts <- col_pts + col_jitter
    row_pts <- row_pts + row_jitter
    
    # draw a filled circle of points with alpha for each [row_pts, col_]
    # from https://stackoverflow.com/questions/14285358/find-all-integer-coordinates-in-a-given-radius
    df_circle <- tibble::tibble(
      row = (row_pts - radius):(row_pts + radius),
      col = (col_pts - radius):(col_pts + radius)
    ) %>% tidyr::expand(row, col) %>%
      dplyr::mutate(radius_from_center = sqrt((row - row_pts) ^ 2 + (col - col_pts) ^
                                                2)) %>%
      dplyr::filter(radius_from_center <= radius) %>%
      dplyr::mutate(alpha = (max(radius_from_center) ^ 2 - radius_from_center ^
                               2) / max(radius_from_center) ^ 2)
    
    return(df_circle)
  }
  
  # Plots for testing & noodling --------------------------------------------
  
  df_1 <- get_circle_kernel()

  ggplot2::ggplot(df_1, ggplot2::aes(x = col, y = row, alpha = alpha)) +
    ggplot2::geom_raster(interpolate = FALSE, fill = "red") +
    ggplot2::scale_x_continuous(limits = c(0, 20)) +
    ggplot2::scale_y_continuous(limits = c(0, 20))



# Example applying to df --------------------------------------------------

  df_2 <- tibble::tibble(col = c(10, 30, 50),
                          row = c(10, 30, 50),
                          radius_from_center = rep(0, 3),
                          alpha = rep(1, 3)) %>% 
    purrr::map_df(~get_circle_kernel(col_pts = col, row_pts = row))
#> Error in col_pts + col_jitter: non-numeric argument to binary operator

Created on 2021-02-19 by the reprex package (v1.0.0)

1 Answers

Either use rowwise

library(dplyr)
library(purrr)
df_2 %>%
   rowwise %>%
    mutate(out = list(get_circle_kernel(col_pts = col, row_pts = row))) %>%
   ungroup

-output

# A tibble: 3 x 5
#    col   row radius_from_center alpha out              
#  <dbl> <dbl>              <dbl> <dbl> <list>           
#1    10    10                  0     1 <tibble [81 × 4]>
#2    30    30                  0     1 <tibble [81 × 4]>
#3    50    50                  0     1 <tibble [81 × 4]>

If we want a single dataset (based on the function, the columns are all repeated within the 'out' as well)

df_2 %>%
    rowwise %>%
     transmute(out = list(get_circle_kernel(col_pts = col, row_pts = row))) %>%
    ungroup %>% unnest(c(out))
# A tibble: 243 x 4
#     row   col radius_from_center alpha
#   <int> <int>              <dbl> <dbl>
# 1     5     9               5    0    
# 2     6     6               5    0    
# 3     6     7               4.47 0.200
# 4     6     8               4.12 0.32 
# 5     6     9               4    0.36 
# 6     6    10               4.12 0.32 
# 7     6    11               4.47 0.200
# 8     6    12               5    0    
# 9     7     5               5    0    
#10     7     6               4.24 0.28 
# … with 233 more rows

Or specify the map2 within the mutate

 df_2 %>%
        mutate(out = map2(col, row, ~get_circle_kernel(col_pts = .x, row_pts = .y)))

-output

# A tibble: 3 x 5
#    col   row radius_from_center alpha out              
#  <dbl> <dbl>              <dbl> <dbl> <list>           
#1    10    10                  0     1 <tibble [81 × 4]>
#2    30    30                  0     1 <tibble [81 × 4]>
#3    50    50                  0     1 <tibble [81 × 4]>

NOTE: Here, map wouldn't work as we need two columns 'col' and 'row'. Also, the lambda for map would be .x after looping over the column

data

 df_2 <- tibble::tibble(col = c(10, 30, 50),
                          row = c(10, 30, 50),
                          radius_from_center = rep(0, 3),
                          alpha = rep(1, 3))
Related