Возможный дубликат:
Равномерно заштрихованные концентрические фигуры, ориентированные на уравнения,
Как я мог бы построить симметричное сердце в R, как я построил круг (с использованием графика) или прямоугольник?
Мне нужен код для этого, чтобы я мог сделать это для себя и уметь обобщать это на аналогичные будущие потребности. Я видел еще более сложные сюжеты, чем это, поэтому это довольно выполнимо, просто мне не хватает знаний, чтобы сделать это.
Это пример построения "параметрического уравнения", т.е. спаривания, если два отдельных уравнения для x и y, которые имеют общий параметр. Вы можете найти множество общих кривых и форм, которые могут быть записаны в такой структуре.
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"))
Другие параметрические (и неявные и полярные) Heart Eq
Вы также можете "нагреть его" с помощью функции "заливки" функции polygon:
with(dat, polygon(x,y, col="hotpink"))
И если вы просто хотите, чтобы в разных местах посыпались маленькие сердца, вы можете использовать версию шрифта Symbol "heart" после просмотра страницы help(points) и с помощью функции TestChars:
points(c(10,-10, -15, 15), c(-10, -10, 10, 10), pch=169, font=5)
Пользователи Windows могут захотеть узнать, может ли добавить пакет Cairo, чтобы получить доступ к карточным символам, включая "сердца". (Когда я протестировал функцию TestChars на стороне WinXP "MacPro", у меня не было сердец и прокрутки через "специальные символы" в MS-Word ничего не открывали, поэтому я сделал поиск Rhelp и нашел недавнюю публикацию Иво Уэлша. Он сообщал об ошибке, но они смотрят на мою машину хорошо.) Далее обратите внимание... Я думаю, что коды сердца и бриллианты в нем были отменены.
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') ) )
Решите параметрическое уравнение для y (разрешает ли SO математическое форматирование?)
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)
Простой и уродливый взлом:
plot(1, 1, pch = "♥", cex = 20, xlab = "", ylab = "", col = "firebrick3")
Вот кардиоида в 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()
И сюжет сердца (связанный с @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)
Другой вариант,
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
Еще несколько разновидностей:
Если вы хотите быть более "зрелым", попробуйте следующее (отправлено в R-help несколько лет назад):
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)
}
Я ничего не знаю о R, но если вы построите эту функцию, вы получите сердце:
x^2+(y-(x^2)^(1/3))^2=1