Matt
Matt

Reputation: 333

Extract dates from date range and assign value

I have the following data frame:

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))

What I will need to do is extract the dates wihtin each date range for each parameter and assign the concentration value to each of the dates from this range and put all those information in a new data frame. The result should look like this:

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

Upvotes: 1

Views: 292

Answers (2)

akrun
akrun

Reputation: 887501

Here is one option with tidyverse. Create a list column by taking the sequence of 'Date_from' to 'Date_to' (map), remove the unwanted columns (select) and 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

Or it can be done with 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

Upvotes: 3

hrbrmstr
hrbrmstr

Reputation: 78832

We can do this without a 57-dependency set of packages:

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
    )
  })
)

Using the pre-type-converted data frame from the 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

Upvotes: 2

Related Questions