โดน build มาจากเพจ https://www.facebook.com/BusinessAnalyticsNIDA/ เลยอดไม่ได้ต้องพยายามทำ “หัวใจ” จาก R มาบ้าง

ทีนี้สูตร plot กราฟรูปหัวใจมีเยอะมากแล้วในเน็ต เราต้องคิดลูกเล่นเพิ่ม เลยออกมาเป็นไอเดีย “ใส่คำและเล่นสี” ใน “โครงร่างหัวใจ” ดังนี้ครับ (สูตรดัดแปลงจากที่พบในเว็บ

www.monkeywiththehat.com/2011/06/love-formula-heart-shaped-curvy-graph.html)

)heartshow.png

w = 10
h1 = 40
h2 = 40

#formula based on
#www.monkeywiththehat.com/2011/06/love-formula-heart-shaped-curvy-graph.html
setx <- seq(-1,1,0.01)
sety2 <- (abs(setx)-sqrt(1-setx^2))
sety1 <- abs(setx)+sqrt(1-setx^2)

#test heart shape
#plot(y=sety2*h2/2,
#     x=setx*w,
#     type="l",xlim=c(-w,w),ylim=c(-h2/2,h1))
#lines(y=sety1*h1-h1+h2/2,
#      x=setx*w,
#      type="l")

setx<-setx*w
sety1<-sety1*h1-h1+h2/2
sety2<-sety2*h2/2

#test heart shape again
#plot(y=sety2,
#     x=setx,
#     type="l",xlim=c(-w,w),ylim=c(-h2/2,h1))
#lines(y=sety1,
#      x=setx,
#      type="l")

plot(y=0,x=0,lwd=0,
     xlim=c(-w,w),ylim=c(-h2/2,h1))

word <- c("I","L","o","V","e","Y","O","u","~")
color <- c("#FF88BB","#993355","#FF4444","#AA2288","red")
wi=1
ci=1
for(i in seq(1,length(setx),by=ceiling(100/w)))
  for(j in seq(from=sety1[i],to=sety2[i],by=-ceiling(200/(h2+h1/2)))){
    text(x=setx[i],y=j,font=2,
         labels=word[(wi<-(wi+1))%%length(word)+1],
         col=color[(ci<-(ci+1))%%length(color)+1])
  }

code นี้รีบทำ ค่อนข้างรกนะครับ เราสามารถกำหนดสัดส่วนต่างๆของโครงหัวใจได้ผ่านค่าคงที่ w, h1, h2 และกำหนด set ของตัวหนังสือและสีที่จะจัดลงบนโครงหัวใจได้ ส่วนเรียงออกมาเป็นยังไงนั้น บ่องตงว่าผมมั่วๆเอาครับ ให้โปรแกรมมันวิ่งไป แล้วเดาเอาว่ามันคงสวยมั้ง เออ มันก็สวยกว่าที่คิดแฮะ …
แน่นอนครับ อันนี้ทำออกสื่อ ส่วนอันทำให้ส่วนตัว ก็เป็นคำอื่นสิครับ อิอิ

Advertisements