首页 > 解决方案 > 计算嵌套小标题列上的函数?

问题描述

我有一个带有一列小标题的数据框。这是我的部分数据:

date        time        uuid                data
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>    
2018-06-23  18:26:37    0b27ea5fad61c99d    <tibble>    
2018-06-23  18:27:00    0b27ea5fad61c99d    <tibble>    
2018-06-23  18:27:22    0b27ea5fad61c99d    <tibble>    
2018-06-23  18:27:39    0b27ea5fad61c99d    <tibble>    
2018-06-23  18:28:06    0b27ea5fad61c99d    <tibble>    
2018-06-23  18:28:30    0b27ea5fad61c99d    <tibble>

这是我的功能:

jaccard <- function(vector1, vector2) {

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

}

我的数据列由带有一列字符的小标题组成:

contacts
5646
65748
115
498456
35135

我的目标是计算数据列中每 2 个连续 tibbles 之间的 jaccard。

我努力了:

df %>% mutate(j = jaccard(data, lag(data, 1)))但由于某种原因它似乎不起作用。

我知道我很接近,请指教。

标签: rdataframetibble

解决方案


原因是jaccard函数不是为了处理向量参数而编写的。如您所知,用作mutate接收数据向量一部分的函数(10 tibbles在 OP 的示例中为向量)。现在,由于jaccard没有编写函数来处理向量(小标题向量)的参数,因此结果将不符合预期。

最简单的解决方法是向量化jaccard函数,以便它可以处理向量参数。一旦可以使用Vectorize转换函数为:

# Function 
jaccard <- function(vector1, vector2) {
  return(length(intersect(vector1, vector2)) / 
           length(union(vector1, vector2)))
}
# Vectorised version of jaccard function
jaccardV <- Vectorize(jaccard)


library(dplyr)
df %>%
  mutate(j = jaccardV(data, lag(data, 1)))

#          date     time             uuid                            data         j
# 1  2018-06-23 18:25:24 0b27ea5fad61c99d 5646, 65748, 115, 498456, 35135 0.0000000
# 2  2018-06-23 18:25:38 0b27ea5fad61c99d                     5646, 65748 0.4000000
# 3  2018-06-23 18:26:01 0b27ea5fad61c99d                5646, 65748, 115 0.6666667
# 4  2018-06-23 18:26:23 0b27ea5fad61c99d                            5646 0.3333333
# 5  2018-06-23 18:26:37 0b27ea5fad61c99d                     5646, 65748 0.5000000
# 6  2018-06-23 18:27:00 0b27ea5fad61c99d 5646, 65748, 115, 498456, 35135 0.4000000
# 7  2018-06-23 18:27:22 0b27ea5fad61c99d                     5646, 65748 0.4000000
# 8  2018-06-23 18:27:39 0b27ea5fad61c99d                5646, 65748, 115 0.6666667
# 9  2018-06-23 18:28:06 0b27ea5fad61c99d                            5646 0.3333333
# 10 2018-06-23 18:28:30 0b27ea5fad61c99d                     5646, 65748 0.5000000

数据:

df <- read.table(text="
date        time        uuid                
2018-06-23  18:25:24    0b27ea5fad61c99d    
2018-06-23  18:25:38    0b27ea5fad61c99d    
2018-06-23  18:26:01    0b27ea5fad61c99d    
2018-06-23  18:26:23    0b27ea5fad61c99d    
2018-06-23  18:26:37    0b27ea5fad61c99d    
2018-06-23  18:27:00    0b27ea5fad61c99d    
2018-06-23  18:27:22    0b27ea5fad61c99d    
2018-06-23  18:27:39    0b27ea5fad61c99d    
2018-06-23  18:28:06    0b27ea5fad61c99d    
2018-06-23  18:28:30    0b27ea5fad61c99d",
header = TRUE, stringsAsFactors = FALSE)

t1 <- tibble(contacts = c(5646,65748,115,498456,35135))
t2 <- tibble(contacts = c(5646,65748))
t3 <- tibble(contacts = c(5646,65748,115))
t4 <- tibble(contacts = c(5646))
t5 <- tibble(contacts = c(5646,65748))


df$data <- c(t1,t2,t3,t4,t5)

df
#          date     time             uuid                            data
# 1  2018-06-23 18:25:24 0b27ea5fad61c99d 5646, 65748, 115, 498456, 35135
# 2  2018-06-23 18:25:38 0b27ea5fad61c99d                     5646, 65748
# 3  2018-06-23 18:26:01 0b27ea5fad61c99d                5646, 65748, 115
# 4  2018-06-23 18:26:23 0b27ea5fad61c99d                            5646
# 5  2018-06-23 18:26:37 0b27ea5fad61c99d                     5646, 65748
# 6  2018-06-23 18:27:00 0b27ea5fad61c99d 5646, 65748, 115, 498456, 35135
# 7  2018-06-23 18:27:22 0b27ea5fad61c99d                     5646, 65748
# 8  2018-06-23 18:27:39 0b27ea5fad61c99d                5646, 65748, 115
# 9  2018-06-23 18:28:06 0b27ea5fad61c99d                            5646
# 10 2018-06-23 18:28:30 0b27ea5fad61c99d                     5646, 65748

推荐阅读