Как использовать apply вместо for-loop для проверки каждого столбца в каждой строке

Question

Я пытаюсь проверить каждую строку в моей таблице data.table, если есть определенные элементы (которые я объявляю как 1, если есть). Если есть, я хотел бы вывести новый столбец, который показывает значение (вероятность того, что элемент происходит), ссылающийся на другую таблицу данных.

Это является входным

structure(list(A = c(0L, 0L, 0L, 0L, 0L), B = c(0L, 0L, 0L, 0L, 
0L), C = c(1L, 0L, 1L, 1L, 1L), D = c(0L, 1L, 0L, 0L, 1L)), .Names = c("A", 
"B", "C", "D"), class = "data.frame", row.names = c(NA, -5L)) 

В таблицах, которые я использовал для ссылки, чтобы получить вероятности

Таблица Pyxixj

A B C D 
A 0 0 0 0 
B 0 0 0 0 
C 0 0 0 0.001804403 
D 0 0 0.001804403 0 

Таблица Pyxi

A 0 
B 0 
C 0.00086701 
D 0.000250439 

Это выход

A B C D prob 
1 0 0 1 0 0.00086701 
2 0 0 0 1 0.000250439 
3 0 0 1 0 0.00086701 
4 0 0 1 0 0.00086701 
5 0 0 1 1 0.001804403 

Я сделал это с помощью для цикла ниже, но это занимает 6hrs, чтобы работать около 1 миллиона строк.

for (i in 1:nrow(cnts2)) 
{ 
    if ((rowSums(cnts2 == "1", na.rm = TRUE) == 1)[i]) 
    { 
     cnts2$prob[i] <- Pyxi[colnames(cnts2)[which(cnts2[i, ] == 1)]] 
    } 
    else 
    { 
     cnts2$prob[i] <- Pyxixj[colnames(cnts2)[which(cnts2[i, ] == 1)][1], colnames(cnts2)[which(cnts2[i, ] == 1)][2]] 
    } 
} 

пытался apply, но я понял его еще.

Answer 1

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

Ключ к этому решению меняет свой фрейм данных cnts2 в форму, где вероятности могут быть оставлены объединены на, и, таким образом удаляя потребность в циклах или lapply

library(dplyr);library(tidyr) 
#probability data frame note use of X1 
Pyxixj <- data.frame(X1=c("A", "B", "C", "D"), 
      matrix(data=sample(1:100, 16, replace=TRUE)/100, nrow= 4)) %>% 
    setNames(c("X1", "A", "B", "C", "D")) 


#Restructure the initial data frame 
probmerge <-cnts2 %>%mutate(rowid= 1:nrow(.)) %>% 
    gather(., key=column, value=yesno,-rowid) %>% 
    filter(yesno==1) %>% group_by(rowid) %>% 
    mutate(order=make.names(cumsum(yesno))) %>% 
    spread(key=order, value=column) %>% 
    mutate(X2=ifelse(is.na(X2),X1,X2)) %>%ungroup 


#Gather your probability dataframe 
Pyxixj <-Pyxixj %>% gather(key="X2", value=prob,-X1) 

#join the two new dataframes 
probmerge<-left_join(probmerge, Pyxixj, by=c("X1", "X2")) 

#bind onto the orignial dataframe 
cnts2 <- bind_cols(cnts2, select(probmerge, prob)) 

Answer 2

Вы можете удалить внешний вид окна, чтобы таблица Pyxi от для цикла к циклу через более быстро

Это делает использование векторизации R «ы применения функции при поиске до Pyxi

if (rowSums(cnts2 == "1", na.rm = TRUE) == 1) 
    { 
     cnts2$probs <- (Pyxi[rownames(Pyxi)=="A"]*cnts2$A 
        + Pyxi[rownames(Pyxi)=="B"]*cnts2$B 
        + Pyxi[rownames(Pyxi)=="C"]*cnts2$C 
        + Pyxi[rownames(Pyxi)=="D"]*cnts2$D) 
    } 

Затем сделайте петлю только, где количество строк составляет> 1

for (i in 1:nrow(cnts2)) 
{ 
    if ((rowSums(cnts2 == "1", na.rm = TRUE) > 1)[i]) 
    {cnts2$prob[i] <- Pyxixj[colnames(cnts2)[which(cnts2[i, ] == 1)][1], 
    colnames(cnts2)[which(cnts2[i, ] == 1)][2]] 
    } 
}