Write a Function Which Given an Int N Prints Out a Slashbased Ascii Art Ofsize N

avril 28, 2022 Enregistrer un commentaire

Simon Barthelmé (GIPSA-lab, CNRS)

ASCII art is the art of drawing pictures using text (specifically, the 128 characters immune by standard ASCII). In this case we'll come across how to use imager to render pictures into ASCII, in the mode of prototype-to-ASCII converters like AAlib.

We'll be using imager and tools from the tidyverse, and an prototype of a blossom every bit an example:

          ##The tidyverse package loads dplyr, purrr, etc.  library(tidyverse) library(imager) ##Optional: cowplot has nicer defaults for ggplot library(cowplot)

          ## Warning: `legend.margin` must be specified using `margin()`. For the old ## behavior utilise fable.spacing

          im <- load.image("https://upload.wikimedia.org/wikipedia/commons/pollex/f/fd/Aster_Tataricus.JPG/1024px-Aster_Tataricus.JPG")  plot(im)

The first strategy we'll explore is to render pixels every bit characters, using darker characters for darker pixels.

Starting time, we generate a set of ASCII characters:

          asc <- gtools::chr(38:126) #We utilize a subset of ASCII, R doesn't return the residual caput(asc,10)

          ##  [1] "&" "'" "(" ")" "*" "+" "," "-" "." "/"

Next, nosotros measure out how dark these characters by having R describe them on an image, then by computing the average image lightness: for this we use imager'south implot function, which uses R base graphics to plot things on images.

          #Draw some text on a white background:  txt <- imfill(50,50,val=1) %>% implot(text(20,xx,"Blah"))  txt

          ## Image. Width: 50 pix Acme: 50 pix Depth: 1 Colour channels: 3

          plot(txt,interp=Imitation)

          ##A role that plots a single character and measures its lightness  one thousand.chr <- office(chr) implot(imfill(50,50,val=1),text(25,25,chr,cex=5)) %>% grayscale %>% mean g <- map_dbl(asc,g.chr) n <- length(g) plot(1:n,sort(g),type="n",xlab="Order",ylab="Lightness") text(ane:n,sort(g),asc[order(g)])

The plot shows the characters on an centrality of increasing lightness. To render the image we'll quantise the grayscale levels into as many bins every bit nosotros have characters, and plot the effect:

          #Sort the characters past increasing lightness char <- asc[order(yard)] #Catechumen image to grayscale, resize, catechumen to data.frame d <- grayscale(im) %>% imresize(.1)  %>% as.data.frame #Quantise d <- mutate(d,qv=cut_number(value,due north) %>% as.integer) #Assign a character to each quantised level d <- mutate(d,char=char[qv]) #Plot ggplot(d,aes(x,y))+geom_text(aes(label=char),size=1)+scale_y_reverse()

And then far we have matched pixels to characters based on their average lightness. Nosotros could become on to match prototype patches to characters, finding the character that is most similar to each prototype patch. The following piece of lawmaking implements this idea, but, for a change, instead of ASCII characters we'll employ R's gear up of plotting symbols.

The get-go stride is to divide the image into patches:

          #psize is the patch size in pixels (nosotros'll utilise odd patch sizes for simplicity) psize <- 5 #center of the patch cen <- ceiling(psize/2)  #produces a grid of coordinates for the center of each patch gr <- grayscale(im) %>% pixel.grid %>%     filter((x %% psize)==cen,(y %% psize) == cen)  plot(im,xlim=c(200,250),ylim=c(200,250)) with(gr,points(x,y,cex=1,col="cherry-red"))

          #extract an image patch at each point on the grid ptch <- extract_patches(im,gr$x,gr$y,psize,psize)  #NB: ptch is an image list, in which each chemical element is an image patch ptch

          ## Image list of size 41205

The second step is to render all characters as paradigm patches of the same size:

          syms <- 1:25  render <- function(sym) implot(imfill(psize,psize,val=1),points(cen,cen,pch=sym,cex=1)) %>% grayscale ptch.c <- map(syms,return) plot(ptch.c[[four]],interp=FALSE)

Of course at that resolution the rendering of each letter is spring to be pretty crummy (the above is supposed to be "A").

The third step is to match each epitome patch to the character it most resembles. For that nosotros'll use the excellent nearest neighbour function from the nabor package:

          #Convert patches to a long matrix  Pim <- map(ptch,equally.vector) %>% do.call(rbind,.)  Pc <- map(ptch.c,as.vector) %>% do.telephone call(rbind,.) nn <- nabor::knn(Pc,Pim,1)$nn.idx mutate(gr,sym=syms[nn]) %$% plot(x,y,pch=sym,cex=.2,ylim=c(elevation(im),i))

I'll admit, this isn't the prettiest bloom, but at that place you go. Feel free to better.

For the reader's amusement, I'm adding a last piece of lawmaking along the same lines: it reconstructs an prototype using a collection of patches (for instance, patches extracted from another image).

          ##Extract patches of a given size extract.all <- function(im,psize=v)     {         cen <- ceiling(psize/ii)         gr <- pixel.grid(R(im)) %>% filter((x %% psize)==cen,(y %% psize) == cen)          extract_patches(im,gr$x,gr$y,psize,psize)     }  friction match.patches <- office(dict,im) {     psize <- pinnacle(dict[[ane]]) #Patches are assumed to be square     ##Resize to make certain the image can be cut into an integer number of patches     im <- resize(im,(width(im) %/% psize)*psize,(superlative(im) %/% psize)*psize)          pim <- extract.all(im,psize)     Pa <- map(dict,equally.vector) %>% exercise.telephone call(rbind,.)     Atomic number 82 <-  map(pim,equally.vector) %>% practice.call(rbind,.)     nn <- nabor::knn(Pa,Pb,1)$nn.idx %>% c     imappend(dict[nn],"10") %>% imsplit("ten",-width(im)) %>% imappend("y")  }  ##Render the R logo using image patches extracted from the "parrots" image dict <- load.example("parrots") %>% extract.all(7) im <- imager::load.image("https://cran.r-project.org/Rlogo.jpg") lucifer.patches(dict,im) %>% plot

          ##Return "tennis" as ASCII art render <- function(chr) implot(imfill(psize,psize,val=1),text(cen,cen,chr,cex=.8)) %>% grayscale tennis <- load.case("tennis")/255 dict <- map_il(asc,render) tennis.asc <- imsplit(tennis,"z") %>% map(~ match.patches(dict,.))  %>% imappend("z")