Ввод дополнительных строк в кадре данных как середины между значениями смежных существующих строк - PullRequest
2 голосов
/ 31 мая 2019

Скажем, у вас есть следующий набор данных временного ряда в r:

n <- 3
set.seed(1)
df <- data.frame(Day = rep("Mon", n),
           Time = 1:n,
           Temper = round(rnorm(n, 4, 2), 0))
print(df)

  Day Time Temper
  Mon    1      3
  Mon    2      4
  Mon    3      2

Теперь предположим, что вы хотите добавить средние точки между соседними существующими значениями в виде дополнительных строк во фрейме данных.Например, скажем, вы хотите добавить точную среднюю точку между каждой парой смежных значений, чтобы получить следующий новый кадр данных:

  Day Time Temper
  Mon    1      3
  Mon  1.5    3.5
  Mon    2      4
  Mon  2.5      3
  Mon    3      2

Каким будет эффективный код R, который мог бы выполнить это для гораздо больших наборов данных?

Было бы замечательно, если бы этот код мог также заполнять фрейм данных значениями, которые не являются просто точными средними точками, например, точкой данных «одна треть»:

  Day Time Temper
  Mon    1      3
  Mon 1.33   3.33
  Mon    2      4
  Mon 2.33   3.33
  Mon    3      2

Ответы [ 3 ]

2 голосов
/ 31 мая 2019

Другое решение:

library(tidyverse)

df %>%
  slice(rep(1:n(), each = 2)) %>%
  mutate_at(c("Time", "Temper"), function(x) {
    replace(x, seq(2, n(), 2),
            (x + (1 / 3) * (lead(x) - lag(x)))[seq(2, n(), 2)])
  }) %>%
  mutate_at(c("Time", "Temper"), round, 2) %>%
  slice(-n())
#>   Day Time Temper
#> 1 Mon 1.00   3.00
#> 2 Mon 1.33   3.33
#> 3 Mon 2.00   4.00
#> 4 Mon 2.33   3.33
#> 5 Mon 3.00   2.00
1 голос
/ 31 мая 2019

Возможно, вы захотите сравнить (микробенчмарк библиотеки cf) эти 3 решения, в зависимости от количества имеющихся у вас факторов и числовых переменных.

Использование базы R

n <- 3
set.seed(1)
dframe <- data.frame(Day = rep("Mon", n),
                     Time = 1:n,
                     Temper = round(rnorm(n, 4, 2), 0))

# --- convert factor to numeric
mframe <- as.data.frame(sapply(dframe, as.numeric))

# --- function to use on variables 
pfun <- function(x, coef = 1/4){

        # x <- mframe$Time ; coef <- .25 ;
        newp <- x[1:(length(x)-1)] + diff(x, lag = 1) * coef
        res <- c(rbind(x[1:(length(x) -1) ], newp) , x[length(x)] )

        return( res )
}

# --- base R way

# pfun( mframe$Time )
# sapply(mframe, pfun, .5)
apply(mframe, 2, pfun)

dframe_final <- as.data.frame ( apply(mframe, 2, pfun) )
# str(dframe_final)

# --- get Day's or other factors back
for(col in names(dframe)[sapply(dframe, is.factor)]){
        dframe_final[[col]] <- factor(dframe_final[[col]])
        levels( dframe_final[[col]] ) <- levels(dframe[[col]])
}

dplyr

# --- dplyr way
library(dplyr)
library(purrr)

lfactors <- dframe %>% 
        map_if(is.factor, levels)

dframe2 <- dframe %>% 
         as_tibble %>%
        map_dfr(as.numeric) %>% 
        map_dfr(pfun) %>% 
        mutate_at(.vars = names(dframe)[sapply(dframe, is.factor)], .funs = factor)

# --- get Day's or other factors back
for(col in names(dframe)[sapply(dframe, is.factor)]){
        dframe2[[col]] <- factor(dframe2[[col]])
        levels( dframe2[[col]] ) <- levels(dframe[[col]])
}

data.table

# --- data.table way
library(data.table)

dframe3 <- data.table(dframe)

dframe3 <- dframe3[ , lapply(.SD, as.numeric)]
dframe3 <- dframe3[ , lapply(.SD, pfun)]

# --- get Day's or other factors back
for(col in names(dframe)[sapply(dframe, is.factor)]){
        dframe3[ , (col) := factor(get(col)) ]
        levels( dframe3[[col]] ) <- levels(dframe[[col]])
}
1 голос
/ 31 мая 2019

Вот идея с использованием dplyr и purrr.Сначала мы rbind строки по NA, а затем заполняем эти NA, то есть

library(tidyverse)

df %>%
  group_by(Day) %>%
  map_dfr(rbind, NA) %>%
  fill(Day) %>%
  mutate_at(vars(c(2, 3)), funs(replace(., is.na(.), (1/2) * (lag(.) + lead(.))[is.na(.)] ))) %>% 
  na.omit()

, что дает,

# A tibble: 5 x 3
    Day  Time Temper
  <int> <dbl>  <dbl>
1     1   1      3  
2     1   1.5    3.5
3     1   2      4  
4     1   2.5    3  
5     1   3      2
...