Оптимизирующая функция R, которая добавляет новый столбец в data.frame

Question

У меня есть функция, которая на данный момент запрограммирована в функциональной модели, и я либо хочу ускорить ее, либо, возможно, решить проблему более в духе R.У меня есть data.frame, и я хочу добавить столбец на основе информации, в котором каждая запись зависит от двух строк.На данный момент это выглядит следующим образом:

faultFinging <- function(heartData){
    if(heartData$Pulse[[1]] == 0){
        Group <- 0
    }
    else{
        Group <- 1
    }
    for(i in seq(2, length(heartData$Pulse), 1)){
        if(heartData$Pulse[[i-1]] != 0 
            && heartData$Pulse[[i]] != 0
            && abs(heartData$Pulse[[i-1]] - heartData$Pulse[[i]])<20){
            Group[[i]] <- 1
        }
        else{
            if(heartData$Pulse[[i-1]] == 0 && heartData$Pulse[[i]] != 0){
                Group[[i]] <- 1
            }
            else{
                Group[[i]] <- 0
            }
        }
    }
    Pulse<-heartData$Pulse
    Time<-heartData$Time
    return(data.frame(Time,Pulse,Group))
}

Answer 1

Я не могу протестировать это без выборочных данных, но это общая идея.Вы можете избежать выполнения for() цикл полностью с помощью & и | которые являются векторизованными версиями && и ||.Кроме того, нет необходимости в операторе if-else, если существует только одно значение (true или false).

faultFinging <- function(heartData){
    Group <- as.numeric(c(heartData$Pulse[1] != 0,
      (heartData$Pulse[-nrow(heartData)] != 0 
        & heartData$Pulse[-1] != 0
        & abs(heartData$Pulse[-nrow(heartData)] - heartData$Pulse[-1])<20) |
      (heartData$Pulse[-nrow(heartData)] == 0 & heartData$Pulse[-1] != 0)))
    return(cbind(heartData, Group))
}

Помещая as.numeric() вокруг индекса будет установлено значение TRUE равным 1, а FALSE - 0.

Answer 2

Это можно сделать более векторным способом, разделив вашу программу на две части:во-первых, функция, которая берет две временные выборки и определяет, соответствуют ли они вашей спецификации импульса:

isPulse <- function(previous, current)
{ 
  (previous != 0 & current !=0 & (abs(previous-current) < 20)) |
  (previous == 0 & current !=0)
}

Обратите внимание на использование vector | вместо логического ||.

А затем вызовите его, предоставив двум векторным потокам "предыдущий" и "текущий" смещение на подходящую задержку, в вашем случае 1:

delay <- 1
samples = length(heartData$pulse)

isPulse(heartData$pulse[-(samples-(1:delay))], heartData$pulse[-(1:delay)])

Давайте попробуем это на некоторых выдуманных данных:

sampleData = c(1,0,1,1,4,25,2,0,25,0)
heartData = data.frame(pulse=sampleData)
result = isPulse(heartData$pulse[-(samples-(1:delay))], heartData$pulse[-(1:delay)])

Обратите внимание, что код heartData$pulse[-(samples-(1:delay))] планки delay образцы с конца, для Предыдущая страница поток, и heartData$pulse[-(1:delay)] планки delay образцы с самого начала, для текущий поток.

Делая это вручную, результаты должны быть (используя F для ложных и T для истинных)

F,T,T,T,F,F,F,T,F

и, запустив его, мы обнаруживаем, что они есть!:

> print(result)
FALSE  TRUE  TRUE  TRUE FALSE FALSE FALSE  TRUE FALSE

успех!

Поскольку вы хотите привязать их обратно в виде столбца к вашему исходному набору данных, вам следует отметить, что новый массив является delay элементы короче ваших исходных данных, поэтому вам нужно дополнить их в начале с помощью delay FALSE elements.Вы также можете преобразовать его в 0,1 в соответствии с вашими данными:

resultPadded <- c(rep(FALSE,delay), result)
heartData$result = ifelse(resultPadded, 1, 0)

который дает

> heartData
   pulse result
1      1      0
2      0      0
3      1      1
4      1      1
5      4      1
6     25      0
7      2      0
8      0      0
9     25      1
10     0      0