R中的像素图像来自字符数组 [英] Pixel image in R from character array

问题描述

我通过将每个输入字符编码为图像中的某种颜色来生成基于像素的图像。例如，在输入 txt< - ABACDAAFFEDDADFAFAED中，我将'A'绘制为红色像素，'B'绘制为紫色，'C'绘制为蓝色和'D'通过其他颜色。我用R来做它。以下是我从这里获得帮助的答案

I have generated a pixel-based image by encoding each input character to a certain color in the image. For example, in input txt <- "ABACDAAFFEDDADFAFAED" i plotted 'A' as a red pixel, 'B' as purple, 'C' by blue and 'D' by some other color. I used R for it. Here is the answer from where I have taken help for this Generate pixel based image in R from character array

Now, I want to update this for handling a case as well where I have a character presents 2 or three times consecutively and I want to give it a different color. For example txt <- "ABBACDAABBBEDDADCACABBDB", i want to give A- red, AA maroon, AAA dark red. B-green, BB- Pink, BBB-yellow, C-light brown, CC brown, CCC dark brown etc.

I still want to give 1 pixel to each char but for consecutive 2 or 3 appearances color those 2 or 3 pixels with a different color. I am unable to code a reasonable solution for it in R. Your help will be appreciated. Thanks

解决方案

I changed the function to support multiple character :

library(png)
library(tiff)
library(abind)

# function which plots the image
createImage <- function(txt,charToColorMap,destinationFile,format=c('png','tiff'),debugPlot=FALSE,unused.char='#'){

  if(nchar(unused.char) != 1){
    stop('unused.char must be a single character, and you should be sure that it will never be present in your text')
  }



  # helper function which finds all the divisors of a number
  divisors <- function(x){
    y <- seq_len(x)
    y[ x%%y == 0 ]
  }

  # split the string in charaters
  chars <- strsplit(txt,'')[[1]]

  # find the most "squared" rectangle that contains all the characters without padding
  d <- divisors(length(chars)) 
  y <- d[length(d) %/% 2]
  x <- length(chars) / y

  # create an array with 4 matrices (or planes) one for each RGBA channel
  RGBAmx <- col2rgb(charToColorMap,alpha=TRUE) / 255
  colorIndexes <- match(chars,names(charToColorMap))

  ######################################
  # MULTIPLE CHAR
  ######################################
  # check if color map contains multiple character names
  multiple <- names(charToColorMap)[nchar(names(charToColorMap)) > 1]
  multiple <- multiple[order(nchar(multiple),decreasing=TRUE)]
  txtForMultiple <- txt
  for(m in multiple){
    idxs <- gregexpr(pattern=m,text=txtForMultiple,fixed=TRUE)[[1]]
    charRanges <- unlist(lapply(idxs,seq,length.out=nchar(m)))
    colorIndexes[charRanges] <- which(names(charToColorMap)==m)[1]
    tmp <- strsplit(txtForMultiple,'')[[1]]
    tmp[charRanges] <- unused.char
    txtForMultiple <- paste(tmp,collapse='')
  }
  #########################################################

  colorIndexesR <- matrix(RGBAmx['red',colorIndexes],nrow=y,ncol=x,byrow = TRUE)
  colorIndexesG <- matrix(RGBAmx['green',colorIndexes],nrow=y,ncol=x,byrow = TRUE)
  colorIndexesB <- matrix(RGBAmx['blue',colorIndexes],nrow=y,ncol=x,byrow = TRUE)
  colorIndexesA <- matrix(RGBAmx['alpha',colorIndexes],nrow=y,ncol=x,byrow = TRUE)

  planes <- abind(colorIndexesR,colorIndexesG,colorIndexesB,colorIndexesA,along=3)

  # write the PNG image
  if(format[1] == 'png'){
    writePNG(planes,destinationFile)
  }else if(format[1] == 'tiff'){
    writeTIFF(planes,destinationFile)
  }else{
    stop('usupported format')
  }

  # for debug purpose only we plot the image...
  if(debugPlot){
    mx <- matrix(colorIndexes,nrow=y,ncol=x,byrow = TRUE)
    image(z=t(mx[nrow(mx):1,]),col=charToColorMap)
  }

  invisible()
}

Usage example ('AAA' set to white) :

charToColorMap <- c(A='red',B='blue',C='green',D='black',E='yellow',F='orange',AAA='white')

txt <- "ABACAAAFFEDDADFAFAED"
# please note that unused.char will be used to mark the characters of txt already analyzed
# during the multi-char handling, so it must not be present in txt
createImage(txt,charToColorMap,destinationFile = "test.png",debugPlot=TRUE,unused.char='#')

Result (zoom 800 %):

这篇关于R中的像素图像来自字符数组的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！