Извлечение дат из диапазона дат и присвоение значения - PullRequest
0 голосов
/ 19 октября 2018

У меня есть следующий фрейм данных:

Date_from <- c("2013-01-01","2013-01-04")
Date_to <- c("2013-01-03","2013-01-06")
Parameter <- c("Par1","Par1","Par2","Par2")
conc<-c("1.5","2.5","1.5","1.8")
metals<-data.frame(Date_from,Date_to,Parameter,conc)
metals$Date_from<-as.Date(metals$Date_from)
metals$Date_to<-as.Date(metals$Date_to)
metals$conc<-as.numeric(as.character(metals$conc))

Что мне нужно сделать, это извлечь даты с каждым диапазоном дат для каждого параметра и назначить значение концентрации для каждой из дат из этого диапазона ипоместите всю эту информацию в новый фрейм данных.Результат должен выглядеть так:

Date        Parameter    conc
2013-01-01  Par1         1.5
2013-01-02  Par1         1.5
2013-01-03  Par1         1.5
2013-01-04  Par1         2.5
2013-01-05  Par1         2.5
2013-01-06  Par1         2.5
2013-01-01  Par2         1.5
2013-01-02  Par2         1.5
2013-01-03  Par2         1.5
2013-01-04  Par2         1.8
2013-01-05  Par2         1.8
2013-01-06  Par2         1.8

Ответы [ 2 ]

0 голосов
/ 19 октября 2018

Мы можем сделать это без набора 57-зависимых пакетов:

metals <- data.frame(Date_from,Date_to,Parameter,conc)

do.call(
  rbind.data.frame,
  lapply(1:nrow(metals), function(.i) {
    data.frame(
      Date = seq(as.Date(metals$Date_from[.i]), as.Date(metals$Date_to[.i]), "1 day"),
      Parameter = metals$Parameter[.i],
      conc = as.double(as.character(metals$conc[.i])),
      stringsAsFactors = FALSE
    )
  })
)

Используя предварительно преобразованный тип фрейма данных из OP:

library(microbenchmark)

microbenchmark(
  base = do.call(
    rbind.data.frame,
    lapply(1:nrow(metals), function(.i) {
      data.frame(
        Date = seq(metals$Date_from[.i], metals$Date_to[.i], "1 day"),
        Parameter = metals$Parameter[.i],
        conc = metals$conc[.i],
        stringsAsFactors = FALSE
      )
    })
  ),
  base2 = {
    lst <- Map(
      seq, MoreArgs = list(by = "1 day"), metals$Date_from, metals$Date_to
    )
    cbind(
      Date = do.call(c, lst), 
      metals[rep(seq_len(nrow(metals)), lengths(lst)), c("Parameter", "conc")]
    )
  },
  tidy = metals %>% 
    mutate(Date = map2(Date_from, Date_to, seq, by = "1 day")) %>% 
    select(-Date_from, -Date_to) %>%
    unnest %>%
    select(Date, Parameter, conc)
)
## Unit: microseconds
##   expr      min        lq      mean    median        uq       max neval
##   base 2472.997 2615.7025 2758.6086 2678.6220 2765.6375  8085.012   100
##  base2  716.680  784.0505  835.0233  815.9715  869.8095  1166.096   100
##   tidy 7331.729 7671.4065 8644.6002 7889.7080 8080.5925 82376.963   100
0 голосов
/ 19 октября 2018

Вот один вариант с tidyverse.Создайте столбец list, взяв значение seq от Date_from до Date_to (map), удалите ненужные столбцы (select) и unnest

library(tidyverse)
metals %>% 
   mutate(Date = map2(Date_from, Date_to, seq, by = "1 day")) %>% 
   select(-Date_from, -Date_to) %>%
   unnest %>%
   select(Date, Parameter, conc)
#          Date Parameter conc
#1  2013-01-01      Par1  1.5
#2  2013-01-02      Par1  1.5
#3  2013-01-03      Par1  1.5
#4  2013-01-04      Par1  2.5
#5  2013-01-05      Par1  2.5
#6  2013-01-06      Par1  2.5
#7  2013-01-01      Par2  1.5
#8  2013-01-02      Par2  1.5
#9  2013-01-03      Par2  1.5
#10 2013-01-04      Par2  1.8
#11 2013-01-05      Par2  1.8
#12 2013-01-06      Par2  1.8

Или это можно сделать с помощью base R

lst <- Map(seq, MoreArgs = list(by = "1 day"), metals$Date_from, metals$Date_to)
out <- cbind(Date = do.call(c, lst), metals[rep(seq_len(nrow(metals)),
          lengths(lst)), c("Parameter", "conc")])
row.names(out) <- NULL
out
#         Date Parameter conc
#1  2013-01-01      Par1  1.5
#2  2013-01-02      Par1  1.5
#3  2013-01-03      Par1  1.5
#4  2013-01-04      Par1  2.5
#5  2013-01-05      Par1  2.5
#6  2013-01-06      Par1  2.5
#7  2013-01-01      Par2  1.5
#8  2013-01-02      Par2  1.5
#9  2013-01-03      Par2  1.5
#10 2013-01-04      Par2  1.8
#11 2013-01-05      Par2  1.8
#12 2013-01-06      Par2  1.8
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...