代码之家 › 专栏 › 技术社区 › phil_t

基于行名和列名范围提取观察值

phil_t · 技术社区 · 9 年前

我有两个数据帧-一个是基本数据帧,另一个是查询数据帧。

base_df ):

    Mon   Tue   Wed   Thu   Fri   Sat
A  5.23  0.01  6.81  8.67  0.10  6.21
B  6.26  2.19  4.28  5.57  0.16  2.81
C  7.41  2.63  4.32  6.57  0.20  1.69
D  6.17  1.50  5.30  9.22  2.19  5.47
E  1.23  9.01  8.09  1.29  7.65  4.57

查询数据帧( query_df ):

Person  Start  End
     A    Tue  Thu
     C    Mon  Wed
     D    Thu  Sat
     C    Thu  Sat
     B    Wed  Fri

我想提取某个人在开始和结束期间的所有观察结果。开始日和结束日之间的差值始终为三(包括开始日和结束日)。

Person  Start  End     D1    D2    D3
     A    Tue  Thu   0.01  6.81  8.67
     C    Mon  Wed   7.41  2.63  4.32
     D    Thu  Sat   9.22  2.19  5.47
     C    Thu  Sat   6.57  0.20  1.69
     B    Wed  Fri   4.28  5.57  0.16

我希望避免循环,因为实际base\u df超过35000行。有数据吗。表格解决方案?使用其他数据结构的解决方案也很好。非常感谢。

5 回复 | 直到 9 年前

Andrew Gustar 9 年前

mapply ...

query_df <- cbind(query_df,
                  t(mapply(function(p,s,e) {
                     base_df[p, match(s, names(base_df)):match(e, names(base_df))]},
                           query_df$Person,
                           query_df$Start,
                           query_df$End)))
names(query_df)[4:6] <- c("D1", "D2", "D3")

query_df
  Person Start End   D1   D2   D3
1      A   Tue Thu 0.01 6.81 8.67
2      C   Mon Wed 7.41 2.63 4.32
3      D   Thu Sat 9.22 2.19 5.47
4      C   Thu Sat 6.57  0.2 1.69
5      B   Wed Fri 4.28 5.57 0.16

Community Mohan Dere 6 年前

这个 data.table Start 和 End 多亏了 非等连接 和 melt() / dcast() 对于重塑:

library(data.table)
setDT(base_df)
setDT(query_df)

# reshape from wide to long
long <- melt(base_df, id.vars = "Person", variable.name = "Day")

# align factor levels
cols <- c("Start", "End")
query_df[, (cols) := lapply(.SD, factor, levels = levels(long$Day)), .SDcols = cols][
  # add row id because Person is not unique
  , rn := .I]

# non-equi join right join, i.e., take all rows of query_df
long[query_df, on = .(Person, Day >= Start, Day <= End), 
     .(rn, Person, Start = i.Start, End = i.End, value)][
       # reshape from long to wide
       , dcast(.SD, rn + Person + ... ~ rowid(rn, prefix = "D"))]

   rn Person Start End   D1   D2   D3
1:  1      A   Tue Thu 0.01 6.81 8.67
2:  2      C   Mon Wed 7.41 2.63 4.32
3:  3      D   Thu Sat 9.22 2.19 5.47
4:  4      C   Thu Sat 6.57 0.20 1.69
5:  5      B   Wed Fri 4.28 5.57 0.16

Day 是一个按外观顺序将工作日名称作为因子级别的因子:

 str(long)

Classes âdata.tableâ and 'data.frame':    30 obs. of  3 variables:
 $ Person: chr  "A" "B" "C" "D" ...
 $ Day   : Factor w/ 6 levels "Mon","Tue","Wed",..: 1 1 1 1 1 2 2 2 2 2 ...
 $ value : num  5.23 6.26 7.41 6.17 1.23 0.01 2.19 2.63 1.5 9.01 ...
 - attr(*, ".internal.selfref")=<externalptr>

对齐因子水平对于非等连接至关重要。

数据

library(data.table)

base_df <- fread(
  "Person    Mon   Tue   Wed   Thu   Fri   Sat
A  5.23  0.01  6.81  8.67  0.10  6.21
B  6.26  2.19  4.28  5.57  0.16  2.81
C  7.41  2.63  4.32  6.57  0.20  1.69
D  6.17  1.50  5.30  9.22  2.19  5.47
E  1.23  9.01  8.09  1.29  7.65  4.57"
)

query_df <- fread(
  "Person  Start  End
  A    Tue  Thu
  C    Mon  Wed
  D    Thu  Sat
  C    Thu  Sat
  B    Wed  Fri"
)

Axeman 9 年前

tidyverse

base_df ,然后加入并切分正确的日期,然后重新塑形。

library(tidyr)
library(dplyr)

base_df <- tibble::rownames_to_column(base_df, 'Person')
days <- names(base_df)[-1]

base_df %>% 
  gather(day, value, -Person) %>% 
  right_join(mutate(query_df, i = row_number())) %>% 
  group_by(i) %>% 
  slice(which(days == Start):which(days == End)) %>% 
  mutate(col = c('D1', 'D2', 'D3')) %>% 
  select(-day, -i) %>% 
  spread(col, value)

pogibas 9 年前

数据表格解决方案:

我在这里使用 get 提取列(例如。 Mon data.table 对象

library(data.table)
# Prepare data
base_df$Person <- rownames(base_df)
d <- merge(query_df, base_df, "Person", sort = FALSE)
setDT(d)

# Extract mid day (day between start and end)
d[, Mid := days[which(Start == days) + 1], 1:nrow(d)]
# Extract columns using get
d[, .(Person, Start, End, 
      D1 = get(Start), D2 = get(Mid), D3 = get(End)), 1:nrow(d)][, nrow := NULL][]

   Person Start End   D1   D2   D3
1:      A   Tue Thu 0.01 6.81 8.67
2:      C   Mon Wed 7.41 2.63 4.32
3:      D   Thu Sat 9.22 2.19 5.47
4:      C   Thu Sat 6.57 0.20 1.69
5:      B   Wed Fri 4.28 5.57 0.16

基本R解决方案:

# Order of days
days <- names(base_df)
# Order of persons
subjects <- rownames(base_df)

res <- apply(query_df, 1, function(x) {
    # Extract observation between start:end date
    foo <- base_df[x[1] == subjects, which(x[2] == days):which(x[3] == days)]
    colnames(foo) <- paste0("D", 1:3)
    foo})
# Merge with original query_df
res <- cbind(query_df, do.call("rbind", res))
rownames(res) <- NULL
res

Henrik plannapus 9 年前

base 使用数字矩阵索引的解决方案:

ri <- match(query_df$Person, rownames(base_df))
ci <- match(query_df$Start, names(base_df))
cbind(query_df, `dim<-`(base_df[cbind(ri, rep(ci, 3) + rep(0:2, each = nrow(query_df)))],
                        c(nrow(query_df), 3)))

#   Person Start End    1    2    3
# 1      A   Tue Thu 0.01 6.81 8.67
# 2      C   Mon Wed 7.41 2.63 4.32
# 3      D   Thu Sat 9.22 2.19 5.47
# 4      C   Thu Sat 6.57 0.20 1.69
# 5      B   Wed Fri 4.28 5.57 0.16