Применить функцию к столбцу типа Tibble?

Question

Имея такой толчок:

df_nested:

dt          t           uuid                data
<date>      <S3: hms>   <chr>               <list>
2018-06-23  18:25:24    0b27ea5fad61c99d    <tibble>    
2018-06-23  18:25:38    0b27ea5fad61c99d    <tibble>    
2018-06-23  18:26:01    0b27ea5fad61c99d    <tibble>    
2018-06-23  18:26:23    0b27ea5fad61c99d    <tibble>

Мне интересно вычислить Jaccard между каждыми 2 последовательными столбиками в столбце данных.

Единственный способ, которым он работает для меня, это использовать следующий код:

sapply(seq_len(nrow(df_nested) - 1), 
                function(i) { jaccardV(df_nested$data[[i]], 
                                       df_nested$data[[i+1]])})

или используя

jaccardV(df_nested$data[[i]]$contacts, 
                  df_nested$data[[i+1]]$contacts)

Где jaccardV:

jaccard <- function(vector1, vector2) {

  return(length(intersect(vector1, vector2)) / 
           length(union(vector1, vector2)))

}

jaccardV <- Vectorize(jaccard)

Проблема связана с: Рассчитать функцию для столбца вложенных столбцов?

Но ответ там не решает мою проблему.

Исполнение

df_nested <- df_nested %>% mutate(j = jaccardV(data, lag(data, 1)) 

не дает мне правильные числа.

Для лучшего понимания причина в типе столбца данных (список).

Пожалуйста, сообщите, если есть простой способ сделать это.

P.S:

structure(list(dt = structure(17705, class = "Date"), t = structure(66324, class = c("hms", 
"difftime"), units = "secs"), uuid = "0b27ea5fad61c99d", data = list(
    structure(list(Date = structure(c(17689, 17689, 17689, 17690, 
    17690, 17690, 17690, 17690, 17690, 17691, 17691, 17691, 17691, 
    17691, 17691, 17691, 17691, 17691, 17692, 17692, 17692, 17692, 
    17692, 17692, 17692, 17692, 17692, 17692, 17692, 17692, 17692, 
    17692, 17692, 17692, 17692, 17692, 17692, 17692, 17692, 17692, 
    17692, 17692, 17692, 17692, 17692, 17692, 17692, 17692, 17692, 
    17692, 17692, 17692, 17692, 17692, 17692, 17692, 17692, 17692, 
    17692, 17692, 17692, 17692, 17692, 17692, 17692, 17692, 17692, 
    17692, 17692, 17692, 17692, 17692, 17692, 17692, 17693, 17693, 
    17693, 17693, 17693, 17693, 17693, 17693, 17693, 17693, 17693, 
    17693, 17693, 17693, 17693, 17693, 17693, 17693, 17693, 17693, 
    17693, 17693, 17693, 17693, 17693, 17693), class = "Date"), 
        Time = structure(c(76180, 77415, 84620, 27900, 28132, 
        29396, 32914, 32962, 54105, 75066, 79109, 79761, 79810, 
        79700, 80245, 80229, 80282, 80322, 14443, 23356, 24693, 
        24752, 25133, 28226, 28764, 29110, 29134, 29159, 29267, 
        33427, 34404, 34617, 34763, 35866, 35974, 36719, 39145, 
        38499, 39852, 39975, 40289, 40576, 41567, 43894, 44953, 
        45555, 46226, 46627, 46827, 46955, 47220, 46644, 47263, 
        47378, 47630, 47996, 48043, 49479, 50984, 51343, 51258, 
        52258, 52904, 57153, 58608, 58583, 58971, 59210, 61133, 
        61648, 62976, 63472, 63972, 67364, 25886, 27299, 27850, 
        28049, 28594, 32058, 32357, 32462, 32557, 32509, 35118, 
        35263, 35290, 37042, 38741, 40548, 40828, 42071, 43121, 
        43937, 44384, 44485, 50519, 53615, 53494, 54243), class = c("hms", 
        "difftime"), units = "secs"), phone_number = c(22881, 
        74049, 74049, 22881, 22881, 22881, 74049, 74049, 22881, 
        80079, 80838, 60397, 57727, 80838, 80838, 57727, 80838, 
        51122, 5444, NA, 13692, 22881, 6173, 22881, 22881, 86025, 
        86025, 86025, 86933, 86963, 62667, 86025, 80094, 77668, 
        86933, 86882, 95422, 71111, 95422, 80094, 22881, 77668, 
        77668, 86903, 22881, 77668, 35244, 35244, 35244, 65575, 
        62667, 22881, 62667, 65575, 35244, 22881, 22881, 71111, 
        22881, 77668, 22881, 22881, 61195, 61195, 72116, 86975, 
        72116, 72116, 22881, 22881, 11980, 22881, 22881, 22881, 
        11980, 60397, 11980, 60397, 22881, 71111, 3369, 86994, 
        86994, 71111, 4650, 4650, 86994, 11980, 80064, 80064, 
        60397, 4650, 80064, 61195, 4650, 4650, 55652, 60397, 
        1050, 60397), isInContact = c(TRUE, TRUE, TRUE, TRUE, 
        TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, 
        TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, FALSE, TRUE, TRUE, 
        TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, 
        TRUE, TRUE, TRUE, TRUE, TRUE, FALSE, FALSE, FALSE, TRUE, 
        TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, 
        TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, FALSE, 
        TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, 
        TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, 
        TRUE, TRUE, TRUE, FALSE, FALSE, TRUE, TRUE, FALSE, FALSE, 
        FALSE, TRUE, TRUE, TRUE, TRUE, TRUE, FALSE, TRUE, TRUE, 
        FALSE, FALSE, TRUE, TRUE, TRUE, TRUE), callDuration = c(1, 
        0, 0, 71, 13, 54, 0, 315, 135, 87, 34, 0, 0, 233, 0, 
        3249, 3193, 3142, 10, 11, 0, 117, 0, 59, 137, 0, 0, 0, 
        1, 33, 27, 85, 0, 7, 145, 23, 0, 1039, 25, 305, 0, 0, 
        35, 58, 21, 110, 0, 0, 0, 0, 0, 601, 98, 228, 349, 0, 
        526, 1045, 0, 5, 515, 167, 76, 30, 0, 65, 112, 100, 0, 
        215, 362, 0, 301, 109, 1379, 0, 199, 532, 10, 8, 83, 
        0, 0, 1563, 130, 23, 116, 0, 0, 0, 505, 146, 71, 0, 17, 
        107, 0, 0, 732, 670)), .Names = c("Date", "Time", "phone_number", 
    "isInContact", "callDuration"), row.names = c(NA, -100L), class = c("tbl_df", 
    "tbl", "data.frame")))), .Names = c("dt", "t", "uuid", "data"
), row.names = c(NA, -1L), class = c("tbl_df", "tbl", "data.frame"
))

Answer 1

Выполняя jaccardV(data, lag(data, 1)), вы применяете функцию на 2 столах. Это равносильно выполнению одного jaccard на каждый столбец внутренней таблицы. Это действительно то, что вы хотели?

Ваш представитель нарушен, вот мой игрушечный пример с моим пониманием:

set.seed(2)
df = data_frame(
  t = 101:104,
  uuid = rep.int("a", 4),
  data = replicate(4, simplify=F,
                   data_frame(
                     Date=as.Date("2018-06-27"),
                     phone_number=sample(1:20, size=10))
  )
)

Тогда это решение:

df %>% 
  mutate(
    contacts = lapply(data, pull, var="phone_number"),
    jac = jaccardV(contacts, lag(contacts))
  )

Примечание: он также будет работать после group_by(uuid)