гибкое сравнение столбцов в таблице данных r

Question

Я пытаюсь фильтровать, сравнивая группы столбцов друг с другом в динамическом режиме.Предположим, у меня есть база данных.

###########
#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) одинаковы, например

Длякаждый т .., если 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 ... это может помочь ... Я пытаюсь убедиться, что каждый вектор (prod1vint1, prod1vint2, prod1vint3) имеет LIFO, убывающий к своему простому значению. Проигнорируйте этот бит, если он не поможет. Моя попытка решения включает в себя кодирование различных условий, таких каккак тот, на котором я застрял.)

Answer 1

Используя 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,]