3
\$\begingroup\$

Right now this function takes an excessively long time to run, please let me know how to make it more efficient.

lunarCal is 144x7 and the dput for it is here.

Here's the code:

if(!require(pacman)) install.packages("pacman")
pacman::p_load(lubridate)
cat("Please make sure that birthday inputs are in YYYY-MM-DD format")

lunarCal             <- readRDS("data/lunarCal.RDS")

eastern.profile <- function(birthday){
    good                 <- is.na.POSIXlt(birthday)
    if(!(good)){birthday <- strptime(birthday, format = "%Y-%m-%d", tz = "Asia/Chongqing")}
    ind                  <- (lunarCal$START_DATE <= birthday) & (lunarCal$END_DATE >= birthday)
    temp                 <- subset(lunarCal, ind)
    return(temp)
}

Here's an example of its non-vectorized usage:

eastern.profile("1975-01-01")
   YEAR START_DATE   END_DATE ANIMAL ELEMENT ASPECT                                   PERSONALITY
75 1974 1974-01-23 1975-02-10  Tiger    Wood      + Imagination, creativity, idealism, compassion

When I run it I'm using sapply but it's still slow. I've got a data set with 250,000 dates I'm applying it to and it took over 15 minutes. We can simulate the data set to run this function on with

dat <- as.data.frame(seq(as.Date("1900/1/1"), as.Date("2040/1/1"), "days"))
dat <- rbind(dat,dat,dat,dat)
\$\endgroup\$
  • \$\begingroup\$ Hello! Please don't make changes to the original post once it has been reviewed, as that invalidates the current answers. Please see our meta side on performing iterative reviews for more information! \$\endgroup\$ – syb0rg Jun 15 '16 at 15:17
  • \$\begingroup\$ Hi @syb0rg! OK, sorry about that, but there's only 1 current answer and it returns an error (in part) because of the fact that I didn't put as.data.frame() around the first line of my suggested simulation of the data. So I'm changing it to make the current answer valid... \$\endgroup\$ – Hack-R Jun 15 '16 at 15:19
  • 1
    \$\begingroup\$ Ah, I see. I only saw you edited the code after an answer was given and thought it would invalidate the answer. Thanks for correcting me! \$\endgroup\$ – syb0rg Jun 15 '16 at 15:21
2
\$\begingroup\$

Have a look at the function findInterval. It is vectorized so it can treat all your dates in a single (fast) call. Your code should look something like this:

eastern.profile <- function(birthday) {
   bad <- !is.na.POSIXlt(birthday)
   birthday[bad] <- strptime(birthday[bad], format = "%Y-%m-%d", tz = "Asia/Chongqing")
   ind <- findInterval(birthday, lunarCal$START_DATE)
   cbind(birthday = birthday, lunarCal[ind, ])
}

Note that I was not able to test because of some issues I had with your data. So it may need some tweaks.

\$\endgroup\$
  • \$\begingroup\$ Thanks much! I'll mark this as the solution for findInterval. Part of the problem may be that we need to put as.data.frame around the first line of the simulated data. However, even after doing that and sorting the data non-decreasingly it still throws an error. Error in as.POSIXct.numeric(x) : 'origin' must be supplied I know this error is usually solved by setting an origin of the Unix epoch, but that doesn't seem to working here. \$\endgroup\$ – Hack-R Jun 15 '16 at 15:22

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.