2
\$\begingroup\$

I have the following data frame:

set.seed(1)
SOURCE <- as.data.frame(matrix(c((1:10), 
                             sample(c("20-24","25-28"), 10, replace = TRUE), 
                             sample(c("10000", "20000"), 10, replace = TRUE), 
                             sample(c(1, NA), 10, replace = TRUE), 
                             sample(c(2, NA), 10, replace = TRUE), 
                             sample(c(3, NA), 10, replace = TRUE)), nrow = 10), stringsAsFactors = FALSE)

names(SOURCE) <- c("id", "age", "income", "IS_1", "IS_2", "IS_3")
SOURCE$SUM_1 <- sample(c(1000, 10000), 10, replace = TRUE) * as.numeric(SOURCE$IS_1)
SOURCE$SUM_2 <- sample(c(1000, 10000), 10, replace = TRUE) * as.numeric(SOURCE$IS_2)
SOURCE$SUM_3 <- sample(c(1000, 10000), 10, replace = TRUE) * as.numeric(SOURCE$IS_3)

For each line I want to find additional IS group, by doing the following:

SOURCE$BUCKET <- do.call(paste, c(SOURCE[, c(4,5,6)]))
for (i in 1:nrow(SOURCE)) {
  steady <- as.vector(read.table(text = SOURCE$BUCKET[i], sep = " ", colClasses = "numeric"))
  ready <- steady[!is.na(steady)]
  SOURCE$IS_BREADTH[i] <- length(ready)
  SOURCE$PATTERN[i] <- paste0("(?=.*", ready, ")", collapse = "")
}
require("data.table")
DIMPORT <- data.table(SOURCE)

Also, I don't want my algorithm to return me the same IS group, the person is active in. So I use the following:

na.replace <- function (x) {
  ifelse(is.na(x) == TRUE,  x <- 1, x <- NA)
  return(x)
}

And here comes the iterative part:

j <- data.frame()
d <- data.frame()
for (i in 1:nrow(DIMPORT)) {
  print(i)
  Xid <- DIMPORT$id[i]
  Xage <- DIMPORT$age[i]
  Xpattern <- DIMPORT$PATTERN[i]
  Xincome <- DIMPORT$income[i]
  Xbreadth <- DIMPORT$IS_BREADTH[i]
  if (DIMPORT$IS_BREADTH[i] == 0){
    Xcategory <- "UNKNOWN"
    Xsum <- "UNKNOWN"
    j <- as.data.frame(matrix(c(Xid, Xage, Xpattern, Xincome, Xcategory, Xsum), nrow = 1))
    d <- rbind(d, j)
  } else {
    DSEGMENT <- DIMPORT[age == Xage & IS_BREADTH == Xbreadth + 1 & income == Xincome & grepl(Xpattern, DIMPORT$BUCKET, perl = TRUE)]
    if (nrow(DSEGMENT) == 0) {
      Xcategory <- "UNDETECTABLE"
      Xsum <- "UNDETECTABLE"
      j <- as.data.frame(matrix(c(Xid, Xage, Xpattern, Xincome, Xcategory, Xsum), nrow = 1))
      d <- rbind(d, j)
      } else {
      IS_vector <- c(na.replace(DIMPORT$IS_1[i]), na.replace(DIMPORT$IS_2[i]), na.replace(DIMPORT$IS_3[i]))
      DZ <- DSEGMENT[, list("1" = sum(!is.na(IS_1)) / length(id), "2" = sum(!is.na(IS_2)) / length(id), "3" = sum(!is.na(IS_3)) / length(id))] * IS_vector
      category <- paste0(names(which.max(DZ)))
      DB <- DSEGMENT[, grepl(paste0("(?=.*_", category, "$)", collapse = ""), names(DSEGMENT), perl = TRUE), with = FALSE]
      names(DB) <- c("IS", "SUM")
      DB <- DB[complete.cases(DB)]
      Xsum <- as.character(DB[, list(SPEND_PER_ID = sum(SUM) / nrow(DB))])
      Xcategory <- category
      j <- as.data.frame(matrix(c(Xid, Xage, Xpattern, Xincome, Xcategory, Xsum), nrow = 1))
      d <- rbind(d, j)
      }
  }
}

The result is fine, though the speed is about 2 lines per second in non-mockup data (127 columns). Is there any way to improve the speed?

\$\endgroup\$
4
  • \$\begingroup\$ Welcome! Can you try to explain a little what your data represents and what your code is trying to accomplish? Also, are SOURCE and DIMPORT meant to be the same object? If yes, should SOURCE contain an IS_BREADTH column? \$\endgroup\$
    – flodel
    Sep 17, 2016 at 23:30
  • \$\begingroup\$ When you mention 127 columns, does that mean that your data has many more IS_??? and SUM_??? columns? How many exactly? Are the IS_??? meant to be booleans? I see you for example fill IS_2 with two types of values: 2 or NA. Does a value of 2 means "yes" and a value of NA mean "no"? Also, what is the meaning of the SUM_??? columns? \$\endgroup\$
    – flodel
    Sep 17, 2016 at 23:49
  • \$\begingroup\$ Very important, please make sure the code you provide us runs properly in a fresh new session and that it creates the expected output. Currently it is not the case for some of the reasons I have listed above. \$\endgroup\$
    – flodel
    Sep 18, 2016 at 0:05
  • \$\begingroup\$ @flodel technically yes, SOURCE and DIMPORT are the same object, thanks for pointing that out. Yes, there'is more IS (total of 27) and SUM and two extra called FREQ of occurance and MONTH of occurance, which gives 27 * 4 = 108 columns + some initial ones. A value 2 means there had been at least one occurance. I use 1, 2, ... 27 to get them passed for grepl. \$\endgroup\$
    – user23809
    Sep 18, 2016 at 6:28

0

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Browse other questions tagged or ask your own question.