SO30528592

tableMaker.R

tableMaker <- function(invec) {
  ## http://stackoverflow.com/q/30528592/1270695
  require(data.table)
  ## Split up the vector
  temp <- strsplit(invec, ",", TRUE)
  ## How long is each vector?
  a <- lengths(temp)
  ## Which vectors need adjustment?
  ind <- which(a %% 2 == 0)
  ## Adjust only those that need adjustment
  temp[ind] <- lapply(temp[ind], function(x) {
    c(x[1:(length(x)-1)], x[length(x)-2], x[length(x)])
  })
  ## Recalculate lengths
  a <- lengths(temp)
  ## Figure out where the IDs are
  a2 <- c(1, cumsum(a[-length(a)]) + 1)
  ## Unlist the data
  tempUL <- unlist(temp)
  ## Grab the IDs and repeat them to the necessary length
  ID <- rep(tempUL[a2], a/2)
  ## Make a 2 column matrix from the remaining values
  MAT <- matrix(tempUL[-a2], ncol = 2, byrow = TRUE, 
                dimnames = list(NULL, c("X", "Z")))
  ## Combine it into a data.table and run type.convert
  data.table(ID, MAT)[, lapply(.SD, type.convert)]
}

Test case:

tableMaker <- function(invec) {
  require(data.table)
  temp <- strsplit(invec, ",", TRUE)
  a <- lengths(temp)
  ind <- which(a %% 2 == 0)
  temp[ind] <- lapply(temp[ind], function(x) {
    c(x[1:(length(x)-1)], x[length(x)-2], x[length(x)])
  })
  a <- lengths(temp)
  a2 <- c(1, cumsum(a[-length(a)]) + 1)
  tempUL <- unlist(temp)
  ID <- rep(tempUL[a2], a/2)
  MAT <- matrix(tempUL[-a2], ncol = 2, byrow = TRUE, 
                dimnames = list(NULL, c("X", "Z")))
  data.table(ID, MAT)[, lapply(.SD, type.convert)]
}

roland <- function(invec) {
  invec <- strsplit(invec, ",", fixed = TRUE)

  #parse
  res <- lapply(invec, function(x) {
    y <- type.convert(x[-1])
    test <- length(y) %% 2 #unequal count of numbers?
    z <- y[seq_len(length(y) - test)]
    mat <- matrix(z, ncol = 2, byrow = TRUE)
    if (test == 1L) mat <- rbind(mat, c(mat[nrow(mat), 1], tail(y, 1)))
    data.frame(ID = x[1], 
               X = mat[,1],
               Z = mat[,2])
  })
  do.call(rbind, res)
}


dat <- readLines(textConnection("ABC,1,1.5,2,2.4,3,3.1
DEF,1,1.7,2,0.9
GHI,3,8.2
JKL,1,1.5,2,2.4,3,3.13,8.2"))

dat1000 <- rep(dat, 1000/length(dat))
dat10k <- rep(dat, 10000/length(dat))

library(microbenchmark)
microbenchmark(tableMaker(dat1000), roland(dat1000), times = 10)
# Unit: milliseconds
#                 expr        min        lq       mean     median         uq        max neval
#  tableMaker(dat1000)   2.346186   2.53734   2.647924   2.573726   2.730987   3.048823    10
#      roland(dat1000) 382.857587 391.46409 406.925600 402.442203 412.203468 452.420665    10

microbenchmark(tableMaker(dat10k), roland(dat10k), times = 5)
# Unit: milliseconds
#                expr        min         lq       mean     median         uq        max neval
#  tableMaker(dat10k)   19.24391   22.51366   24.57222   23.43996   27.11431   30.54927     5
#      roland(dat10k) 6286.45480 6324.42184 6497.16173 6325.32259 6355.39668 7194.21274     5