Нарисуйте сердце в R

Возможный дубликат:
Равномерно заштрихованные концентрические фигуры, ориентированные на уравнения,

Как я мог бы построить симметричное сердце в R, как я построил круг (с использованием графика) или прямоугольник?

Мне нужен код для этого, чтобы я мог сделать это для себя и уметь обобщать это на аналогичные будущие потребности. Я видел еще более сложные сюжеты, чем это, поэтому это довольно выполнимо, просто мне не хватает знаний, чтобы сделать это.

Ответы

Ответ 1

Это пример построения "параметрического уравнения", т.е. спаривания, если два отдельных уравнения для 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)

enter image description here

Пользователи 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') ) )

enter image description here

Ответ 2

Из сообщения в блоге:

Решите параметрическое уравнение для 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)

enter image description here

Ответ 3

Простой и уродливый взлом:

plot(1, 1, pch = "♥", cex = 20, xlab = "", ylab = "", col = "firebrick3")

Ответ 4

Вот кардиоида в 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()

enter image description here

И сюжет сердца (связанный с @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)

enter image description here

Ответ 5

Другой вариант,

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

Ответ 6

Еще несколько разновидностей:

equations

Ответ 7

Если вы хотите быть более "зрелым", попробуйте следующее (отправлено в 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)  
}

Ответ 8

Я ничего не знаю о R, но если вы построите эту функцию, вы получите сердце:

x^2+(y-(x^2)^(1/3))^2=1