数据表中的灵活列比较

时间:2019-01-01 22:34:54

标签: r function data.table

我正在尝试通过动态比较列组来进行过滤。假设我有数据库。

###########
#Setup data
###########

set.seed(2)
fill = data.table(n=1:7)
Tp=3

  for(t in 1:Tp){ 
     set(x = fill, j = paste0('prod1vint',t), value = sample(0:10,7))
  }

fill[1,paste0('prod1vint',3):=0]
fill[5,paste0('prod1vint',2):=0]
fill[5,paste0('prod1vint',3):=0]

for(t in 1:Tp){ 
  fill[,paste0('prod1vint',t,'prm'):=get(paste0('prod1vint',t))]
}


fill[1,paste0('prod1vint',1,'prm'):=0] 
fill[2,paste0('prod1vint',2,'prm'):=1]   
fill[5,paste0('prod1vint',3,'prm'):=1]  
fill[7,paste0('prod1vint',3,'prm'):=2] 

数据表:

   n prod1vint1 prod1vint2 prod1vint3 prod1vint1prm prod1vint2prm prod1vint3prm
1: 1          2          9          0             0             9             0
2: 2          7          4          8             7             1             8
3: 3          5         10          9             5            10             9
4: 4          1          8          1             1             8             1
5: 5          6          0          0             6             0             1
6: 6          8          7          0             8             7             0
7: 7          0          0          6             0             0             2

通过动态,我的意思是Tp可以是任意整数。

我想通过以下方式进行过滤:

对于每一个t,例如prod1vint{t},我想比较一下它的“ prm”版本,并检查它是否不为零。如果它不为零,那么我只想保留所有t'>t vint都小于或等于本底值且所有较低元素(t'<t)都是相同的行,例如

对于每一个t ..,如果为prod1vint{t}!=0,则

1. prod1vint{t'}prm <= prod1vint{t'} for t'>t
2. prod1vint{t'}prm == prod1vint{t'} for t'<t

例如,应显示以下输出:

   n   prod1vint1 prod1vint2 prod1vint3 prod1vint1prm prod1vint2prm prod1vint3prm
1: 3          5         10          9             5            10             9
2: 4          1          8          1             1             8             1
3: 6          8          7          0             8             7             0
4: 7          0          0          6             0             0             2       

(如果XY问题... this可能有帮助...我试图确保每个向量(prod1vint1,prod1vint2,prod1vint3)的LIFO都减小到它的质数。如果没有,请忽略此位“无济于事。我尝试的解决方案涉及对各种条件进行编码,例如上面提到的条件,我坚持这样做。)

1 个答案:

答案 0 :(得分:0)

使用melt作为评论,我会这样做:

# this part is as replied from the question
set.seed(2)
fill = data.table(n=1:7)
Tp=3

for(t in 1:Tp){ 
  set(x = fill, j = paste0('prod1vint',t), value = sample(0:10,7))
}

fill[1,paste0('prod1vint',3):=0]
fill[5,paste0('prod1vint',2):=0]
fill[5,paste0('prod1vint',3):=0]

for(t in 1:Tp){ 
  fill[,paste0('prod1vint',t,'prm'):=get(paste0('prod1vint',t))]
}


fill[1,paste0('prod1vint',1,'prm'):=0] 
fill[2,paste0('prod1vint',2,'prm'):=1]   
fill[5,paste0('prod1vint',3,'prm'):=1]  
fill[7,paste0('prod1vint',3,'prm'):=2] 

# NEW CODE
fill.melt <- reshape2::melt(fill, id.vars = c('n'))

fill.melt$intpart <-  sapply(fill.melt$variable, 
                            function (x) 
                              {stringr::str_extract(gsub('prod1','',x),
                                                    '\\d')})


fill.melt$prmpart <-  ifelse(grepl('prm', fill.melt$variable), 'prm','noprm')
fill.cast <- reshape2::dcast(fill.melt, n+intpart ~ prmpart , value.var = 'value')
fill.cast <- as.data.table(fill.cast)

t=3


tmp <- fill.cast[
                 ((intpart >= t & prm <= noprm) | (intpart < t & prm == noprm)),]

ns <- unique(tmp$n)[table(tmp$n) == t]

fill[n %in% ns,]