GH2*_*H28 1 for-loop r list dataframe
我已从一台设备输出数据。不幸的是,输出数据的组织不是很好,我一直在用R编写代码来分解它。本质上,数据是粘贴到一个长文档中的每个主题的单独信息列表(基本描述信息,以及每个时间间隔的两个不同测量A和B的原始数据)。例如:
Date: 01/01/2016
Time: 12:00:00
Subject: Subject1
A:
1: 1 2 4 1
2: 2 1 2 3
3: 1 0 2 7
B:
1: 2 3 0 1
2: 4 1 1 2
3: 3 5 2 8
Date: 01/01/2016
Time: 12:00:00
Subject: Subject2
A:
1: 8 2 0 1
2: 9 1 2 7
3: 1 6 2 7
B:
1: 2 3 2 0
2: 6 7 1 2
3: 3 3 2 4
Run Code Online (Sandbox Code Playgroud)
我已经用R编写了一个有效的代码,但是使用split(seq_along),for循环和do.call效果很好(主要基于此堆栈溢出问题和此博客文章)。
# First read text file in as a character vector called ‘example’
scan("example_file.txt", what="character", strip.white=T, sep="\n") -> example
# Separate the header text (before the colon) from the proceeding data
# and make that text name the components of the vector
regmatches(example, regexpr(example, pattern="[[:alnum:]]+:", useBytes = F)) -> names(example)
gsub(example, pattern="[[:print:]]+: ", replacement="", useBytes = F)-> example.2
# Then, split character vector into a list based on how many lines are
# dedicated to each subject (in this example, 11 lines); based on SE
# answer cited above
strsplit(example.2, "([A-Z]:)") -> example.3
split(as.list(example.3), ceiling(seq_along(example.2)/11)) -> example.4
# Use a for-loop to systematically add the data together for subjects 1
# and 2 for time interval 1, using the method detailed from a blog post
# (cited above)
my.list <- list()
for(i in 1:2){
strsplit(as.character(example.4[[i]][5]), split="[[:blank:]]+") -> A
strsplit(as.character(example.4[[i]][9]), split="[[:blank:]]+")-> B
as.vector(c(as.character(example.4[[i]][3]), "A", unlist(A))) -> A_char
as.vector(c(as.character(example.4[[i]][3]), "B", unlist(B))) -> B_char
paste(as.character(example.4[[i]][3]), "Measure_A") -> a_name
paste(as.character(example.4[[i]][3]), "Measure_B") -> b_name
my.list[[a_name]] <- A_char
my.list[[b_name]] <- B_char
}
final.data <- do.call(rbind, my.list)
as.data.frame(final.data) -> final.data
names(final.data) <- c("Subject", "Measure", "V1", "V2", "V3", "V4")
Run Code Online (Sandbox Code Playgroud)
我可以使用我的代码(例如,上面的行“ 1:1 2 4 1”和“ 1:2 3 0 1”)提取所有主题在A和B的单个时间间隔内的数据,然后将所有信息一起放在一个数据帧中。当我想在所有时间间隔(而不只是一个时间间隔)内执行此操作时,会变得混乱。我不知道如何在没有为每个时间间隔运行单独的for循环的情况下执行此操作。我尝试在for循环内执行for循环,但这没有用。我也无法弄清楚如何使用apply()类型的函数。
按照这个例子,如果我只有3个时间间隔,这个问题就不会那么糟糕,但是我的实际数据要长得多。任何更优雅和简洁的方法的建议,将不胜感激!
PS我知道上面的代码给出的最终数据帧具有冗余的行名称。但是,这是确保最终数据框的主题和度量信息与我应用于早期R对象的标签对齐的一种有用方法。
除了行名,这将执行所有操作:
lines <- readLines(textConnection("Date: 01/01/2016
Time: 12:00:00
Subject: Subject1
A:
1: 1 2 4 1
2: 2 1 2 3
3: 1 0 2 7
B:
1: 2 3 0 1
2: 4 1 1 2
3: 3 5 2 8
Date: 01/01/2016
Time: 12:00:00
Subject: 2
A:
1: 8 2 0 1
2: 9 1 2 7
3: 1 6 2 7
B:
1: 2 3 2 0
2: 6 7 1 2
3: 3 3 2 4
Date: 01/01/2016
Time: 12:00:00
Subject: 2
A:
1: 8 2 0 1
2: 9 1 2 7
3: 1 6 2 7
B:
1: 2 3 2 0
2: 6 7 1 2
3: 3 3 2 4
3: 3 3 2 4"))
Run Code Online (Sandbox Code Playgroud)
非基础R解决方案需要一些库:
library(purrr)
library(tibble)
library(tidyr)
library(dplyr)
Run Code Online (Sandbox Code Playgroud)
修剪空白并过滤出空白行:
trimws(lines) %>% discard(`==`, "") -> lines
Run Code Online (Sandbox Code Playgroud)
这将成为lines 记录开始位置的索引向量(通过Date:在行的开头查找来指定):
starts <- which(grepl("^Date:", lines))
Run Code Online (Sandbox Code Playgroud)
现在,我们从头开始,寻找下一个出现的位置Date:(即下一个记录)。它将找到所有这些,因此我们只关心第一个。为了计算该索引,我们将开始索引加上减法1。从理论上讲,只有一个NA(即最后一个记录),但是我们懒洋洋地使用ifelsevs更改他的最后一个。
ends <- map_dbl(starts, function(i) {
which(grepl("^Date:", lines[(i+1):length(lines)]))[1]+i-1
})
ends <- ifelse(is.na(ends), length(lines), ends)
Run Code Online (Sandbox Code Playgroud)
因此,现在starts包含每个记录的开始索引,并ends包含每个记录的结束索引。
该map2_df()是超级方便的伪包装的mapply()&do.call(rbind,…)。我们使用以下事实:它们是DCF格式(key: value)并使用read.dcf()。这样就构成了一个矩阵,然后我们对其进行重新定向并将其转换为data.frame。
然后,我们将值分开,添加行名以创建time_interval列,添加日期,时间和主题,并确保列的类型正确。
我们还利用这样一个事实map2_df(),如果我们告诉它会使用指定列表中的“钥匙”为一列。
最后,我们对列进行重新排序。
所以,这将遍历starts并ends与每个迭代传入start和end:
map2_df(starts, ends, function(start, end) {
# now, we extract just the current record into `record` by pulling
# out lines by the indexes.
record <- lines[start:end]
# we then use `read.dcf` to read in the date/subject/time values:
header <- as.data.frame(read.dcf(textConnection(record[1:3])))
# Since we do not have blank lines and you said the records were
# uniform we can use the fact that they'll be at known index
# positions in this `record`. So, we make a list of two vectors
# which are the indexes. Each becomes `i` (two total iterations)
# and we use the value in `i` to extract out the three lines from
# `record` and read those via `read.dcf`.
# But that reads things into a matrix and in an unhelpful order
# so we transpose it into shape and make it a data frame since
# we'll ultimately need that.
# We use `separate` to take the single character space-separated
# `V1` column and turn it into 4 columns. `read.dcf` gave us
# named rows for each time interval so we promote that to a
# full-on column and then add in date/time/subject, ensuring
# they are characters and not factors, then ensure that the
# values we split out from `V1` are numeric and not character or
# factor.
# `map_df` can add in the `A` and `B` from the named list we passed
# in for us and we have it call that column `measure`.
# finally, we put the columns in a better order.
map_df(list(A=5:7, B=9:11), function(i) {
read.dcf(textConnection(record[i])) %>%
t() %>% as_data_frame() %>%
separate(V1, sprintf("V%d", 1:4)) %>%
rownames_to_column("time_interval") %>%
mutate(date=as.character(header$Date),
time=as.character(header$Time),
subject=header$Subject) %>%
mutate_at(vars(starts_with("V")), as.numeric)
}, .id="measure")
}) %>%
select(date, time, subject, measure, time_interval, V1, V2, V3, V4)
Run Code Online (Sandbox Code Playgroud)
产生以下输出:
## # A tibble: 18 x 9
## date time subject measure time_interval V1 V2 V3 V4
## <chr> <chr> <chr> <chr> <chr> <dbl> <dbl> <dbl> <dbl>
## 1 01/01/2016 12:00:00 Subject1 A 1 1 2 4 1
## 2 01/01/2016 12:00:00 Subject1 A 2 2 1 2 3
## 3 01/01/2016 12:00:00 Subject1 A 3 1 0 2 7
## 4 01/01/2016 12:00:00 Subject1 B 1 2 3 0 1
## 5 01/01/2016 12:00:00 Subject1 B 2 4 1 1 2
## 6 01/01/2016 12:00:00 Subject1 B 3 3 5 2 8
## 7 01/01/2016 12:00:00 2 A 1 8 2 0 1
## 8 01/01/2016 12:00:00 2 A 2 9 1 2 7
## 9 01/01/2016 12:00:00 2 A 3 1 6 2 7
## 10 01/01/2016 12:00:00 2 B 1 2 3 2 0
## 11 01/01/2016 12:00:00 2 B 2 6 7 1 2
## 12 01/01/2016 12:00:00 2 B 3 3 3 2 4
## 13 01/01/2016 12:00:00 2 A 1 8 2 0 1
## 14 01/01/2016 12:00:00 2 A 2 9 1 2 7
## 15 01/01/2016 12:00:00 2 A 3 1 6 2 7
## 16 01/01/2016 12:00:00 2 B 1 2 3 2 0
## 17 01/01/2016 12:00:00 2 B 2 6 7 1 2
## 18 01/01/2016 12:00:00 2 B 3 3 3 2 4
Run Code Online (Sandbox Code Playgroud)
如果您确实需要基本的R解决方案,则:
do.call(rbind, mapply(function(start, end) {
record <- lines[start:end]
header <- as.data.frame(read.dcf(textConnection(record[1:3])))
do.call(rbind, lapply(list(A=5:7, B=9:11), function(i) {
mat <- as.data.frame(t(read.dcf(textConnection(record[i]))))
mat <- matrix(unlist(apply(mat, 1, strsplit, split=" "), use.names=FALSE), ncol=4, byrow=TRUE)
mat <- as.data.frame(mat)
mat$time_interval <- 1:3
mat$date <- as.character(header$Date)
mat$time <- as.character(header$Time)
mat$subject <- as.character(header$Subject)
mat
})) -> df
df$measure <- gsub("\\..*$", "", rownames(df))
rownames(df) <- NULL
df
}, starts, ends, SIMPLIFY=FALSE)) -> out_df
out_df[,c("date", "time", "subject", "measure", "time_interval", "V1", "V2", "V3", "V4")]
## date time subject measure time_interval V1 V2 V3 V4
## 1 01/01/2016 12:00:00 Subject1 A 1 1 2 4 1
## 2 01/01/2016 12:00:00 Subject1 A 2 2 1 2 3
## 3 01/01/2016 12:00:00 Subject1 A 3 1 0 2 7
## 4 01/01/2016 12:00:00 Subject1 B 1 1 2 4 1
## 5 01/01/2016 12:00:00 Subject1 B 2 2 1 2 3
## 6 01/01/2016 12:00:00 Subject1 B 3 1 0 2 7
## 7 01/01/2016 12:00:00 2 A 1 8 2 0 1
## 8 01/01/2016 12:00:00 2 A 2 9 1 2 7
## 9 01/01/2016 12:00:00 2 A 3 1 6 2 7
## 10 01/01/2016 12:00:00 2 B 1 8 2 0 1
## 11 01/01/2016 12:00:00 2 B 2 9 1 2 7
## 12 01/01/2016 12:00:00 2 B 3 1 6 2 7
## 13 01/01/2016 12:00:00 2 A 1 8 2 0 1
## 14 01/01/2016 12:00:00 2 A 2 9 1 2 7
## 15 01/01/2016 12:00:00 2 A 3 1 6 2 7
## 16 01/01/2016 12:00:00 2 B 1 8 2 0 1
## 17 01/01/2016 12:00:00 2 B 2 9 1 2 7
## 18 01/01/2016 12:00:00 2 B 3 1 6 2 7
Run Code Online (Sandbox Code Playgroud)
| 归档时间: |
|
| 查看次数: |
77 次 |
| 最近记录: |