In linogaliana/gravity: Gravity model with large scale data

  knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>"
  )

library(gravity)

Data used

df <- data.frame(x1 = rnorm(1e6), x2 = rnorm(1e6), x3 = rnorm(1e6))
df$y <- exp(2*df$x1 - 0.02*df$x2 - df$x3  + rnorm(1e6))
df$y2 <- floor(df$y)
df$off <- df$y - df$y2
head(df)

system.time(
  MASS::glm.nb(y2 ~ x1 + x2 + x3 + offset(off),
               control = glm.control(epsilon = 1e-2),
               data = df)
)
system.time(
  gravity::fastglm.nb(y2 ~ x1 + x2 + x3 + offset(off),
                      control = glm.control(epsilon = 1e-2),
                      data = df)
)

mean(df$y2 == 0)

system.time(
  pscl::zeroinfl(formula = y2 ~ x1 + x2 + x3,
                 offset = off,
                 control = pscl::zeroinfl.control(reltol = 1e-2),
                 data = df)
)
system.time(
  gravity::fastzeroinfl(
    formula = y2 ~ x1 + x2 + x3,
    offset = off,
    control = pscl::zeroinfl.control(reltol = 1e-2),
    data = df)
)

Memory

profvis::profvis({
  MASS::glm.nb(y2 ~ x1 + x2 + x3 + offset(off),
               control = glm.control(epsilon = 1e-2),
               data = df)
})
profvis::profvis({
  gravity::fastglm.nb(y2 ~ x1 + x2 + x3 + offset(off),
                      control = glm.control(epsilon = 1e-2),
                      data = df)
})

profvis::profvis({
  pscl::zeroinfl(formula = y2 ~ x1 + x2 + x3,
                 offset = off,
                 control = pscl::zeroinfl.control(reltol = 1e-2),
                 data = df)
})
profvis::profvis({
  gravity::fastzeroinfl(
    formula = y2 ~ x1 + x2 + x3,
    offset = off,
    control = pscl::zeroinfl.control(reltol = 1e-2),
    data = df)
})

Test depending on speed

df <- data.frame(x1 = rnorm(1e6), x2 = rnorm(1e6))
df$y <- exp(2*df$x1 - df$x2  + rnorm(1e6))
df$y2 <- floor(df$y)
df$off <- df$y - df$y2
head(df)

test_speed <- lapply(c(1e3, 1e4, 1e5, 5e5, 1e6, 3e6, 5e6, 8e6, 1e7), function(n) ({
  as.numeric(
  system.time(
    pscl::zeroinfl(formula = y2 ~ x1 + x2,
                   offset = off,
                   control = pscl::zeroinfl.control(reltol = 1e-2),
                   data = df[1:n,])
  )['elapsed']
)}))

test_speed2 <- lapply(c(1e3, 1e4, 1e5, 5e5, 1e6, 3e6, 5e6, 8e6, 1e7), function(n) ({
  as.numeric(
  system.time(
    gravity::fastzeroinfl(formula = y2 ~ x1 + x2,
                   offset = off,
                   control = pscl::zeroinfl.control(reltol = 1e-2),
                   data = df[1:n,])
  )['elapsed']
)}))

vitesse_zeroinfl <- data.frame(
  size = c(1e3, 1e4, 1e5, 5e5, 1e6, 3e6, 5e6, 8e6, 1e7),
  pscl = as.numeric(test_speed),
  gravity = as.numeric(test_speed2)
)

vitesse_zeroinfl <- reshape2::melt(vitesse_zeroinfl, id.vars = "size",
               value.name = "speed")

ggplot2::ggplot(vitesse_zeroinfl) + ggplot2::geom_line(ggplot2::aes(x = size, y = speed, color = variable))