Source: https://github.com/markziemann/RN4CB

Intro

In this script, I’m attempting to do some logo design with R because I don’t want to use AI for this task.

#install.packages("system_fonts")
library(systemfonts)
library(scales)
library(viridis)

Make a blank chart with some text

List the available typefaces.

x <- c(0,0,10,10)
y <- c(0,10,0,10)
plot(x,y,xaxt="n", yaxt="n", bty="n",xlab="",ylab="",col="white")
text(5,5,"RN4CB",cex=10)

myfonts <- system_fonts()
head(myfonts)
## # A tibble: 6 × 10
##   path           index name  family style weight width italic monospace variable
##   <chr>          <int> <chr> <chr>  <chr> <ord>  <ord> <lgl>  <lgl>     <lgl>   
## 1 /usr/share/fo…     0 URWG… URW G… Book… normal norm… FALSE  FALSE     FALSE   
## 2 /usr/share/te…     0 TeXG… TeX G… Bold… bold   norm… TRUE   FALSE     FALSE   
## 3 /usr/share/fo…     0 Lato… Lato   Thin… normal norm… TRUE   FALSE     FALSE   
## 4 /usr/share/fo…     0 Libe… Liber… Bold  bold   norm… FALSE  FALSE     FALSE   
## 5 /usr/share/fo…     0 Cour… Couri… Bold… bold   norm… TRUE   TRUE      FALSE   
## 6 /usr/share/fo…     0 Lato… Lato   Semi… semib… norm… TRUE   FALSE     FALSE
tail(myfonts)
## # A tibble: 6 × 10
##   path           index name  family style weight width italic monospace variable
##   <chr>          <int> <chr> <chr>  <chr> <ord>  <ord> <lgl>  <lgl>     <lgl>   
## 1 /usr/share/fo…     0 cmex… cmex10 LyX   normal norm… FALSE  FALSE     FALSE   
## 2 /usr/share/fo…     0 Stan… Stand… Regu… normal norm… FALSE  FALSE     FALSE   
## 3 /usr/share/te…     0 TeXG… TeX G… Regu… normal norm… FALSE  FALSE     FALSE   
## 4 /usr/share/fo…     0 URWB… URW B… Demi  semib… norm… FALSE  FALSE     FALSE   
## 5 /usr/share/fo…     0 Nimb… Nimbu… Bold  bold   norm… FALSE  FALSE     FALSE   
## 6 /usr/share/fo…     0 D050… D0500… Regu… normal norm… FALSE  FALSE     FALSE
unique(myfonts$family)
##  [1] "URW Gothic"                   "TeX Gyre Heros"              
##  [3] "Lato"                         "Liberation Sans"             
##  [5] "Courier"                      "Nimbus Mono PS"              
##  [7] "Liberation Mono"              "TeX Gyre Heros Cn"           
##  [9] "Nimbus Roman"                 "Latin Modern Roman"          
## [11] "TeX Gyre Schola"              "Latin Modern Mono Light Cond"
## [13] "Nimbus Sans Narrow"           "D050000L"                    
## [15] "P052"                         "Latin Modern Mono Slanted"   
## [17] "URW Bookman"                  "TeX Gyre Bonum"              
## [19] "Nimbus Sans"                  "MathJax_SansSerif"           
## [21] "DejaVu Serif"                 "Latin Modern Sans"           
## [23] "DejaVu Sans"                  "TeX Gyre Termes Math"        
## [25] "Z003"                         "Liberation Serif"            
## [27] "Liberation Sans Narrow"       "Bitstream Charter"           
## [29] "MathJax_Size4"                "TeX Gyre Pagella Math"       
## [31] "C059"                         "Latin Modern Roman Caps"     
## [33] "TeX Gyre Adventor"            "MathJax_WinChrome"           
## [35] "Latin Modern Sans Quotation"  "Latin Modern Mono Light"     
## [37] "MathJax_Main"                 "Latin Modern Mono Prop Light"
## [39] "msbm10"                       "cmmi10"                      
## [41] "Standard Symbols PS"          "dsrom10"                     
## [43] "MathJax_Vector"               "TeX Gyre DejaVu Math"        
## [45] "TeX Gyre Cursor"              "MathJax_Fraktur"             
## [47] "Noto Mono"                    "DejaVu Sans Mono"            
## [49] "TeX Gyre Pagella"             "MathJax_Size1"               
## [51] "TeX Gyre Termes"              "MathJax_Caligraphic"         
## [53] "Noto Sans Mono"               "Latin Modern Roman Slanted"  
## [55] "MathJax_WinIE6"               "Droid Sans Fallback"         
## [57] "Latin Modern Roman Dunhill"   "wasy10"                      
## [59] "Bitstream Vera Serif"         "MathJax_Math"                
## [61] "MathJax_Vector-Bold"          "MathJax_Size3"               
## [63] "Latin Modern Sans Demi Cond"  "MathJax_Typewriter"          
## [65] "MathJax_Size2"                "Latin Modern Mono"           
## [67] "Latin Modern Mono Caps"       "Utopia"                      
## [69] "cmr10"                        "eufm10"                      
## [71] "esint10"                      "Bitstream Vera Sans Mono"    
## [73] "Latin Modern Mono Prop"       "DejaVu Math TeX Gyre"        
## [75] "MathJax_Script"               "GLYPHICONS Halflings"        
## [77] "Latin Modern Roman Demi"      "stmary10"                    
## [79] "MathJax_AMS"                  "rsfs10"                      
## [81] "Bitstream Vera Sans"          "msam10"                      
## [83] "cmsy10"                       "TeX Gyre Bonum Math"         
## [85] "Latin Modern Roman Unslanted" "TeX Gyre Chorus"             
## [87] "Latin Modern Math"            "cmex10"                      
## [89] "TeX Gyre Schola Math"

The number of families is less than the number of fonts due to typefaces having different width and italic styles.

Font styles

Now we can look at the different font styles like italics and bold.

par(mfrow=c(2,2))
plot(x,y,xaxt="n", yaxt="n", bty="n",xlab="",ylab="",col="white")
text(5,5,"RN4CB",family=myfonts[1,"family"],font=1, cex=2)

plot(x,y,xaxt="n", yaxt="n", bty="n",xlab="",ylab="",col="white")
text(5,5,"RN4CB",family=myfonts[1,"family"],font=2, cex=2)

plot(x,y,xaxt="n", yaxt="n", bty="n",xlab="",ylab="",col="white")
text(5,5,"RN4CB",family=myfonts[1,"family"],font=3, cex=2)

plot(x,y,xaxt="n", yaxt="n", bty="n",xlab="",ylab="",col="white")
text(5,5,"RN4CB",family=myfonts[1,"family"],font=4, cex=2)

par(mfrow=c(1,1))

Now we can show all the typefaces with all the font styles.

families <- unique(myfonts$family)
families <- families[order(families)]

par(mar=c(0,1,1.5,0))

par(mfrow=c(6,4))
null <- lapply(1:length(families),function(i) {
  plot(x,y,xaxt="n", yaxt="n", bty="n",xlab="",ylab="",col="white")
  text(5,5,"RN4CB", family=families[i], font=1, cex=3)
  mtext(families[i],cex=1)

  plot(x,y,xaxt="n", yaxt="n", bty="n",xlab="",ylab="",col="white")
  text(5,5,"RN4CB", family=families[i],font=2, cex=3)

  plot(x,y,xaxt="n", yaxt="n", bty="n",xlab="",ylab="",col="white")
  text(5,5,"RN4CB", family=families[i],font=3, cex=3)

  plot(x,y,xaxt="n", yaxt="n", bty="n",xlab="",ylab="",col="white")
  text(5,5,"RN4CB", family=families[i],font=4, cex=3)

})

par(mfrow=c(1,1))

Candidate grid

skycols <- colors()[grep("sky",colors())]

set.seed(42) ; myseeds <- sample(0:10000)

set.seed(myseeds[1]) ; x <- sample(0:10,size=SIZE*100,replace=TRUE)
set.seed(myseeds[2]) ; y <- sample(0:10,size=SIZE*100,replace=TRUE)
set.seed(myseeds[5]) ; mycols <- sample(skycols,size=length(x),replace=TRUE)

df <- data.frame(x,y)
df <- unique(df)[1:SIZE,]

plot(df,xaxt="n", yaxt="n", bty="n",xlab="",ylab="",col="white",xlim=c(0,10),ylim=c(0,10))

set.seed(myseeds[6]) ; df2 <- df[sample(1:SIZE,size=SIZE,replace=T),]
lines(df2,col="gray",lwd=1.5)
lines(df,col="lightgray",lwd=1.5)
points(df, cex=1.6, pch=19, col=mycols)

text(5.1,5,"RN4CB", family="TeX Gyre Adventor",font=1, cex=10)

Network chaos

This one looks OK.

skycols <- colors()[grep("sky",colors())]

null <- lapply(1:3,function(i) {

set.seed(i) ; myseeds <- sample(0:10000)
SIZE=25
set.seed(myseeds[1]) ; x <- sample(0:10000,size=SIZE,replace=FALSE)/1000
set.seed(myseeds[2]) ; y <- sample(0:10000,size=SIZE,replace=FALSE)/1000
set.seed(myseeds[5]) ; mycols <- sample(skycols,size=length(x),replace=TRUE)

plot(x,y,xaxt="n", yaxt="n", bty="n",xlab="",ylab="",col="white",xlim=c(0,10),ylim=c(0,10))

df <- data.frame(x,y)
set.seed(myseeds[6]) ; df2 <- df[sample(1:SIZE,size=SIZE,replace=T),]
lines(df2,col="darkgray",lwd=5)
lines(df,col="lightgray",lwd=5)

set.seed(myseeds[7]) ; mycex <- rnorm(n=50,mean=3.5,sd=1)

points(x,y, cex=mycex, pch=19, col=mycols)

rect(0, 3, 10, 7,col="white",border="black",lwd=3)

text(5,5,"RN4CB", family="TeX Gyre Adventor",font=1, cex=9)
mtext(i)
})

Network grid

More ordered xy coords.

null <- lapply(c(1:3,39),function(i) {

set.seed(i) ; myseeds <- sample(0:10000)
SIZE=25
set.seed(myseeds[1]) ; x <- sample(0:10,size=SIZE*100,replace=TRUE)
set.seed(myseeds[2]) ; y <- sample(0:10,size=SIZE*100,replace=TRUE)
set.seed(myseeds[5]) ; mycols <- sample(skycols,size=length(x),replace=TRUE)

df <- data.frame(x,y)
df <- unique(df)[1:SIZE,]

plot(df,xaxt="n", yaxt="n", bty="n",xlab="",ylab="",col="white",xlim=c(0,10),ylim=c(0,10))

set.seed(myseeds[6]) ; df2 <- df[sample(1:SIZE,size=SIZE,replace=T),]
lines(df2,col="darkgray",lwd=5)
lines(df,col="lightgray",lwd=5)

set.seed(myseeds[7]) ; mycex <- rnorm(n=50,mean=3.5,sd=1)

points(df, cex=mycex, pch=19, col=mycols)

rect(0, 3, 10, 7,col="white",border="black",lwd=3)

text(5,5,"RN4CB", family="TeX Gyre Adventor",font=1, cex=9)
mtext(i)
})

Array grid red/blue

null <- lapply(1:3,function(i) {

set.seed(i) ; myseeds <- sample(0:10000)
SIZE=15

my_palette <- colorRampPalette(c("blue", "gray", "red"))(n = 50)

xy <- expand.grid(1:6,1:6)
set.seed(myseeds[7]) ; mycex <- rnorm(n=nrow(xy),mean=5,sd=1)
set.seed(myseeds[5]) ; mycols <- sample(my_palette,size=nrow(xy),replace=TRUE)

plot(xy,xaxt="n", yaxt="n", bty="n",xlab="",ylab="",col="white",xlim=c(0,7),ylim=c(0,7))

set.seed(myseeds[6]) ; df <- xy[sample(1:nrow(xy),size=SIZE,replace=T),]
set.seed(myseeds[8]) ; df2 <- xy[sample(1:nrow(xy),size=SIZE,replace=T),]

lines(df,col="lightgray",lwd=4)
lines(df2,col="darkgray",lwd=4)

points(xy, cex=mycex, pch=19, col=mycols)

rect(0.6, 2.6, 6.45, 4.4, col="white",border="black",lwd=3.5)

text(3.5,3.5,"RN4CB", family="TeX Gyre Adventor",font=1, cex=8)
mtext(i)

})

Array grid Viridis

null <- lapply(1:3,function(i) {

set.seed(i) ; myseeds <- sample(0:10000)
SIZE=15

my_palette <-  viridis(50)

xy <- expand.grid(1:6,1:6)
set.seed(myseeds[7]) ; mycex <- rnorm(n=nrow(xy),mean=5,sd=1)
set.seed(myseeds[5]) ; mycols <- sample(my_palette,size=nrow(xy),replace=TRUE)

plot(xy,xaxt="n", yaxt="n", bty="n",xlab="",ylab="",col="white",xlim=c(0,7),ylim=c(0,7))

set.seed(myseeds[6]) ; df <- xy[sample(1:nrow(xy),size=SIZE,replace=T),]
set.seed(myseeds[8]) ; df2 <- xy[sample(1:nrow(xy),size=SIZE,replace=T),]

lines(df,col="lightgray",lwd=4)
lines(df2,col="darkgray",lwd=4)

points(xy, cex=mycex, pch=19, col=mycols)

rect(0.6, 2.6, 6.45, 4.4, col="white",border="black",lwd=3.5)

text(3.5,3.5,"RN4CB", family="TeX Gyre Adventor",font=1, cex=8)
mtext(i)

})

Array grid Viridis space

Now try for diamond pattern.

null <- lapply(1:3,function(i) {

set.seed(i) ; myseeds <- sample(0:10000)
SIZE=15

my_palette <-  viridis(50)

xy <- expand.grid(1:7,1:7)
xy <- xy[seq(2,nrow(xy),2),]
set.seed(myseeds[7]) ; mycex <- rnorm(n=nrow(xy),mean=7,sd=1)
set.seed(myseeds[5]) ; mycols <- sample(my_palette,size=nrow(xy),replace=TRUE)

plot(xy,xaxt="n", yaxt="n", xlab="",ylab="",col="white",xlim=c(0.5,7.5),ylim=c(0.5,7.5))

set.seed(myseeds[6]) ; df <- xy[sample(1:nrow(xy),size=SIZE,replace=T),]
set.seed(myseeds[8]) ; df2 <- xy[sample(1:nrow(xy),size=SIZE,replace=T),]

lines(df,col="lightgray",lwd=5)
lines(df2,col="darkgray",lwd=5)

points(xy, cex=mycex, pch=19, col=mycols)

rect(1, 3, 7, 5, col="white",border="black",lwd=3.5)

text(4,4,"RN4CB", family="TeX Gyre Adventor",font=1, cex=8)
mtext(i)

})

Sin waves

curve(sin, to = 4*pi)
curve(cos, to = 4*pi,add=TRUE)

Now a basic plot

x <- seq(0,2*pi,length.out=50)
y <- sin(x)
z <- cos(x)
plot(x/2/pi*10, y, type='l',ylim=c(-2,2),lwd=2,xaxt="n", yaxt="n", bty="n",xlab="",ylab="")
lines(x/2/pi*10, z, type='l',lwd=2)

x2 <- seq(0,2*pi,length.out=10)
y2 <- sin(x2)
z2 <- cos(x2)

points(x2/2/pi*10, y2, type='p',cex=4)
points(x2/2/pi*10, z2, type='p',cex=4)

null <- lapply(1:length(x2), function(i) {
  lines(c(x2[i],x2[i])/2/pi*10 ,c(y2[i],z2[i]) ,lwd=3)
})

DNA helix

Need to make it longer.

par(mar=c(0,1,1.5,0))

mycols <- plasma(5)[1:4]
mycols2 <- rev(mycols)

x <- seq(0,5*pi,length.out=125)
y <- sin(x)
z <- cos(x)
plot(x/2/pi*10, y, type='l',ylim=c(-1,6),lwd=15,xaxt="n", yaxt="n", bty="n",xlab="",ylab="",col="darkgray")
lines(x/2/pi*10, z, type='l',lwd=12,col="darkgray")

x2 <- seq(0,5*pi,length.out=25)
y2 <- sin(x2)
z2 <- cos(x2)

points(x2/2/pi*10, y2, type='p',cex=1,col=mycols,pch=19)
points(x2/2/pi*10, z2, type='p',cex=1,col=mycols2,pch=19)

null <- lapply(1:length(x2), function(i) {
  lines(c(x2[i], x2[i])/2/pi*10, c(y2[i], mean(c(z2[i],y2[i])) ) ,lwd=15, col=mycols[i%%4+1])
  lines(c(x2[i], x2[i])/2/pi*10, c(mean(c(z2[i],y2[i])), z2[i] ) ,lwd=15, col=mycols2[i%%4+1])
})

text(10,2,"RN4CB", family="TeX Gyre Adventor",font=1, cex=10)

Short helix with patchwork

Shorten by 50%

par(mar=c(0,1,1.5,0))

#mycols <- viridis(5)[1:4]
XMAX <- ceiling(max(x)/2/pi*10)+1
XMIN <- 0

YMIN=-1
YMAX=5
plot(x/2/pi*10, y, type='l',ylim=c(-1,5),lwd=15,xaxt="n", yaxt="n",xlab="",ylab="",col="white", bty="n")

df <- expand.grid(seq(XMIN,XMAX,2),seq(-1,4,0.5))
mycols <- rev(tail(inferno(300),50))
set.seed(42) ; points(df,pch=15,cex=7,col=sample(mycols))

mycols <- plasma(5)[1:4]
mycols2 <- rev(mycols)

x <- seq(0,5*pi,length.out=125)
y <- sin(x)
z <- cos(x)
#plot(x/2/pi*10, y, type='l',ylim=c(-1,4),lwd=15,xaxt="n", yaxt="n", bty="n",xlab="",ylab="",col="darkgray")
lines(x/2/pi*10, y, type='l',lwd=20,,col=mako(3)[2])
lines(x/2/pi*10, z, type='l',lwd=20,col=mako(3)[2])

x2 <- seq(0,5*pi,length.out=25)
y2 <- sin(x2)
z2 <- cos(x2)

points(x2/2/pi*10, y2, type='p',cex=1,col=mycols,pch=19)
points(x2/2/pi*10, z2, type='p',cex=1,col=mycols2,pch=19)

null <- lapply(1:length(x2), function(i) {
  lines(c(x2[i], x2[i])/2/pi*10, c(y2[i], mean(c(z2[i],y2[i])) ) ,lwd=15, col=mycols[i%%4+1])
  lines(c(x2[i], x2[i])/2/pi*10, c(mean(c(z2[i],y2[i])), z2[i] ) ,lwd=15, col=mycols2[i%%4+1])
})

text(10,2,"RN4CB", family="TeX Gyre Adventor",font=2, cex=10, col=mako(3)[2])

Binary data background

par(mar=c(0,1,1.5,0))

mysize=42
plot(0:mysize, 0:mysize, type='p',xlim=c(0,mysize),ylim=c(0,mysize),lwd=15,xaxt="n", yaxt="n",xlab="",ylab="",col="white", bty="n")
df <- expand.grid(0:mysize,0:mysize)
#my_palette <- c("white","lightgray","gray","darkgray","black")
my_palette <- plasma(10)[6:9]
mycols <- sample(my_palette,nrow(df),replace=TRUE)
points(df,col=mycols,pch=15,cex=1.5)

rect(3, 16, 39, 26, col="white",border="black",lwd=3)

text(mysize/2,mysize/2,"RN4CB", family="TeX Gyre Adventor",font=1, cex=8, col="black")

Binary data background diamond

par(mar=c(0,1,1.5,0))
mysize=42
plot(0:mysize, 0:mysize, type='p',xlim=c(0,mysize),ylim=c(0,mysize),
  lwd=15,xaxt="n", yaxt="n",xlab="",ylab="",col="white", bty="n")

df <- expand.grid(0:mysize,0:mysize)

df2 <- df[seq(2,nrow(df),2),]

my_palette <- plasma(10)[6:9]
set.seed(42) ; mycols <- sample(my_palette,nrow(df2),replace=TRUE)
points(df2,col=mycols,pch=18,cex=3)

rect(3, 16, 39, 26, col=NA, border="white",lwd=12)
rect(3, 16, 39, 26, col="white",border="black",lwd=2)

text(mysize/2,mysize/2,"RN4CB", family="TeX Gyre Adventor",font=1, cex=8, col="black")
text(mysize*0.12,mysize/2,"{", family="TeX Gyre Adventor",font=1, cex=8, col="black")
text(mysize*0.88,mysize/2,"}", family="TeX Gyre Adventor",font=1, cex=8, col="black")

rect(0, 0, mysize, mysize, col=NA, border="white",lwd=23)
rect(0, 0, mysize, mysize, col=NA, border="black",lwd=2)

Something hexagonal

par(mar=c(0,1,1.5,0))

my_palette <- colorRampPalette(c("white", viridis(10)[1]))(n = 10)

x <- c(6,12,12,6,0,0,6)
y <- c(0,3,9,12,9,3,0)

mysize=12
plot(0:mysize, 0:mysize, type='p',xlim=c(0,mysize),ylim=c(0,mysize),lwd=15,xaxt="n", yaxt="n",xlab="",ylab="",col="white", bty="n")

polygon(x,y, col = my_palette[9], border = my_palette[5], lwd = 15)

lines( (x/5)+4.8, (y/5)+4.8 , col = my_palette[8], lwd = 2)
lines( (x/3)+4, (y/3)+4 , col = my_palette[8], lwd = 2)
lines( (x/2)+3, (y/2)+3 , col = my_palette[8], lwd = 2)
lines( (x/1.5)+2, (y/1.5)+2 , col = my_palette[8], lwd = 2)
lines( (x*0.9)+0.6, (y*0.9)+0.6 , col = my_palette[8], lwd = 2)
lines( (x*0.8)+1.2, (y*0.8)+1.2 , col = my_palette[8], lwd = 2)

x2 <- (x*0.9)+0.6
y2 <- (y*0.9)+0.6
df2 <- data.frame(x2,y2)

lines(  df2[c(1,4),1] , df2[c(1,4),2] , col = my_palette[8], lwd = 2)
lines(  df2[c(6,3),1] , df2[c(6,3),2] , col = my_palette[8], lwd = 2)
lines(  df2[c(5,2),1] , df2[c(5,2),2] , col = my_palette[8], lwd = 2)

points( 6,6, col = my_palette[8], cex = 2, pch=19)
points( (x/5)+4.8, (y/5)+4.8 , col = my_palette[8], cex = 2, pch=19)
points( (x/3)+4, (y/3)+4 , col = my_palette[8], cex = 2, pch=19)
points( (x/2)+3, (y/2)+3 , col = my_palette[8], cex = 2, pch=19)
points( (x/1.5)+2, (y/1.5)+2 , col = my_palette[8], cex = 2, pch=19)
points( (x*0.9)+0.6, (y*0.9)+0.6 , col = my_palette[8], cex = 2, pch=19)
points( (x*0.8)+1.2, (y*0.8)+1.2 , col = my_palette[8], cex = 2, pch=19)

text(mysize*0.1,mysize/2-0.1+1.5,"{", family="TeX Gyre Adventor",font=2, cex=7.5, col=my_palette[3])
text(mysize*0.9,mysize/2-0.1+1.5,"}", family="TeX Gyre Adventor",font=2, cex=7.5, col=my_palette[3])
text(mysize/2,mysize/2+1.5," RN4CB ", family="TeX Gyre Adventor",font=2, cex=8, col=my_palette[3])
text(mysize*0.3,mysize/2-0.1-0.7,"Reproducibility", family="TeX Gyre Adventor",font=1, cex=2, col=my_palette[3],adj=c(0,0))
text(mysize*0.3,mysize/2-0.1-1.5,"Network", family="TeX Gyre Adventor",font=1, cex=2, col=my_palette[3],adj=c(0,0))
text(mysize*0.3,mysize/2-0.1-2.3,"For", family="TeX Gyre Adventor",font=1, cex=2, col=my_palette[3],adj=c(0,0))
text(mysize*0.3,mysize/2-0.1-3.1,"Computational", family="TeX Gyre Adventor",font=1, cex=2, col=my_palette[3],adj=c(0,0))
text(mysize*0.3,mysize/2-0.1-3.9,"Biology", family="TeX Gyre Adventor",font=1, cex=2, col=my_palette[3],adj=c(0,0))

Triangles

Yeah this isn’t good.

par(mar=c(0,1,1.5,0))
mysize=42
plot(0:mysize, 0:mysize, type='p',xlim=c(0,mysize),ylim=c(0,mysize),lwd=15,xaxt="n", yaxt="n",xlab="",ylab="",col="white", bty="n")
df <- expand.grid(0:mysize,0:mysize)

null <- lapply(seq(0,30,6),function(j) {
  lapply(seq(0,30,6),function(i) {
    if (j%%12==0) { m <- 0 } else { m <- 3 }
    x_coords <- c(0+i+m, 6+i+m, 3+i+m)
    y_coords <- c(0+j, 0+j, 6+j)
    polygon(x_coords, y_coords, col = "lightblue", border = "blue", lwd = 2)
    x_coords <- c(3+i+m, 9+i+m, 6+i+m)
    y_coords <- c(6+j, 6+j, 0+j)
    polygon(x_coords, y_coords, col = "lightblue", border = "blue", lwd = 2)
  })
})

DNA Code

set.seed(42) ; myseeds <- sample(0:10000)
par(mar=c(0,1,1.5,0))
mysize=42
plot(0:mysize, 0:mysize, type='p',xlim=c(0,mysize),ylim=c(0,mysize),lwd=15,xaxt="n", yaxt="n",xlab="",ylab="",col="white", bty="n")
df <- expand.grid(0:mysize,0:mysize)
set.seed(myseeds[1]) ; mycols <- sample(c("white","lightgray","darkgray","black"),size=nrow(df),replace=TRUE)
points(df,pch=15,cex=1.5,col=mycols)
set.seed(myseeds[2]) ; mycols2 <- sample(c("white","lightgray","darkgray","black"),size=nrow(df),replace=TRUE)
mypch <- sample(c("A","C","G","T"),size=nrow(df),replace=TRUE)
points(df,pch=mypch,cex=0.8,col=mycols2)
points(df,pch=0,cex=1.5,col="gray")

Asterisk

#my_palette <- plasma(9)[c(1,3,5,2,4,6)]
my_palette <- plasma(9)[c(4,6,8,5,7,9)]
par(mar=c(0,1,1.5,0))
mysize=42
plot(0:mysize, 0:mysize, type='p',xlim=c(0,mysize)*2,ylim=c(0,mysize),
  lwd=15,xaxt="n", yaxt="n",xlab="",ylab="",col="white", bty="n")

x <- c(21,5,35,7,32,20)
y <- c(5,10,12,34,36,22)
mycex <- c(15,20,18,15,20,27)*0.8

lines( c(20,x[1]), c(22,y[1]), lwd=22 )
lines( c(20,x[2]), c(22,y[2]), lwd=22 )
lines( c(20,x[3]), c(22,y[3]), lwd=22 )
lines( c(20,x[4]), c(22,y[4]), lwd=22 )
lines( c(20,x[5]), c(22,y[5]), lwd=22 )

lines( c(20,x[1]), c(22,y[1]), lwd=8, col=my_palette[1])
lines( c(20,x[2]), c(22,y[2]), lwd=8, col=my_palette[2])
lines( c(20,x[3]), c(22,y[3]), lwd=8, col=my_palette[3])
lines( c(20,x[4]), c(22,y[4]), lwd=8, col=my_palette[4])
lines( c(20,x[5]), c(22,y[5]), lwd=8, col=my_palette[5])

points(x,y,cex=mycex,pch=19)
points((x+.8)*0.96,(y+.8)*0.96,cex=mycex-3,pch=19,col=my_palette)

points(20,22,cex=20, pch=19, col=my_palette[1])
points(20,22,cex=16, pch=19, col=my_palette[2])
points(20,22,cex=12, pch=19, col=my_palette[3])
points(20,22,cex=8,  pch=19, col=my_palette[4])
points(20,22,cex=4,  pch=19, col=my_palette[5])

text(54,36,"RN",family="TeX Gyre Adventor", cex=12)
text(55,6,"CB",family="TeX Gyre Adventor", cex=12)
text(47.5,21,"4", family="TeX Gyre Adventor", cex=12, col=my_palette[4])

#abline(v=42)
#my_palette <- plasma(9)[c(1,3,5,2,4,6)]
my_palette <- plasma(9)[c(4,6,8,5,7,9)]
par(mar=c(0,1,1.5,0))
mysize=42
plot(0:mysize, 0:mysize, type='p',xlim=c(0,mysize)*2,ylim=c(0,mysize),
  lwd=15,xaxt="n", yaxt="n",xlab="",ylab="",col="white", bty="n")

x <- c(21,5,35,7,32,20)
y <- c(5,10,12,34,36,22)
mycex <- c(15,20,18,15,20,27)*0.8

lines( c(20,x[1]), c(22,y[1]), lwd=22 )
lines( c(20,x[2]), c(22,y[2]), lwd=22 )
lines( c(20,x[3]), c(22,y[3]), lwd=22 )
lines( c(20,x[4]), c(22,y[4]), lwd=22 )
lines( c(20,x[5]), c(22,y[5]), lwd=22 )

lines( c(20,x[1]), c(22,y[1]), lwd=8, col=my_palette[1])
lines( c(20,x[2]), c(22,y[2]), lwd=8, col=my_palette[2])
lines( c(20,x[3]), c(22,y[3]), lwd=8, col=my_palette[3])
lines( c(20,x[4]), c(22,y[4]), lwd=8, col=my_palette[4])
lines( c(20,x[5]), c(22,y[5]), lwd=8, col=my_palette[5])

points(x,y,cex=mycex,pch=19)
points((x+.8)*0.96,(y+.8)*0.96,cex=mycex-3,pch=19,col=my_palette)

points(20,22,cex=20, pch=19, col=my_palette[1])
points(20,22,cex=16, pch=19, col=my_palette[2])
points(20,22,cex=12, pch=19, col=my_palette[3])
points(20,22,cex=8,  pch=19, col=my_palette[4])
points(20,22,cex=4,  pch=19, col=my_palette[5])

text(55,36,"RN",family="TeX Gyre Adventor", cex=12)
text(55,6,"CB",family="TeX Gyre Adventor", cex=12)
text(55.5,21,"4", family="TeX Gyre Adventor", cex=12, col=my_palette[4])

#abline(v=42)

Session information

sessionInfo()
## R version 4.6.1 (2026-06-24)
## Platform: x86_64-pc-linux-gnu
## Running under: Ubuntu 24.04.4 LTS
## 
## Matrix products: default
## BLAS:   /usr/lib/x86_64-linux-gnu/openblas-pthread/libblas.so.3 
## LAPACK: /usr/lib/x86_64-linux-gnu/openblas-pthread/libopenblasp-r0.3.26.so;  LAPACK version 3.12.0
## 
## locale:
##  [1] LC_CTYPE=en_US.UTF-8       LC_NUMERIC=C              
##  [3] LC_TIME=en_US.UTF-8        LC_COLLATE=en_US.UTF-8    
##  [5] LC_MONETARY=en_US.UTF-8    LC_MESSAGES=en_US.UTF-8   
##  [7] LC_PAPER=en_US.UTF-8       LC_NAME=C                 
##  [9] LC_ADDRESS=C               LC_TELEPHONE=C            
## [11] LC_MEASUREMENT=en_US.UTF-8 LC_IDENTIFICATION=C       
## 
## time zone: Australia/Melbourne
## tzcode source: system (glibc)
## 
## attached base packages:
## [1] stats     graphics  grDevices utils     datasets  methods   base     
## 
## other attached packages:
## [1] viridis_0.6.5     viridisLite_0.4.3 scales_1.4.0      systemfonts_1.3.2
## 
## loaded via a namespace (and not attached):
##  [1] vctrs_0.7.3        cli_3.6.6          knitr_1.51         rlang_1.2.0       
##  [5] xfun_0.57          otel_0.2.0         generics_0.1.4     S7_0.2.2          
##  [9] jsonlite_2.0.0     glue_1.8.1         htmltools_0.5.9    gridExtra_2.3     
## [13] sass_0.4.10        rmarkdown_2.31     grid_4.6.1         tibble_3.3.1      
## [17] evaluate_1.0.5     jquerylib_0.1.4    fastmap_1.2.0      yaml_2.3.12       
## [21] lifecycle_1.0.5    compiler_4.6.1     dplyr_1.2.1        RColorBrewer_1.1-3
## [25] pkgconfig_2.0.3    farver_2.1.2       digest_0.6.39      R6_2.6.1          
## [29] utf8_1.2.6         tidyselect_1.2.1   dichromat_2.0-0.1  pillar_1.11.1     
## [33] magrittr_2.0.5     bslib_0.11.0       gtable_0.3.6       tools_4.6.1       
## [37] ggplot2_4.0.3      cachem_1.1.0