I came up with a weekly R challenge, as a way to “force” myself into learning new things. One figure, every week! The catch is that every time I should be trying something new… maybe I’ll use a new type of visualization for first time, or maybe I’ll explore a new dataset. Initially I thought it would be neat if there was some unifying topic, e.g. water, but then I decided to keep it open.

Intro to entry #6

It’s Valentines Day, so obviously, I tried to draw hearths. A fast google search led me to this figure:

It wasn’t that difficult… the 1st hearth I plotted was super easy, because I found the code of 42- on stackoverflow (it’s the very purple hearth). Then, I tried to plot two polar equations with ggplot… that was not very enjoyable, since I’m not really used to polar coordinates and radians. Also, I just found out that if I had scrolled down, bellow the answer by 42- on stackoverflow, I would have found much better ggplot code. Well, it doesn’t really matter, does it?

Colors

I finally got to use the Pantone Color of the Year 2019 + two other colors that go well with it. The color palette feels very tropical & I love it:

You can also see other color combinations here!

Code

library(ggplot2)
library(ggthemes)
t <-seq(0, 2*pi, by=0.01)
x <- function(t) 16*sin(t)^3
y <- function(t) 13*cos(t)-5*cos(2*t)-2*cos(3*t)-cos(4*t)
hearth <- data.frame(t, x=x(t), y=y(t)) 
# HEX #FF6F61 is PANTONE 16-1546 TCX "Living Coral"
par(mar=c(1, 1, 1, 1), bg="#FF6F61", bty="n", xpd=FALSE, family="mono") 
# HEX #9D446E PANTONE 18-2525 TCX "Magenta Haze"
plot(hearth$x, hearth$y, type="l", axes=FALSE, xlab="", ylab="", col="#9D446E", lty=2)
# HEX #FEA166 PANTONE 15-1243 TCX "Papaya"
polygon(hearth$x, hearth$y, col="#FEA166", border = NA)
points(hearth$x, hearth$y, pch=3, col="#9D446E")
text(0, 0, "I LOVE YOU", col="#9D446E", cex=6)

t <-seq(0, 0.5, by=0.1)
r <- 1- sin(t)
r2 <- 1 + sin(t)
hearth2 <- data.frame(t, r)
hearth3 <- data.frame(t, r2)
p <- ggplot(hearth2, aes(x = r, y=t))+ geom_area(fill="#FEA166", col="#FEA166") +
  geom_line(col="#9D446E", lty=3, lwd=1.25)+
  geom_area(data=hearth3, aes(x = r2, y=t), fill="#FEA166", col="#FEA166")+
  geom_line(data=hearth3, aes(x = r2, y=t), col="#9D446E", lty=3, lwd=1.25)+
  coord_polar(theta = "x", direction=-1, start=-pi)+
  theme_void() +
  ggtitle("I LOVE YOU")+
  theme(panel.background = element_rect(fill="#FF6F61"),
        plot.title=element_text(color = "#9D446E", 
                                family="mono", face="bold", size=20))
p 

t <-seq(-1.01, 1.01, by=0.0001)
x <- function(t) sin(t)*cos(t)*log(abs(t))
y <- function(t) (abs(t)^0.3)*sqrt(cos(t))
hearth <- data.frame(t, x=x(t), y=y(t)) 
# HEX #FF6F61 is PANTONE 16-1546 TCX "Living Coral"
par(mar=c(1, 1, 1, 1), bg="#FF6F61", bty="n", xpd=FALSE, family="mono") 
# HEX #9D446E PANTONE 18-2525 TCX "Magenta Haze"
plot(hearth$x, hearth$y, type="l", axes=FALSE, xlab="", ylab="", col="#9D446E", lty=2)
# HEX #FEA166 PANTONE 15-1243 TCX "Papaya"
polygon(hearth$x, hearth$y, col="#FEA166", border = "#FEA166")
points(hearth$x, hearth$y, pch=4, col="#9D446E")
text(0, 0.6, "I LOVE YOU", col="#9D446E", cex=5)

t <-seq(0, 0.5, by=0.1)
r <- 2- 2*sin(t) + (sin(t)*sqrt(abs(cos(t))))/(sin(t)+1.4)
r2 <- 2 + 2*sin(t) - (sin(t)*sqrt(abs(cos(t))))/(sin(t)+1.4)
hearth2 <- data.frame(t, r)
hearth3 <- data.frame(t, r2)
g <- ggplot(hearth2, aes(x = r, y=t))+ geom_area(fill="#FEA166", col="#FEA166") +
  geom_line(col="#9D446E", lty=3, lwd=1.25)+
  geom_area(data=hearth3, aes(x = r2, y=t), fill="#FEA166", col="#FEA166")+
  geom_line(data=hearth3, aes(x = r2, y=t), col="#9D446E", lty=3, lwd=1.25)+
  coord_polar(theta = "x", direction=-1, start=-pi)+
  theme_void() +
  ggtitle("I LOVE YOU")+
  theme(panel.background = element_rect(fill="#FF6F61"),
        plot.title=element_text(color = "#9D446E", 
                                family="mono", face="bold", size=20))
g 

LS0tDQp0aXRsZTogIlNoYXBlIG9mIG15IGhlYXJ0Ig0KYXV0aG9yOiAiRGVuaXR6YSBELiBWb3V0Y2hrb3ZhIg0KZGF0ZTogIjE0IEZlYiAyMDE5ICgjNikiDQpvdXRwdXQ6DQogIGh0bWxfbm90ZWJvb2s6DQogICAgY29kZV9mb2xkaW5nOiBoaWRlDQogICAgaGlnaGxpZ2h0OiBrYXRlDQotLS0NCg0KX0kgY2FtZSB1cCB3aXRoIGEgd2Vla2x5IF9fUl9fIGNoYWxsZW5nZSwgYXMgYSB3YXkgdG8gImZvcmNlIiBteXNlbGYgaW50byBsZWFybmluZyBuZXcgdGhpbmdzLiBPbmUgZmlndXJlLCBldmVyeSB3ZWVrISBUaGUgY2F0Y2ggaXMgdGhhdCBldmVyeSB0aW1lIEkgc2hvdWxkIGJlIHRyeWluZyBzb21ldGhpbmcgbmV3Li4uIG1heWJlIEknbGwgdXNlICBhIG5ldyB0eXBlIG9mIHZpc3VhbGl6YXRpb24gZm9yIGZpcnN0IHRpbWUsIG9yIG1heWJlIEknbGwgZXhwbG9yZSBhIG5ldyBkYXRhc2V0LiBJbml0aWFsbHkgSSB0aG91Z2h0IGl0IHdvdWxkIGJlIG5lYXQgaWYgdGhlcmUgd2FzIHNvbWUgdW5pZnlpbmcgdG9waWMsIGUuZy4gd2F0ZXIsIGJ1dCB0aGVuIEkgZGVjaWRlZCB0byBrZWVwIGl0IG9wZW4uXw0KDQojIyMgSW50cm8gdG8gZW50cnkgIzYgDQoNCkl0J3MgVmFsZW50aW5lcyBEYXksIHNvIG9idmlvdXNseSwgSSB0cmllZCB0byBkcmF3IGhlYXJ0aHMuIEEgZmFzdCBnb29nbGUgc2VhcmNoIGxlZCBtZSB0byB0aGlzIGZpZ3VyZToNCg0KIVtNYXRoICYgaGVhcnRocyBmcm9tIGh0dHA6Ly9tYXRod29ybGQud29sZnJhbS5jb20vSGVhcnRDdXJ2ZS5odG1sXShDOi9Vc2Vycy92b3V0Yy9Eb2N1bWVudHMvUGVyc29uYWwvUl9CbG9ncy81X1NoYXBlX29mX3lvdXJfaGVhcnRoL0hlYXJ0Q3VydmVzXzgwMS5naWYpDQoNCkl0IHdhc24ndCB0aGF0IGRpZmZpY3VsdC4uLiB0aGUgMV5zdF4gaGVhcnRoIEkgcGxvdHRlZCB3YXMgc3VwZXIgZWFzeSwgYmVjYXVzZSBJIGZvdW5kIHRoZSBjb2RlIG9mIF9fNDItX18gb24gW3N0YWNrb3ZlcmZsb3ddKGh0dHBzOi8vc3RhY2tvdmVyZmxvdy5jb20vcXVlc3Rpb25zLzgwODI0MjkvcGxvdC1hLWhlYXJ0LWluLXIpIChpdCdzIHRoZSB2ZXJ5IHB1cnBsZSBoZWFydGgpLiANClRoZW4sIEkgdHJpZWQgdG8gcGxvdCB0d28gcG9sYXIgZXF1YXRpb25zIHdpdGggZ2dwbG90Li4uIHRoYXQgd2FzIG5vdCB2ZXJ5IGVuam95YWJsZSwgc2luY2UgSSdtIG5vdCByZWFsbHkgdXNlZCB0byBwb2xhciBjb29yZGluYXRlcyBhbmQgcmFkaWFucy4gQWxzbywgSSBqdXN0IGZvdW5kIG91dCB0aGF0IGlmIEkgaGFkIHNjcm9sbGVkIGRvd24sIGJlbGxvdyB0aGUgYW5zd2VyIGJ5IF9fNDItX18gb24gc3RhY2tvdmVyZmxvdywgSSB3b3VsZCBoYXZlIGZvdW5kIG11Y2ggYmV0dGVyIGdncGxvdCBjb2RlLiBXZWxsLCBpdCBkb2Vzbid0IHJlYWxseSBtYXR0ZXIsIGRvZXMgaXQ/DQoNCiMjIyBDb2xvcnMNCg0KSSBmaW5hbGx5IGdvdCB0byB1c2UgdGhlIFBhbnRvbmUgQ29sb3Igb2YgdGhlIFllYXIgMjAxOSArIHR3byBvdGhlciBjb2xvcnMgdGhhdCBnbyB3ZWxsIHdpdGggaXQuIFRoZSBjb2xvciBwYWxldHRlIGZlZWxzIHZlcnkgdHJvcGljYWwgJiBJIGxvdmUgaXQ6DQoNCisgX19MaXZpbmcgQ29yYWxfXyBIRVggI0ZGNkY2MSAoUEFOVE9ORSAxNi0xNTQ2IFRDWCk6IFtsaW5rXShodHRwczovL3d3dy5wYW50b25lLmNvbS9jb2xvci1maW5kZXIvMTYtMTU0Ni1UQ1gpDQorIF9fTWFnZW50YSBIYXplX18gSEVYICM5RDQ0NkUgKFBBTlRPTkUgMTgtMjUyNSBUQ1gpOiBbbGlua10oaHR0cHM6Ly93d3cucGFudG9uZS5jb20vY29sb3ItZmluZGVyLzE4LTI1MjUtVENYKQ0KKyBfX1BhcGF5YV9fIEhFWCAjRkVBMTY2IChQQU5UT05FIDE1LTEyNDMgVENYKTogW2xpbmtdKGh0dHBzOi8vd3d3LnBhbnRvbmUuY29tL2NvbG9yLWZpbmRlci8xNS0xMjQzLVRDWCkNCg0KWW91IGNhbiBhbHNvIHNlZSBvdGhlciBjb2xvciBjb21iaW5hdGlvbnMgW2hlcmVdKGh0dHBzOi8vd3d3LnBhbnRvbmUuY29tL2NvbG9yLWludGVsbGlnZW5jZS9jb2xvci1vZi10aGUteWVhci9jb2xvci1vZi10aGUteWVhci0yMDE5LXBhbGV0dGUtZXhwbG9yYXRpb24pIQ0KDQojIyMgQ29kZQ0KDQpgYGB7cn0NCmxpYnJhcnkoZ2dwbG90MikNCmxpYnJhcnkoZ2d0aGVtZXMpDQpgYGANCg0KDQpgYGB7ciBmaWd1cmUsIGZpZy53aWR0aD0xMCwgZmlnLmFzcD0xLCAgZGV2PSdzdmcnLCBjb2xsYXBzZT1UUlVFLCBmaWcuYWxpZ249J2NlbnRlcid9DQoNCnQgPC1zZXEoMCwgMipwaSwgYnk9MC4wMSkNCnggPC0gZnVuY3Rpb24odCkgMTYqc2luKHQpXjMNCnkgPC0gZnVuY3Rpb24odCkgMTMqY29zKHQpLTUqY29zKDIqdCktMipjb3MoMyp0KS1jb3MoNCp0KQ0KaGVhcnRoIDwtIGRhdGEuZnJhbWUodCwgeD14KHQpLCB5PXkodCkpIA0KDQojIEhFWCAjRkY2RjYxIGlzIFBBTlRPTkUgMTYtMTU0NiBUQ1ggIkxpdmluZyBDb3JhbCINCnBhcihtYXI9YygxLCAxLCAxLCAxKSwgYmc9IiNGRjZGNjEiLCBidHk9Im4iLCB4cGQ9RkFMU0UsIGZhbWlseT0ibW9ubyIpIA0KDQojIEhFWCAjOUQ0NDZFIFBBTlRPTkUgMTgtMjUyNSBUQ1ggIk1hZ2VudGEgSGF6ZSINCnBsb3QoaGVhcnRoJHgsIGhlYXJ0aCR5LCB0eXBlPSJsIiwgYXhlcz1GQUxTRSwgeGxhYj0iIiwgeWxhYj0iIiwgY29sPSIjOUQ0NDZFIiwgbHR5PTIpDQoNCiMgSEVYICNGRUExNjYgUEFOVE9ORSAxNS0xMjQzIFRDWCAiUGFwYXlhIg0KcG9seWdvbihoZWFydGgkeCwgaGVhcnRoJHksIGNvbD0iI0ZFQTE2NiIsIGJvcmRlciA9IE5BKQ0KDQpwb2ludHMoaGVhcnRoJHgsIGhlYXJ0aCR5LCBwY2g9MywgY29sPSIjOUQ0NDZFIikNCg0KdGV4dCgwLCAwLCAiSSBMT1ZFIFlPVSIsIGNvbD0iIzlENDQ2RSIsIGNleD02KQ0KYGBgDQoNCmBgYHtyIGZpZ3VyZTIsIGZpZy53aWR0aD0xMCwgZmlnLmFzcD0xLCAgZGV2PSdzdmcnLCBjb2xsYXBzZT1UUlVFLCBmaWcuYWxpZ249J2NlbnRlcid9DQoNCnQgPC1zZXEoMCwgMC41LCBieT0wLjEpDQpyIDwtIDEtIHNpbih0KQ0KcjIgPC0gMSArIHNpbih0KQ0KaGVhcnRoMiA8LSBkYXRhLmZyYW1lKHQsIHIpDQpoZWFydGgzIDwtIGRhdGEuZnJhbWUodCwgcjIpDQoNCnAgPC0gZ2dwbG90KGhlYXJ0aDIsIGFlcyh4ID0gciwgeT10KSkrIGdlb21fYXJlYShmaWxsPSIjRkVBMTY2IiwgY29sPSIjRkVBMTY2IikgKw0KICBnZW9tX2xpbmUoY29sPSIjOUQ0NDZFIiwgbHR5PTMsIGx3ZD0xLjI1KSsNCiAgZ2VvbV9hcmVhKGRhdGE9aGVhcnRoMywgYWVzKHggPSByMiwgeT10KSwgZmlsbD0iI0ZFQTE2NiIsIGNvbD0iI0ZFQTE2NiIpKw0KICBnZW9tX2xpbmUoZGF0YT1oZWFydGgzLCBhZXMoeCA9IHIyLCB5PXQpLCBjb2w9IiM5RDQ0NkUiLCBsdHk9MywgbHdkPTEuMjUpKw0KICBjb29yZF9wb2xhcih0aGV0YSA9ICJ4IiwgZGlyZWN0aW9uPS0xLCBzdGFydD0tcGkpKw0KICB0aGVtZV92b2lkKCkgKw0KICBnZ3RpdGxlKCJJIExPVkUgWU9VIikrDQogIHRoZW1lKHBhbmVsLmJhY2tncm91bmQgPSBlbGVtZW50X3JlY3QoZmlsbD0iI0ZGNkY2MSIpLA0KICAgICAgICBwbG90LnRpdGxlPWVsZW1lbnRfdGV4dChjb2xvciA9ICIjOUQ0NDZFIiwgDQogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIGZhbWlseT0ibW9ubyIsIGZhY2U9ImJvbGQiLCBzaXplPTIwKSkNCnAgDQpgYGANCg0KYGBge3IgZmlndXJlMywgZmlnLndpZHRoPTEwLCBmaWcuYXNwPTEsICBkZXY9J3N2ZycsIGNvbGxhcHNlPVRSVUUsIGZpZy5hbGlnbj0nY2VudGVyJ30NCnQgPC1zZXEoLTEuMDEsIDEuMDEsIGJ5PTAuMDAwMSkNCnggPC0gZnVuY3Rpb24odCkgc2luKHQpKmNvcyh0KSpsb2coYWJzKHQpKQ0KeSA8LSBmdW5jdGlvbih0KSAoYWJzKHQpXjAuMykqc3FydChjb3ModCkpDQoNCmhlYXJ0aCA8LSBkYXRhLmZyYW1lKHQsIHg9eCh0KSwgeT15KHQpKSANCg0KIyBIRVggI0ZGNkY2MSBpcyBQQU5UT05FIDE2LTE1NDYgVENYICJMaXZpbmcgQ29yYWwiDQpwYXIobWFyPWMoMSwgMSwgMSwgMSksIGJnPSIjRkY2RjYxIiwgYnR5PSJuIiwgeHBkPUZBTFNFLCBmYW1pbHk9Im1vbm8iKSANCg0KIyBIRVggIzlENDQ2RSBQQU5UT05FIDE4LTI1MjUgVENYICJNYWdlbnRhIEhhemUiDQpwbG90KGhlYXJ0aCR4LCBoZWFydGgkeSwgdHlwZT0ibCIsIGF4ZXM9RkFMU0UsIHhsYWI9IiIsIHlsYWI9IiIsIGNvbD0iIzlENDQ2RSIsIGx0eT0yKQ0KDQojIEhFWCAjRkVBMTY2IFBBTlRPTkUgMTUtMTI0MyBUQ1ggIlBhcGF5YSINCnBvbHlnb24oaGVhcnRoJHgsIGhlYXJ0aCR5LCBjb2w9IiNGRUExNjYiLCBib3JkZXIgPSAiI0ZFQTE2NiIpDQoNCnBvaW50cyhoZWFydGgkeCwgaGVhcnRoJHksIHBjaD00LCBjb2w9IiM5RDQ0NkUiKQ0KDQp0ZXh0KDAsIDAuNiwgIkkgTE9WRSBZT1UiLCBjb2w9IiM5RDQ0NkUiLCBjZXg9NSkNCmBgYA0KDQpgYGB7ciBmaWd1cmU0LCBmaWcud2lkdGg9MTAsIGZpZy5hc3A9MSwgIGRldj0nc3ZnJywgY29sbGFwc2U9VFJVRSwgZmlnLmFsaWduPSdjZW50ZXInfQ0KDQp0IDwtc2VxKDAsIDAuNSwgYnk9MC4xKQ0KciA8LSAyLSAyKnNpbih0KSArIChzaW4odCkqc3FydChhYnMoY29zKHQpKSkpLyhzaW4odCkrMS40KQ0KcjIgPC0gMiArIDIqc2luKHQpIC0gKHNpbih0KSpzcXJ0KGFicyhjb3ModCkpKSkvKHNpbih0KSsxLjQpDQpoZWFydGgyIDwtIGRhdGEuZnJhbWUodCwgcikNCmhlYXJ0aDMgPC0gZGF0YS5mcmFtZSh0LCByMikNCg0KZyA8LSBnZ3Bsb3QoaGVhcnRoMiwgYWVzKHggPSByLCB5PXQpKSsgZ2VvbV9hcmVhKGZpbGw9IiNGRUExNjYiLCBjb2w9IiNGRUExNjYiKSArDQogIGdlb21fbGluZShjb2w9IiM5RDQ0NkUiLCBsdHk9MywgbHdkPTEuMjUpKw0KICBnZW9tX2FyZWEoZGF0YT1oZWFydGgzLCBhZXMoeCA9IHIyLCB5PXQpLCBmaWxsPSIjRkVBMTY2IiwgY29sPSIjRkVBMTY2IikrDQogIGdlb21fbGluZShkYXRhPWhlYXJ0aDMsIGFlcyh4ID0gcjIsIHk9dCksIGNvbD0iIzlENDQ2RSIsIGx0eT0zLCBsd2Q9MS4yNSkrDQogIGNvb3JkX3BvbGFyKHRoZXRhID0gIngiLCBkaXJlY3Rpb249LTEsIHN0YXJ0PS1waSkrDQogIHRoZW1lX3ZvaWQoKSArDQogIGdndGl0bGUoIkkgTE9WRSBZT1UiKSsNCiAgdGhlbWUocGFuZWwuYmFja2dyb3VuZCA9IGVsZW1lbnRfcmVjdChmaWxsPSIjRkY2RjYxIiksDQogICAgICAgIHBsb3QudGl0bGU9ZWxlbWVudF90ZXh0KGNvbG9yID0gIiM5RDQ0NkUiLCANCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgZmFtaWx5PSJtb25vIiwgZmFjZT0iYm9sZCIsIHNpemU9MjApKQ0KZyANCmBgYA==