圣诞节微生信生物送你一颗专属生信领域的圣诞树

写在前面

外国人把R语言绘制圣诞树在国外都作为家庭作业，虽然我并不过圣诞节，但是看看他们编写的代码还是蛮有意思的，今天我为大家带来三个版本的圣诞树绘制过程。都是基于R语言。这也算是我们一种娱乐吧。

注意：本次无需任何数据，直接复制代码，即可出图。

library(ggplot2)
ggplot()+geom_polygon(aes(x=c(-1,1,1,-1),y=c(0,0,3,3)),fill="brown")+geom_polygon(aes(x=c(0,0,4),y=c(20,1,1)),fill="green")+coord_equal()+
geom_polygon(aes(x=-c(0,0,4),y=c(20,1,1)),fill="green")+theme_void()+
geom_point(aes(x=c(-2,-1,0,1,2,1,-1,0,1,2,-2),y=c(2,7,15,3,6,11,12,5,8,2,5)),color=c("red"),shape=c(19))+
theme(panel.background = element_rect(fill = "blue"))+
geom_point(aes(x=0,y=20),shape=8,color="gold",size=8)+
geom_curve(aes(x=-3.2,y=5,xend=3.2,yend=5),color="gold",size=2)+
geom_curve(aes(x=-2.1,y=10,xend=2.1,yend=10),color="gold",size=2)

下面来一颗奢华版本的圣诞树


library(ggplot2)

# generowanie losowych punktów

x1 <- runif(100000, -1, 1)
y1 <- runif(100000, -1, 1.6)

# równanie na serce
which1 <- x1^2+(y1-(x1^2)^(1/4))^2<=1
x1 <- x1[which1]
y1 <- y1[which1]

# drugi poziom
x2 <- 1.5*x1 -1
y2 <- 1.5*y1

# trzeci poziom
x3 <- 2*x1 -2
y3 <- 2*y1

dt <- data.frame(c(x1,x2,x3),c(y1,y2,y3))
colnames(dt) <- c("x", "y")
dt$y <- dt$y - 0.25
dt <- dt[dt$x>-2 & dt$x<1 & dt$y>-2.25 & dt$y<0,]
dt <- data.frame(c(dt$x,dt$x), c(dt$y, -dt$y))
colnames(dt) <- c("x", "y")

#pieniek

p1 <- runif(1000, -0.5, 0.5)
p2 <- runif(1000, -2.5, -2)

pieniek <- data.frame(p1,p2)

colors <- c('green', 'green2', 'green4', 'darkgreen')
colors2 <- rep(colors,length.out=dim(dt)[1])

bombki <- data.frame(c(-1.8, -1.7, -1.1, -0.6, 0, 0.3), c(-1,0.7,-0.9,0.1,-0.3,0.3))
colnames(bombki) <- c("x", "y")

lancuch <- data.frame(data.frame(x1 = -0.5, x2 = 1, y1 = 21.0, y2 = 15.0))

gwiazda <- data.frame(c(0), c(0.7))
colnames(gwiazda)<- c("x", "y")

ggplot(data=NULL) + geom_point(data=dt, aes(x = y, y=x), col=colors2) +
geom_point(data=bombki, aes(x=y, y=x), size=10, col='blue') +
geom_point (data=pieniek, aes(x=p1, y=p2), col='brown') +
geom_point(data=gwiazda, aes(x=x, y=y),size=10,shape=24, col="yellow", fill='yellow') +
geom_point(data=gwiazda, aes(x=x ,y=y),size=10,shape=25, col="yellow", fill='yellow') +
geom_curve(aes(x=-1,xend=1.2,y=-0.65,yend=-1.2), col='red',size=2, curvature = 0.3) +
geom_curve(aes(x=1.2, y=-1.2, xend=-1.2, yend=-1.5), size=2, col="red", curvature = -0.3) +
geom_curve(aes(x=-1,xend=0.8,y=-0.65,yend=-0.5), col='red',size=2, curvature = 0.3) +
geom_curve(aes(x=-0.8,xend=0.8,y=-0.2,yend=-0.5), col='red',size=2, curvature = 0.2) +
geom_curve(aes(x=-0.8,xend=0.9,y=-0.2,yend=0.15), col='red',size=2, curvature = 0.3) +
geom_curve(aes(x=-0.65,xend=0.9,y=0.35,yend=0.15), col='red',size=2, curvature = 0.3) +
theme(axis.line=element_blank(),axis.text.x=element_blank(),
axis.text.y=element_blank(),axis.ticks=element_blank(),
axis.title.x=element_blank(),
axis.title.y=element_blank(),legend.position="none",
panel.background=element_blank(),panel.border=element_blank(),panel.grid.major=element_blank(),
panel.grid.minor=element_blank(),plot.background=element_blank())

最后我们来一张交互的圣诞树

（shiny 版本的圣诞树）

library(datasets)
library(ggplot2)
library(RColorBrewer)
library(shiny)

## dane
k = 101
a <- cbind(rep(100,k),rep(100,k),seq(0,100,1), rep(0,k))
a1 <- cbind(rep(100,34), rep(100,34), seq(67,100,1), rep(0,34))
a2 <- cbind(rep(100,67), rep(100,67), seq(34,100,1), rep(0,67))
a3 <- cbind(rep(100,101), rep(100,101), seq(0,100,1), rep(0,101))
x <- rbind(a1,a2,a3)
wektor <- c(rep("a",34),rep("b",67),rep("c",101))
data <- cbind(x,wektor,rep("p",202))

b <- cbind(rep(0,k),rep(100,k),seq(0,100,1), rep(0,k))
b1 <- cbind(rep(0,34), rep(100,34), seq(0,33,1), rep(0,34))
b2 <- cbind(rep(0,67), rep(100,67), seq(0,66,1), rep(0,67))
b3 <- cbind(rep(0,101), rep(100,101), seq(0,100,1), rep(0,101))
y <- rbind(b1,b2,b3)
wektor2 <- c(rep("a",34),rep("b",67),rep("c",101))
data2 <- cbind(y,wektor2,rep("q",202))

l = 31
c <- cbind(rep(seq(94,100,0.2)),rep(100,l),seq(85,100,0.5),rep(0,l))
wektor3 <- c(rep("d",l))
data3 <- cbind(c,wektor3,rep("p",l))

d <- cbind(rep(seq(0,6,0.2)),rep(100,l),seq(0,15,0.5),rep(0,l))
wektor4 <- c(rep("d",l))
data4 <- cbind(d,wektor4,rep("q",l))

kolory <- brewer.pal(9,"Greens")

data <- rbind(data,data2,data3,data4)

lancuchyGora <- rbind(c(84,50,100,50,"a","p"),c(76,25,100,25,"a","p"),
c(16,50,0,50,"a","q"),c(24,25,0,25,"a","q"))
lancuchySrodek <- rbind(c(69,50,100,50,"b","p"),c(50,25,100,25,"b","p"),
c(31,50,0,50,"b","q"),c(50,25,0,25,"b","q"))
lancuchyDol <- rbind(c(50,50,100,50,"c","p"),c(25,25,100,25,"c","p"),
c(50,50,0,50,"c","q"),c(75,25,0,25,"c","q"))

gwiazda <- rbind(c(100,88,0,0,"a","p"),c(0,88,0,0,"a","q"))

swiatelka <- rbind(c(80,20,1,0,"a","p"),c(85,35,2,0,"a","p"),c(90,40,1,0,"a","p"),
c(20,20,2,0,"a","q"),c(15,35,1,0,"a","q"),c(10,40,2,0,"a","q"),
c(60,30,1,0,"b","p"),c(70,40,2,0,"b","p"),c(90,50,1,0,"b","p"),
c(40,30,2,0,"b","q"),c(30,40,1,0,"b","q"),c(10,50,2,0,"b","q"),
c(30,20,1,0,"c","p"),c(50,30,2,0,"c","p"),c(70,40,1,0,"c","p"),c(90,50,2,0,"c","p"),
c(70,20,2,0,"c","q"),c(50,30,1,0,"c","q"),c(30,40,2,0,"c","q"),c(10,50,1,0,"c","q"))

data <- rbind(data,lancuchyGora,lancuchySrodek,lancuchyDol,gwiazda, swiatelka)
data <- data.frame(data)
colnames(data) <- c("xstart","ystart","xend","yend","wiersz","kolumna")
data$xstart <- as.numeric(as.character(data[,1]))
data$ystart <- as.numeric(as.character(data[,2]))
data$xend <- as.numeric(as.character(data[,3]))
data$yend <- as.numeric(as.character(data[,4]))

##

ui <- fixedPage(

titlePanel("Ubierz Choinkę FacetGrid"),
sidebarLayout(
sidebarPanel(
selectInput("gwiazdka", "Gwiazdka",
choices = c("TAK","NIE"), selected = "NIE"),
checkboxGroupInput("lancuch",
"Łańcuchy:",
choices = c("Góra","Środek","Dół"),
selected = FALSE),
sliderInput("light",
"Oświetlenie:",
min = 0,
max = 4,
value = 0),
fluidRow(
actionButton("posprzataj", "Posprzątaj po świętach"),
actionButton("ups", "UPS"))
),
mainPanel(
plotOutput("choinkaPlot",width="60%",height = "450px")
)
)
)

server <- function(input, output) {
v <- reactiveValues(flag=TRUE)
choinka <- reactive({

p <- ggplot(data) + geom_segment(data=data[1:466,],aes(x=xstart,y=ystart,xend=xend, yend=yend, color=wiersz)) +
facet_grid(vars(wiersz),vars(kolumna), margin=FALSE) + theme_minimal() +
guides(color=FALSE) + scale_color_manual(values = c(kolory[6], kolory[7], kolory[8], "brown")) +
scale_x_continuous(expand = c(0, 0)) +
scale_y_continuous(expand = c(0, 0))

if("Góra" %in% input$lancuch){
p <- p + geom_curve(data=data[467:470,],aes(x=xstart,y=ystart,xend=xend, yend=yend),
curvature = -0.1,size=2.5, color="grey")
}
if("Środek" %in% input$lancuch){
p <- p + geom_curve(data=data[471:474,],aes(x=xstart,y=ystart,xend=xend, yend=yend),
curvature = -0.1,size=2.5, color="grey")
}
if("Dół" %in% input$lancuch){
p <- p + geom_curve(data=data[475:478,],aes(x=xstart,y=ystart,xend=xend, yend=yend),
curvature = -0.1,size=2.5, color="grey")
}
if(input$gwiazdka=="TAK"){
p <- p + geom_point(data=data[479:480,],aes(x=xstart,y=ystart),
size = 30, color = "darkgoldenrod1", pch="*")
}
if(input$light>0){
p <- p + geom_point(data=data[481:500,], aes(x=xstart,y=ystart, fill = as.factor(xend)),
size = input$light+2, pch=24, colour = "transparent") +
scale_fill_manual(values=brewer.pal(3,"Set1")[1:2]) + guides(fill=FALSE)
}

library(grid)
height <- 1e-6 # Vertical spacing
aux <- 1e-5 # Auxiliary number to identify 'height' among other heights
width <- 1e-6 # Desirable horizontal spacing

p <- p + theme(panel.spacing = unit(height + aux, "lines"))

if(v$flag==FALSE){
ggplot()
} else {
p
}

})

posprzataj <- observeEvent(input$posprzataj, {
v$flag <- FALSE
})

ups <- observeEvent(input$ups, {
v$flag <- TRUE
})

output$choinkaPlot <- renderPlot({
p <- choinka() + labs(x="",y="")
p
})
}

shinyApp(ui = ui, server = server)

‍