循环仅对第一行数据有效
问题描述 投票：2回答：6
我有一些类似于这样的形式的数据：
xmpl <- data.frame(x = c("022406391116","034506611298", "015410661242"))
xmpl
X
1 022406391116
2 034506611298
3 015410661242
每个值都由成对的数字组成（每个数字两位数）： 项目编号，项目值，项目编号，项目值。
因此，对于示例中的第一行，项目＃2的值为24，项目＃6的值为39，项目＃11的值为16。在第二行，我有第3项，值为45等。在示例中，最大项目编号为12。
我想“展开”数据，所以我为每个出现的项目编号都有一个新列，它的值在相应的行中。在示例中，它应如下所示：
X item1 item2 item3 item6 item11 item12
1 022406391116 NA 24 NA 39 16 NA
2 034506611298 NA NA 45 61 NA 98
3 015411161242 54 NA NA NA 16 42
为了达到目的，我尝试使用双循环：
for (nq in c(0,1,2)) {
for (qs in 1:12) {
if (as.numeric(substr(xmpl$x, 4 * nq + 1, 4 * nq + 2)) == qs) {
xmpl[[paste0("item", qs)]] <- as.numeric(substr(xmpl$x, 4 * nq + 3, 4 * nq + 4))
}
}
}
每次if在循环中运行时，我都会收到此警告：
在if（as.numeric（substr（xmpl $ x，4 * nq + 1,4 * nq + ...：条件长度> 1且仅使用第一个元素）
确定（坏）结果是：
> xmpl
x item2 item6 item11
1 022406391116 24 39 16
2 034506611298 45 61 98
3 015410661242 54 66 42
仅为第一行创建新列，而其他值将被准确解释，但仅放入为第一行定义的现有列中。
我怎样才能让它分别在每一行上运行？或者如果不能这样做（请解释原因） - 什么是更好的策略？
编辑：只是为了澄清 - 我已经有了这个工作，但只是通过一个漫长的过程（分裂，重塑为长，然后回到宽）。这个循环是我尝试缩短过程，我需要帮助理解为什么循环不起作用。
6个回答
1
投票
投票
为什么另一个答案
我已经有了这个工作，但只是通过一个漫长的过程（分裂，重塑到长，然后回到宽）。这个循环是我试图缩短过程[...]
如果“冗长”和“缩短过程”指的是运行时间，则下面的方法比基准验证的循环方法快得多且内存消耗更少。
Reshaping with tstrsplit(), melt(), dcast()
xmpl <- data.frame(x = c("022406391116","034506611298", "015410661242"))
library(data.table)
library(magrittr)
setDT(xmpl) %>%
.[, c(tstrsplit(x, "(?<=[0-9]{2})", perl = TRUE, names = TRUE, type.convert = TRUE),
.(x = x))] %>%
melt(id.var = "x", measure.vars = list(seq(1, ncol(.) - 1, 2), seq(2, ncol(.) - 1, 2)),
value.name = c("item", "val")) %>%
dcast(x ~ sprintf("Item%02i", item), value.var = "val")
x Item01 Item02 Item03 Item06 Item10 Item11 Item12 1: 015410661242 54 NA NA NA 66 NA 42 2: 022406391116 NA 24 NA 39 NA 16 NA 3: 034506611298 NA NA 45 61 NA NA 98
tstrsplit()使用带有lookbehind的正则表达式在每两个数字后拆分，然后转换结果以创建转换为整数的列。melt()同时从宽到长形式重塑两个测量变量。奇数列是项目，偶数列是值。- 最后，
dcast()被用来重塑为广泛的形式。使用sprintf()创建新列名称，以确保低于10的列数具有前导0以确保正确的列顺序。
Benchmark
对于基准测试，给定的数据集太小。所以我为不同的参数范围创建了虚拟数据：
- 决定
x长度的对的数量可以在3到10之间变化。 - 行数从10到1000不等。
我已单独测试（此处未显示）最大项目数对基准时间的影响较小，因此固定为15。
到目前为止发布的大多数代码都具有硬编码的参数，无法修改以与其他参数一起使用。因此，包括三种不同的方法：
- snoram的循环方法
- snoram's reshape approach
- 这个答案中的重塑版本
对代码进行了轻微修改以处理不同的参数。
library(bench)
bm <- press(
n_pair = c(3, 5, 10),
n_row = 10^(1:3),
{
set.seed(1)
max_items <- 15L
xmpl0 <-
sapply(seq_len(n_row), function(x) {
sprintf("%02i%02i",
sample(max_items, n_pair, FALSE),
sample(99, n_pair, TRUE)) %>%
paste0(collapse = "")
}) %>%
data.frame(x = ., stringsAsFactors = FALSE)
mark(
snoram_loop = {
xmpl <- copy(xmpl0)
nc <- max_items
xmpl[1 + 1:nc] <- vector(mode = "integer", length = 3)
names(xmpl) <- c(names(xmpl)[1], sprintf("item%02i", 1:nc))
np <- max(nchar(xmpl$x)) / 4
# Iterate through the df row by row
for (row in seq_len(nrow(xmpl))) {
# Iterate through each entry which has 3 item_number-value pairs
for (pair in seq_len(np)) {
item_number <- as.integer(
substr(xmpl[["x"]][row], 4 * (pair - 1) + 1, 4 * (pair - 1) + 2)
)
value <- as.integer(
substr(xmpl[["x"]][row], 4 * (pair - 1) + 3, 4 * (pair - 1) + 4)
)
xmpl[row, sprintf("item%02i", item_number)] <- value
}
}
xmpl
},
snoram_reshape = {
xmpl <- copy(xmpl0)
xmplsp <- gsub("(\\d{2})", "\\1 ", xmpl$x) %>% strsplit(" ")
np <- max(lengths(xmplsp)) / 2
xmpl2 <- data.frame(
x = rep(xmpl$x, each = np),
item_no = lapply(xmplsp, function(x) x[seq(1, 2*np, 2)]) %>% unlist(),
value = lapply(xmplsp, function(x) x[-seq(1, 2*np, 2)]) %>% unlist() %>% as.integer()
)
result <- dcast(xmpl2, x ~ paste0("item", item_no))
result
},
uwe_reshape = {
xmpl <- copy(xmpl0)
result <- setDT(xmpl) %>%
.[, c(tstrsplit(x, "(?<=[0-9]{2})", perl = TRUE, names = TRUE, type.convert = TRUE),
.(x = x))] %>%
melt(id.var = "x", measure.vars = list(seq(1, ncol(.) - 1, 2), seq(2, ncol(.) - 1, 2)),
value.name = c("item", "val")) %>%
dcast(x ~ sprintf("item%02i", item), value.var = "val")
result
},
check = FALSE
)
})
检查已关闭，因为循环方法也为不存在的项创建列，并使用0而不是NA。
ggplot2::autoplot(bm)
使用tstrsplit()，melt()，dcast()的方法几乎总是更快，并且循环方法几乎总是比其他方法慢 - 除了10行的情况。请注意对数时间刻度。
下表还显示了内存分配。循环方法分配的内存比重塑方法多20倍。
tail(bm, 9)
# A tibble: 9 x 16 expression n_pair n_row min mean median max `itr/sec` mem_alloc n_gc n_itr total_time result <chr> <dbl> <dbl> <bch:tm> <bch:tm> <bch:tm> <bch:t> <dbl> <bch:byt> <dbl> <int> <bch:tm> <list> 1 snoram_lo~ 3 1000 145.04ms 148.78ms 148.67ms 152.8ms 6.72 12.27MB 4 4 595ms <data~ 2 snoram_re~ 3 1000 49.18ms 57.54ms 53.49ms 82.6ms 17.4 1.63MB 3 9 518ms <data~ 3 uwe_resha~ 3 1000 8.11ms 9.09ms 8.87ms 13.9ms 110. 925.19KB 0 56 509ms <data~ 4 snoram_lo~ 5 1000 246.04ms 248.31ms 247.39ms 251.5ms 4.03 19.96MB 5 3 745ms <data~ 5 snoram_re~ 5 1000 54.67ms 59.71ms 58.14ms 69.5ms 16.7 2.41MB 2 9 537ms <data~ 6 uwe_resha~ 5 1000 11.43ms 12.84ms 12.55ms 21.1ms 77.9 1.12MB 1 39 501ms <data~ 7 snoram_lo~ 10 1000 500.29ms 500.29ms 500.29ms 500.3ms 2.00 39.33MB 3 1 500ms <data~ 8 snoram_re~ 10 1000 65.59ms 69.1ms 66.53ms 77.4ms 14.5 4.41MB 2 8 553ms <data~ 9 uwe_resha~ 10 1000 18.41ms 20.71ms 20.61ms 29ms 48.3 1.88MB 1 25 518ms <data~ # ... with 3 more variables: memory <list>, time <list>, gc <list>
2
投票
投票
这是你可以考虑的味道：
library(magrittr) # for %>% which I use just for readability
library(data.table) # for dcast()
xmplsp <- gsub("(\\d{2})", "\\1 ", xmpl$x) %>% strsplit(" ")
xmpl2 <- data.frame(
x = rep(xmpl$x, each = 3),
item_no = lapply(xmplsp, function(x) x[c(1,3,5)]) %>% unlist(),
value = lapply(xmplsp, function(x) x[-c(1,3,5)]) %>% unlist() %>% as.integer()
)
xmpl2
x item_no value
1 022406391116 02 24
2 022406391116 06 39
3 022406391116 11 16
4 034506611298 03 45
5 034506611298 06 61
6 034506611298 12 98
7 015410661242 01 54
8 015410661242 10 66
9 015410661242 12 42
dcast(xmpl2, x ~ paste0("item", item_no))
x item01 item02 item03 item06 item10 item11 item12
1 015410661242 54 NA NA NA 66 NA 42
2 022406391116 NA 24 NA 39 NA 16 NA
3 034506611298 NA NA 45 61 NA NA 98
所以逻辑建立在strsplit（）而不是substr（）上，但我首先使用gsub（）在值之间添加空格。
1
投票
投票
回答问题（1）当前循环有什么问题，以及（2）如何通过循环完成（尽管这可能不是最佳解决方案）。
(1)
if()只接受单个值而不是向量，因此您将每个值强制转换为第一个值所属的列。
(2)
这是一个完成工作的循环示例。逻辑是逐行处理，然后是该行中的每个item_number-value对。
# Preset the vector
xmpl[1 + 1:12] <- vector(mode = "integer", length = 3)
names(xmpl) <- c(names(xmpl)[1], paste0("item", 1:12))
# Iterate through the df row by row
for (row in seq_len(nrow(xmpl))) {
# Iterate through each entry which has 3 item_number-value pairs
for (pair in seq_len(3)) {
item_number <- as.integer(
substr(xmpl[["x"]][row], 4 * (pair - 1) + 1, 4 * (pair - 1) + 2)
)
value <- as.integer(
substr(xmpl[["x"]][row], 4 * (pair - 1) + 3, 4 * (pair - 1) + 4)
)
xmpl[row, paste0("item", item_number)] <- value
}
}
xmpl
x item1 item2 item3 item4 item5 item6 item7 item8 item9 item10 item11 item12
1 022406391116 0 24 0 0 0 39 0 0 0 0 16 0
2 034506611298 0 0 45 0 0 61 0 0 0 0 0 98
3 015410661242 54 0 0 0 0 0 0 0 0 66 0 42
1
投票
投票
在基地R：
xmpl <- data.frame(x = c("022406391116","034506611298", "015410661242"))
want <- do.call(rbind, lapply(strsplit(as.character(xmpl$x), ""),
function(x) {
res <- t(matrix(unlist(x), nrow = 4))
items <- paste0(res[,1], res[,2])
values <- paste0(res[,3], res[,4])
id <- paste(x, collapse = "")
res <- data.frame(x = id, items = items,
values = as.numeric(values))
res
}))
library(reshape2)
want <- dcast(want, x ~ paste0("item", items), value.var = "values")
want
# x item01 item02 item03 item06 item10 item11 item12
#1 022406391116 NA 24 NA 39 NA 16 NA
#2 034506611298 NA NA 45 61 NA NA 98
#3 015410661242 54 NA NA NA 66 NA 42
# modified:
xmpl <- data.frame(x = c("022406391116","034506611298", "015410661242"))
dummy <- matrix(strsplit(paste(as.character(xmpl$x), collapse = ""), "")[[1]], nrow = 4)
want <- data.frame(x = rep(as.character(xmpl$x), each = 3),
items = paste0(dummy[1,], dummy[2,]),
values = paste0(dummy[3,], dummy[4,]))
library(reshape2)
(want <- dcast(want, x ~ paste0("item", items), value.var = "values"))
# x item01 item02 item03 item06 item10 item11 item12
#1 015410661242 54 <NA> <NA> <NA> 66 <NA> 42
#2 022406391116 <NA> 24 <NA> 39 <NA> 16 <NA>
#3 034506611298 <NA> <NA> 45 61 <NA> <NA> 98
1
投票
投票
在某些地方令人着迷，但这有效：
require(tidyverse)
require(stringr)
xmpl <- data_frame(x = c("022406391116","034506611298", "015410661242"))
fn <- function(x, strt, end) {str_sub(x, strt, end) %>% as.integer()}
tmp <- xmpl %>%
mutate(
key_1 = str_sub(x, 1,2),
val_1 = fn(x, 3,4),
key_2 = str_sub(x, 5,6),
val_2 = fn(x, 7,8),
key_3 = str_sub(x, 9,10),
val_3 = fn(x, 11,12)
)
long <- reduce(
.x = list(
tmp %>% select(x, key = key_1, val = val_1),
tmp %>% select(x, key = key_2, val = val_2),
tmp %>% select(x, key = key_3, val = val_3) ),
bind_rows
)
long %>%
transmute(x = x ,item = paste0("item_", key), val = val) %>%
spread(item, val)
# A tibble: 3 x 8
x item_01 item_02 item_03 item_06 item_10 item_11 item_12
<chr> <int> <int> <int> <int> <int> <int> <int>
1 015410661242 54 NA NA NA 66 NA 42
2 022406391116 NA 24 NA 39 NA 16 NA
3 034506611298 NA NA 45 61 NA NA 98
0
投票
投票
我不确定我是否完全理解你想要如何分配数字，但如果它只是数字对，我会做这样的事情：
xmpl <- data.frame(x = c("022406391116","034506611298", "015410661242"))
mytable <- do.call(rbind, lapply(xmpl$x, substring, seq(1,11,2), seq(2,12,2)))
colnames(mytable) <- paste("Item",1:6)
cbind(xmpl, mytable)
x Item 1 Item 2 Item 3 Item 4 Item 5 Item 6
1 022406391116 02 24 06 39 11 16
2 034506611298 03 45 06 61 12 98
3 015410661242 01 54 10 66 12 42
最新问题
- 如何使用Robot框架（Selenium）获取（在变量中）剪贴板文本
- 桌面快捷方式上未显示网站图标
- 如何将列值替换为基于另一个列值的字典中的值
- UI5 工具：在 ui5.yaml 中指定库依赖项
- React Native RCTFabric - 没有名为“RCTDebuggingOverlayViewProtocol”的类型或协议
- Botpress 头盔图表
- 自定义运算符支持 std::hex <<
- 在不知道类型的情况下循环遍历 List<> 中的项目？
- 如何在scrapy中发送带有标头和有效负载的Post请求
- pgAdmin4中表格位置改变时如何调整表格之间的关系线？
- 将 Nextjs-build 切换到 Azure 中的 Docker
- 在 android google 示例项目中构建 now 时出现错误
- Laravel：通过asc从查询顺序中获取数据
- 是否可以在映射数据流中维护文件夹结构和接收器文件？
- 如何在 IntelliJ IDEA 中禁用行分隔符中的差异？
- Python 包 - aiohttp 有警告消息“未关闭的客户端会话”
- 将字体 - TrueType (TTF) 转换为 PostScript Type 1 (PT1)
- JavaScript 鼠标事件的意外行为
- geom_raster 不适用于 x 比例中超过 2^15 的值
- 无法在 Orleans Runtime 中激活 Grains
© www.soinside.com 2019 - 2024. All rights reserved.