R中的自动序列识别
Automatic sequence identification in R
我在 R 中处理一些顺序数据。具体来说,我有一个以各种顺序出现多次的整数列表。我想做的是创建一些代码来识别出现了多少不同的序列。
目前,我正在手动进行。我预定义存在的模式并应用计算出现次数的函数。
我首先使用 RMYSQL 进行存储在变量 product_process_history_joined 中的查询。然后,我创建了一个存储在变量数据中的我感兴趣的数据列表。然后,我定义我的函数应该处理哪些模式,最后我应用我的函数来计算出现次数。
代码:
product_process_history_joined<-dbGetQuery(con,"SELECT *
FROM product, process_history
WHERE product.idproduct = process_history.product_idproduct")
data<-product_process_history_joined$process_types_idprocess_types
pat <- c(1,2,4,5,6)
x <- sapply(1:(length(data)-length(pat)), function(x) all(data[x: (x+length(pat)-1)] == pat))
route<-data[which(x)]
countR<-length(route)
pat1 <- c(1,2,4,5,7,9,7,7,2,5,6,10)
x <- sapply(1:(length(data)-length(pat1)), function(x) all(data[x: (x+length(pat1)-1)] == pat1))
route1<-data[which(x)]
countR1<-length(route1)
生成并存储在数据变量中的数据集如下所示:
[1] 1 4 5 6 1 4 5 6 1 4 5 6 1 4 5 6 1 4 5 6 1 4 5 6 1 4 5 6 1 4 5 6 1 4 5
[36] 6 1 4 5 6 1 4 5 6 1 4 5 6 1 4 5 6 1 4 5 6 1 4 5 6 1 4 5 6 1 4 5 6 1 4
[71] 5 6 1 4 5 6 1 4 5 6 1 4 5 6 1 2 4 5 6 10 1 2 4 5 7 9 7 7 2 5 6 10 1 2 4
[106] 5 6 10 1 2 4 5 6 10 1 2 4 8 1 2 3 5 7 8 1 2 3 5 6 1 2 3 5 6 1 2 4 5 6 10
这只是列表的一部分。我使用大约 12 种不同的图案。给定数据集中前 2 个模式的结果对于 pat 是 21,对于 pat1 是 1。
这绝对不是完成这项工作的最佳方式,但您可以决定将数据视为字符串,然后使用正则表达式(通过 gregexpr
)。
original_data <- c(1, 4, 5, 6, 1, 4, 5, 6, 1, 4, 5, 6, 1, 4, 5, 6, 1, 4, 5, 6, 1, 4, 5, 6, 1, 4, 5, 6, 1, 4, 5, 6, 1, 4, 5,6, 1, 4, 5, 6, 1, 4, 5, 6, 1, 4, 5, 6, 1, 4, 5, 6, 1, 4, 5, 6, 1, 4, 5, 6, 1, 4, 5, 6, 1, 4, 5, 6, 1, 4, 5, 6, 1, 4, 5, 6, 1, 4, 5, 6, 1, 4, 5, 6, 1, 2, 4, 5, 6, 10, 1, 2, 4, 5, 7, 9, 7, 7, 2, 5, 6, 10, 1, 2, 4, 5, 6, 10, 1, 2, 4, 5, 6, 10, 1, 2, 4, 8, 1, 2, 3, 5, 7, 8, 1, 2, 3, 5, 6, 1, 2, 3, 5, 6, 1, 2, 4, 5, 6, 10)
data_as_string <- paste(original_data, collapse="-")
pattern1 = "1-2-4-5-6" # Your "pat"
pattern2 = "1-4-5-6" # Occurs 21 times in your data
pattern3 = "1-2-4-5-7-9-7-7-2-5-6-10" # Your "pat1"
gregexpr(pattern1,data_as_string)
# [[1]]
# [1] 169 207 220 273
# attr(,"match.length")
# [1] 9 9 9 9
# attr(,"useBytes")
# [1] TRUE
# So if you just want the number of occurrences
length(gregexpr(pattern1,data_as_string)[[1]])
# [1] 4
length(gregexpr(pattern2,data_as_string)[[1]])
# [1] 21
length(gregexpr(pattern3,data_as_string)[[1]])
# [1] 1
没有理由进行正则表达式。你可以使用 rollapply
:
original_data <- c(1, 4, 5, 6, 1, 4, 5, 6, 1, 4, 5, 6, 1, 4, 5, 6, 1, 4, 5, 6, 1, 4, 5, 6, 1, 4, 5, 6, 1, 4, 5, 6, 1, 4, 5,6, 1, 4, 5, 6, 1, 4, 5, 6, 1, 4, 5, 6, 1, 4, 5, 6, 1, 4, 5, 6, 1, 4, 5, 6, 1, 4, 5, 6, 1, 4, 5, 6, 1, 4, 5, 6, 1, 4, 5, 6, 1, 4, 5, 6, 1, 4, 5, 6, 1, 2, 4, 5, 6, 10, 1, 2, 4, 5, 7, 9, 7, 7, 2, 5, 6, 10, 1, 2, 4, 5, 6, 10, 1, 2, 4, 5, 6, 10, 1, 2, 4, 8, 1, 2, 3, 5, 7, 8, 1, 2, 3, 5, 6, 1, 2, 3, 5, 6, 1, 2, 4, 5, 6, 10)
pattern2 <- c(1, 4, 5, 6)
library(zoo)
sum(
rollapply(
original_data,
width = length(pattern2),
FUN = function(x, pattern) all(x == pattern),
pattern = pattern2
)
)
#[1] 21
如有必要,可以使用更快的解决方案,但这提供了良好的可读性。
编辑
这会提取所有以 1 开头的不同序列:
x <- split(original_data, cumsum(original_data == 1))
unique(x)
res <- vapply(unique(x), function(x, y) sum(vapply(y, FUN = identical, y = x, FUN.VALUE = TRUE)), y = x, FUN.VALUE = 1L)
Res <- data.frame(n = res,
seq = vapply(unique(x), paste, collapse = ",", FUN.VALUE = "a"))
# n seq
#1 21 1,4,5,6
#2 4 1,2,4,5,6,10
#3 1 1,2,4,5,7,9,7,7,2,5,6,10
#4 1 1,2,4,8
#5 1 1,2,3,5,7,8
#6 2 1,2,3,5,6
我在 R 中处理一些顺序数据。具体来说,我有一个以各种顺序出现多次的整数列表。我想做的是创建一些代码来识别出现了多少不同的序列。
目前,我正在手动进行。我预定义存在的模式并应用计算出现次数的函数。
我首先使用 RMYSQL 进行存储在变量 product_process_history_joined 中的查询。然后,我创建了一个存储在变量数据中的我感兴趣的数据列表。然后,我定义我的函数应该处理哪些模式,最后我应用我的函数来计算出现次数。
代码:
product_process_history_joined<-dbGetQuery(con,"SELECT *
FROM product, process_history
WHERE product.idproduct = process_history.product_idproduct")
data<-product_process_history_joined$process_types_idprocess_types
pat <- c(1,2,4,5,6)
x <- sapply(1:(length(data)-length(pat)), function(x) all(data[x: (x+length(pat)-1)] == pat))
route<-data[which(x)]
countR<-length(route)
pat1 <- c(1,2,4,5,7,9,7,7,2,5,6,10)
x <- sapply(1:(length(data)-length(pat1)), function(x) all(data[x: (x+length(pat1)-1)] == pat1))
route1<-data[which(x)]
countR1<-length(route1)
生成并存储在数据变量中的数据集如下所示:
[1] 1 4 5 6 1 4 5 6 1 4 5 6 1 4 5 6 1 4 5 6 1 4 5 6 1 4 5 6 1 4 5 6 1 4 5
[36] 6 1 4 5 6 1 4 5 6 1 4 5 6 1 4 5 6 1 4 5 6 1 4 5 6 1 4 5 6 1 4 5 6 1 4
[71] 5 6 1 4 5 6 1 4 5 6 1 4 5 6 1 2 4 5 6 10 1 2 4 5 7 9 7 7 2 5 6 10 1 2 4
[106] 5 6 10 1 2 4 5 6 10 1 2 4 8 1 2 3 5 7 8 1 2 3 5 6 1 2 3 5 6 1 2 4 5 6 10
这只是列表的一部分。我使用大约 12 种不同的图案。给定数据集中前 2 个模式的结果对于 pat 是 21,对于 pat1 是 1。
这绝对不是完成这项工作的最佳方式,但您可以决定将数据视为字符串,然后使用正则表达式(通过 gregexpr
)。
original_data <- c(1, 4, 5, 6, 1, 4, 5, 6, 1, 4, 5, 6, 1, 4, 5, 6, 1, 4, 5, 6, 1, 4, 5, 6, 1, 4, 5, 6, 1, 4, 5, 6, 1, 4, 5,6, 1, 4, 5, 6, 1, 4, 5, 6, 1, 4, 5, 6, 1, 4, 5, 6, 1, 4, 5, 6, 1, 4, 5, 6, 1, 4, 5, 6, 1, 4, 5, 6, 1, 4, 5, 6, 1, 4, 5, 6, 1, 4, 5, 6, 1, 4, 5, 6, 1, 2, 4, 5, 6, 10, 1, 2, 4, 5, 7, 9, 7, 7, 2, 5, 6, 10, 1, 2, 4, 5, 6, 10, 1, 2, 4, 5, 6, 10, 1, 2, 4, 8, 1, 2, 3, 5, 7, 8, 1, 2, 3, 5, 6, 1, 2, 3, 5, 6, 1, 2, 4, 5, 6, 10)
data_as_string <- paste(original_data, collapse="-")
pattern1 = "1-2-4-5-6" # Your "pat"
pattern2 = "1-4-5-6" # Occurs 21 times in your data
pattern3 = "1-2-4-5-7-9-7-7-2-5-6-10" # Your "pat1"
gregexpr(pattern1,data_as_string)
# [[1]]
# [1] 169 207 220 273
# attr(,"match.length")
# [1] 9 9 9 9
# attr(,"useBytes")
# [1] TRUE
# So if you just want the number of occurrences
length(gregexpr(pattern1,data_as_string)[[1]])
# [1] 4
length(gregexpr(pattern2,data_as_string)[[1]])
# [1] 21
length(gregexpr(pattern3,data_as_string)[[1]])
# [1] 1
没有理由进行正则表达式。你可以使用 rollapply
:
original_data <- c(1, 4, 5, 6, 1, 4, 5, 6, 1, 4, 5, 6, 1, 4, 5, 6, 1, 4, 5, 6, 1, 4, 5, 6, 1, 4, 5, 6, 1, 4, 5, 6, 1, 4, 5,6, 1, 4, 5, 6, 1, 4, 5, 6, 1, 4, 5, 6, 1, 4, 5, 6, 1, 4, 5, 6, 1, 4, 5, 6, 1, 4, 5, 6, 1, 4, 5, 6, 1, 4, 5, 6, 1, 4, 5, 6, 1, 4, 5, 6, 1, 4, 5, 6, 1, 2, 4, 5, 6, 10, 1, 2, 4, 5, 7, 9, 7, 7, 2, 5, 6, 10, 1, 2, 4, 5, 6, 10, 1, 2, 4, 5, 6, 10, 1, 2, 4, 8, 1, 2, 3, 5, 7, 8, 1, 2, 3, 5, 6, 1, 2, 3, 5, 6, 1, 2, 4, 5, 6, 10)
pattern2 <- c(1, 4, 5, 6)
library(zoo)
sum(
rollapply(
original_data,
width = length(pattern2),
FUN = function(x, pattern) all(x == pattern),
pattern = pattern2
)
)
#[1] 21
如有必要,可以使用更快的解决方案,但这提供了良好的可读性。
编辑
这会提取所有以 1 开头的不同序列:
x <- split(original_data, cumsum(original_data == 1))
unique(x)
res <- vapply(unique(x), function(x, y) sum(vapply(y, FUN = identical, y = x, FUN.VALUE = TRUE)), y = x, FUN.VALUE = 1L)
Res <- data.frame(n = res,
seq = vapply(unique(x), paste, collapse = ",", FUN.VALUE = "a"))
# n seq
#1 21 1,4,5,6
#2 4 1,2,4,5,6,10
#3 1 1,2,4,5,7,9,7,7,2,5,6,10
#4 1 1,2,4,8
#5 1 1,2,3,5,7,8
#6 2 1,2,3,5,6