拆分列表元素扩展列表

Question

I'm doing some kind of optical character recognition and face the following issue. I store the glyphs in a list of binary matrices and they can be of different size, but their maximum possible width is wid = 3 columns (may be any defined constant, not just 3). In some cases after the first stage of processing I get data which look like this:

myll <- list(matrix(c(0, 0, 0, 1, 1, 0), ncol = 2),
             matrix(c(0), ncol = 1),
             matrix(c(1, 1, 0), ncol = 3),
             matrix(c(1, 0, 1, 1, 1, 1, 1, 0, 1, 0, 1, 1, 0, 0, 0, 0, 0, 0, 1, 1, 1), ncol = 7),
             matrix(c(1, 1, 1, 1), ncol = 2))
# [[1]]
#      [,1] [,2]
# [1,]    0    1
# [2,]    0    1
# [3,]    0    0
# 
# [[2]]
#      [,1]
# [1,]    0
# 
# [[3]]
#      [,1] [,2] [,3]
# [1,]    1    1    0
# 
# [[4]]
#      [,1] [,2] [,3] [,4] [,5] [,6] [,7]
# [1,]    1    1    1    0    0    0    1
# [2,]    0    1    0    1    0    0    1
# [3,]    1    1    1    1    0    0    1
# 
# [[5]]
#      [,1] [,2]
# [1,]    1    1
# [2,]    1    1

So, some glyphs may be not separated for some reasons. This happens only with glyphs of maximum possible width. Moreover, there may be some junk at the end of the matrix. I have to split them into matrices of width ncol = wid leaving the last piece (junk) as is. Then I store this matrices in separate elements of list to get the following output:

# [[1]]
#      [,1] [,2]
# [1,]    0    1
# [2,]    0    1
# [3,]    0    0
# 
# [[2]]
#      [,1]
# [1,]    0
# 
# [[3]]
#      [,1] [,2] [,3]
# [1,]    1    1    0
# 
# [[4]]
#      [,1] [,2] [,3]
# [1,]    1    1    1
# [2,]    0    1    0
# [3,]    1    1    1
# 
# [[5]]
#      [,1] [,2] [,3]
# [1,]    0    0    0
# [2,]    1    0    0
# [3,]    1    0    0
# 
# [[6]]
#      [,1]
# [1,]    1
# [2,]    1
# [3,]    1
# 
# [[7]]
#      [,1] [,2]
# [1,]    1    1
# [2,]    1    1

At the moment I can make it with the help of this functions

checkGlyphs <- function(gl_m, wid = 3) {
  if (ncol(gl_m) > wid) 
    return(list(gl_m[,1:wid], matrix(gl_m[,-(1:wid)], nrow = nrow(gl_m)))) else
    return(gl_m)
}

separateGlyphs <- function(myll, wid = 3) {
  require("magrittr")

  presplit <- lapply(myll, checkGlyphs, wid) 
  total_new_length <- 
    presplit[unlist(lapply(presplit, is.list))] %>% lapply(length) %>% unlist() %>% sum() +
    as.integer(!unlist(lapply(presplit, is.list))) %>% sum()

  splitted <- vector("list", length = total_new_length)
  spl_index <- 1
  for (i in 1:length(presplit)) 
  {
    if (!is.list(presplit[[i]])) 
    {   
      splitted[[spl_index]] <- presplit[[i]]
      spl_index <- spl_index + 1 
    } else
    { 
      for (j in 1:length(presplit[[i]]))
      {   
        splitted[[spl_index]] <- presplit[[i]][[j]]
        spl_index <- spl_index + 1 
      }
    }
  }

  if (any(lapply(splitted, ncol) > wid)) return(separateGlyphs(splitted, wid)) else
    return(splitted)
}

But I believe there is more fast and convenient way to achieve the same result (without using for loops and this enlooped reassignment of elements and then recursion if needed O_o).

I will be thankful for any suggestions on the point or, alternatively, for recommending some OCR-packages for R.

Answer 1

This should do the trick, with the values in final being what you're after.

combined <- do.call(cbind, lapply(myll, unlist))
idx <- seq(1, ncol(combined), 2)
final <- do.call(list, lapply(idx, function(x) combined[, x:(x+1)]))