R: Изменение значения в ячейке, если значения выше и ниже этого соответствуют друг другу, без использования цикла for - PullRequest
0 голосов
/ 28 сентября 2018

Я пытаюсь заменить нас (или NA, которые легко привести в Us как NA) в моем фрейме данных значениями, которые находятся в столбце над или под ними.Т.е.

0 1 0 1
U U U U
0 1 1 0

станет

0 1 0 1    
0 1 U U
0 1 1 0

У меня есть цикл for для этого, который работает с подмножествами данных

for(i in 2:((NROW(Sample_table))-1)) {
  for(j in 3:NCOL(Sample_table)) {
if((Sample_table[i,j]=="U")&(Sample_table[(i-1),j]==Sample_table[(i+1),j])){
  Sample_table[i,j] <- Sample_table[(i+1),j]
}
  }
}

(неначните с 1: 1, потому что первая пара строк / столбцов содержит позиции / имена).Тем не менее, мой последний набор данных состоит из 152 столбцов и ~ 6 миллионов строк, поэтому цикл for не является хорошим решением (попытался это сделать, запустился в течение недели без завершения).Я пытался использовать apply, но не могу понять, как заставить его ссылаться на другие строки, я пытался использовать ifelse, но могу заставить его работать только внутри цикла for.Любая помощь или предложения?

EDIT ###

Я думал, что Мориц решил это ниже, но когда я применяю его к большему кадру данных, он не дает ожидаемого результата:

df <- read.table(text =
               "0 1 0 1 0 1 1 0
U U U U 1 0 1 1
0 1 1 0 0 1 0 1
0 1 0 1 0 1 1 0
U U U U 1 0 1 1
0 1 1 0 0 1 0 1
             ", header = F)
 > df
  V1 V2 V3 V4 V5 V6 V7 V8
1  0  1  0  1  0  1  1  0
2  U  U  U  U  1  0  1  1
3  0  1  1  0  0  1  0  1
4  0  1  0  1  0  1  1  0
5  U  U  U  U  1  0  1  1
6  0  1  1  0  0  1  0  1

> df2 <- as.data.frame(sapply(df, function(x) replace(x, x[1] == x[3] & x[2] 
== "U", x[1])))
> df2
  V1 V2 V3 V4 V5 V6 V7 V8
1  1  1  1  2  0  1  1  0
2  1  1  3  3  1  0  1  1
3  1  1  2  1  0  1  0  1
4  1  1  1  2  0  1  1  0
5  1  1  3  3  1  0  1  1
6  1  1  2  1  0  1  0  1
EDIT 2

Сравнение методов: применить быстрее всего (это дает правильный ответ):

devtools::install_github("olafmersmann/microbenchmarkCore")
devtools::install_github("olafmersmann/microbenchmark")
library(microbenchmark)
mbm <- microbenchmark("apply_wrong_version" = {df <- read.table(text =
                                                  "0 1 0 1 0 1 1 0
U U U U 1 0 1 1
0 1 1 0 0 1 0 1
0 1 0 1 0 1 1 0
U U U U 1 0 1 1
0 1 1 0 0 1 0 1
                 ", header = F)
df2 <- as.data.frame(sapply(df, function(x) replace(x, x[1] == x[3] & x[2] 
== "U", x[1])))
df2},"forloop" = {df <- read.table(text =
                                     "0 1 0 1 0 1 1 0
U U U U 1 0 1 1
0 1 1 0 0 1 0 1
0 1 0 1 0 1 1 0
U U U U 1 0 1 1
0 1 1 0 0 1 0 1
                 ", header = F)
  for(i in 2:((NROW(df))-1)) {
    for(j in 1:NCOL(df)) {
      if((df[i,j]=="U")&(df[(i-1),j]==df[(i+1),j])){
        df[i,j] <- df[(i+1),j]
      }
    }
  }
},"na.locf_version" = {mat=read.table(text =
                                           "0 1 0 1 0 1 1 0
U U U U 1 0 1 1
0 1 1 0 0 1 0 1
0 1 0 1 0 1 1 0
U U U U 1 0 1 1
0 1 1 0 0 1 0 1
                 ", header = F)
mat1=mat   
mat1[mat1=='U']=NA  
mask=zoo::na.locf(mat1)==zoo::na.locf(mat1,fromLast=T)
mat[mask]=zoo::na.locf(mat1,fromLast=T)[mask]
mat},"apply_version"= {df <- read.table(text =
                                          "0 1 0 1 0 1 1 0
U U U U 1 0 1 1
0 1 1 0 0 1 0 1
0 1 0 1 0 1 1 0
U U U U 1 0 1 1
0 1 1 0 0 1 0 1
                 ", header = F)
  df[]<-apply(df, 2, function(x){
    #find rows with U
    us<-which(x=="U" )
    #replace U with value above (if above=below)
    x[us]<-ifelse(x[us-1]==x[us+1], x[us-1], "U")
    return(x)
  })
})

мбм

                expr       min        lq       mean    median        uq       max neval  cld
 apply_wrong_version   671.605   821.334   979.1732   910.816  1020.840  4364.250   100 a   
             forloop 11809.985 13516.258 14523.5789 14059.863 15238.531 22556.858   100    d
     na.locf_version  3754.275  4380.448  5042.3309  4631.510  5314.573  9295.415   100   c 
       apply_version   986.470  1209.878  1476.4378  1321.878  1492.742  8167.513   100  b  

Ответы [ 5 ]

0 голосов
/ 29 сентября 2018

Использование dplyr lead() и lag()

myfunc <- function(my_list) {
  mlead <- lead(my_list, default = 'U')
  mlag <- lag(my_list, default = 'U')
  valuetocopy <- (my_list == 'U') & ((mlead == mlag))
  my_list[valuetocopy] <- mlead[valuetocopy]
  return(my_list)
}
0 голосов
/ 28 сентября 2018

Вот простое решение, использующее только базу R и функцию apply.Это решение также предполагает, что «U» не находится в первом или последнем ряду.Также предполагается, что данные хранятся в фрейме данных.

df <- read.table(text =
           "0 1 0 1 0 1 1 0
            U U U U 1 0 1 1
            0 1 1 0 0 1 0 1
            0 1 0 1 0 1 1 0
            U U U U 1 0 1 1
            0 1 1 0 0 1 0 1", header = F)


df[]<-apply(df, 2, function(x){
  #find rows with U
  us<-which(x=="U" )
  #replace U with value above (if above=below)
  x[us]<-ifelse(x[us-1]==x[us+1], x[us-1], "U")
  return(x)
  })
0 голосов
/ 28 сентября 2018

В пакете zoo есть метод с именем na.approx, который будет интерполировать два значения.Также есть na.locf, который принимает предыдущее значение.Вместе они могут помочь вам.

  • замените U на NA
  • сохраните позиции всех NA
  • примените na.approx
  • примените na.locf
  • для тех позиций, где эти два значения одинаковы, вы сохраняете значение
  • всем остальным, вероятно, нужно вернуться к U (или к тому, что вы хотите сделать в этом случае)

С этим вопросом можно ознакомиться здесь: Интерполяция NA

0 голосов
/ 28 сентября 2018

Как упоминал Рал, вы можете использовать zoo с na.locf

mat1=mat   
mat1[mat1=='U']=NA  
mask=zoo::na.locf(mat1)==zoo::na.locf(mat1,fromLast=T)
mat[mask]=zoo::na.locf(mat1,fromLast=T)[mask]

mat
     V1  V2  V3  V4 
[1,] "0" "1" "0" "1"
[2,] "0" "1" "U" "U"
[3,] "0" "1" "1" "0"
0 голосов
/ 28 сентября 2018

Я предполагаю, что вы хотите заменить записи во второй строке, только если записи в первой и третьей строке совпадают.

Возможно, что-то подобное, используя replace?

# Sample data (as matrix)
mat <- as.matrix(read.table(text =
    "0 1 0 1
U U U U
0 1 1 0", header = F))    

apply(mat, 2, function(x) replace(x, x[1] == x[3] & x[2] == "U", x[1]))
#     V1  V2  V3  V4
#[1,] "0" "1" "0" "1"
#[2,] "0" "1" "U" "U"
#[3,] "0" "1" "1" "0"

Или если у вас data.frame (вместо matrix):

# Sample data (as data.frame)
df <- read.table(text =
    "0 1 0 1
U U U U
0 1 1 0", header = F)

as.data.frame(sapply(df, function(x) replace(x, x[1] == x[3] & x[2] == "U", x[1])))
#  V1 V2 V3 V4
#1  0  1  0  1
#2  0  1  U  U
#3  0  1  1  0
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...