Possible Duplicate:
Equation-driven smoothly shaded concentric shapes
How could I plot a symmetrical heart in R like I plot a circle (using plotrix) or a rectangle?
I'd like code for this so that I could actually do it for my self and to be able to generalize this to similar future needs. I've seen even more elaborate plots than this so it's pretty doable, it's just that I lack the knowledge to do it.
This is an example of plotting a "parametric equation", i.e. a pairing of two separate equations for x and y that share a common parameter. You can find many common curves and shapes that can be written within such a framework.
dat<- data.frame(t=seq(0, 2*pi, by=0.1) )
xhrt <- function(t) 16*sin(t)^3
yhrt <- function(t) 13*cos(t)-5*cos(2*t)-2*cos(3*t)-cos(4*t)
dat$y=yhrt(dat$t)
dat$x=xhrt(dat$t)
with(dat, plot(x,y, type="l"))
Other Parametric (and implicit and polar) Heart Eqns
You also could "heat it up" with using the "fill" capability of the polygon function:
with(dat, polygon(x,y, col="hotpink"))
And if you just want little hearts to sprinkle around at various places, you could use the Symbol font version of "heart" after looking at the help(points) page and using the TestChars function:
points(c(10,-10, -15, 15), c(-10, -10, 10, 10), pch=169, font=5)
Windows users may want to see if adding the Cairo package helps gain access to card symbols including "hearts".( When I tested the TestChars function on the WinXP "side" of my MacPro I did not get hearts, and paging through the "special symbols" in MS-Word did not uncover anything. So I did a search of Rhelp and found a recent posting by Ivo Welch. He was reporting a bug, but they look OK on my machine.) Further note... I think the hearts and diamonds codes in his were reversed.
library(Cairo)
clubs <- expression(symbol('\247'))
hearts <- expression(symbol('\251'))
diamonds <- expression(symbol('\250'))
spades <- expression(symbol('\252'))
csymbols <- c(clubs, hearts, diamonds, spades)
plot( 0, xlim=c(0,5), ylim=c(0,2), type="n" )
clr <- c("black", "red", "red", "black")
for (i in 1:4) {
hline <- function( yloc, ... )
for (i in 1:length(yloc))
lines( c(-1,6), c(yloc[i],yloc[i]), col="gray")
hline(0.9);
hline(1.0);
hline(1.1);
hline(1.2)
text( i, 1, csymbols[i], col=clr[i], cex=5 )
text( i, 0.5, csymbols[i], col=clr[i] ) }
# Also try this
plot(1,1)
text(x=1+0.2*cos(seq(0, 2*pi, by=.5)),
y=1+0.2*sin(seq(0, 2*pi, by=.5)),
expression(symbol('\251') ) )
points(x,y, pch)? I'm think font family or somthing like that but am unsure of how to approach this. –
Intrastate TestChars(font=5) at the end of the examples on the help(points) page. It will print out all the Symbol glyphs for your system that are indexed by the decimal numbers: c(32:126, 160:254) –
Lecturer Solve the parametric equation for y (does SO allow math formatting?)
x^2 + (5y/4-sqrt(abs(x)))^2 = 1
sqrt(1-x^2) = 5y/4 - sqrt(abs(x))
y = 4/5*(sqrt(1-x^2)+sqrt(abs(x)))
MASS::eqscplot(0:1,0:1,type="n",xlim=c(-1,1),ylim=c(-0.8,1.5))
curve(4/5*sqrt(1-x^2)+sqrt(abs(x)),from=-1,to=1,add=TRUE,col=2)
curve(4/5*-sqrt(1-x^2)+sqrt(abs(x)),from=-1,to=1,add=TRUE,col=2)
Simple and ugly hack:
plot(1, 1, pch = "♥", cex = 20, xlab = "", ylab = "", col = "firebrick3")
pch = "♥" doesn't work for me. R converts it to a "?". I'm a windows 7 user so this may be the reason. I can use all sorts of crazy numeric values for pch but have yet to find the heart you used. Also any pointers/resources on how to determine what number coresponds to what symbol with pch would be awesome. Generally the resources I've seen have only a few symbols corresponding to numbers. I know there's 100s of them though. –
Intrastate plot(1, 1, pch = -0x2665L, cex = 20, xlab = "", ylab = "", col = "firebrick3") –
Intrastate points(1,1, pch=-0x2642L, cex = 20, col = "firebrick3") & points(1,1, pch=-0x2642L, cex = 20, col = "firebrick3") These could be useful. –
Intrastate text(x,y, heart, col="red") in stead of points(x,y,pch). –
Lecturer Here is a cardioid in ggplot:
library(ggplot2)
dat <- data.frame(x=seq(0, 2*pi, length.out=100))
cardioid <- function(x, a=1)a*(1-cos(x))
ggplot(dat, aes(x=x)) + stat_function(fun=cardioid) + coord_polar()
And the heart plot (linked by @BenBolker):
heart <- function(x)2-2*sin(x) + sin(x)*(sqrt(abs(cos(x))))/(sin(x)+1.4)
ggplot(dat, aes(x=x)) + stat_function(fun=heart) + coord_polar(start=-pi/2)
Another option,
xmin <- -5
xmax <- 10
n <- 1e3
xs<-seq(xmin,xmax,length=n)
ys<-seq(xmin,xmax,length=n)
f = function(x, y) (x^2+0.7*y^2-1)^3 - x^2*y^3
zs <- outer(xs,ys,FUN=f)
h <- contourLines(xs,ys,zs,levels=0)
library(txtplot)
with(h[[1]], txtplot(x, y))
+---+-******----+----******-+---+
1.5 + ***** ********** ***** +
1 +** * +
0.5 +** * +
| *** *** |
0 + **** **** +
-0.5 + ***** ***** +
-1 + *********** +
+---+-----+-----*-----+-----+---+
-1 -0.5 0 0.5 1
If you want to be more "mature", try out the following (posted to R-help a few years ago):
thong<-function(h = 9){
# set up plot
xrange=c(-15,15)
yrange=c(0,16)
plot(0,xlim=xrange,ylim=yrange,type='n')
# draw outer envelope
yr=seq(yrange[1],yrange[2],len=50)
offsetFn=function(y){2*sin(0+y/3)}
offset=offsetFn(yr)
leftE = function(y){-10-offsetFn(y)}
rightE = function(y){10+offsetFn(y)}
xp=c(leftE(yr),rev(rightE(yr)))
yp=c(yr,rev(yr))
polygon(xp,yp,col="#ffeecc",border=NA)
# feasible region upper limit:
# left and right defined by triple-log function:
xt=seq(0,rightE(h),len=100)
yt=log(1+log(1+log(xt+1)))
yt=yt-min(yt)
yt=h*yt/max(yt)
x=c(leftE(h),rightE(h),rev(xt),-xt)
y=c(h,h,rev(yt),yt)
polygon(x,y,col="red",border=NA)
}
A few more varieties:
I do not know anything about R, but if you plot this function you will get a heart:
x^2+(y-(x^2)^(1/3))^2=1
© 2022 - 2024 — McMap. All rights reserved.
r, but you'll likely be interested in cardiod polar equation, and / or other routes. – Welldressed