web-dev-qa-db-fra.com

Tracer un cœur en R

Duplicata possible:
Formes concentriques ombrées et pilotées par équation

Comment pourrais-je tracer un cœur symétrique en R comme je tracerais un cercle (en utilisant plotrix) ou un rectangle?

Je voudrais du code pour cela afin que je puisse le faire moi-même et pouvoir le généraliser à des besoins futurs similaires. J'ai vu des intrigues encore plus élaborées que cela, donc c'est assez faisable, c'est juste que je n'ai pas les connaissances pour le faire.

rparametric-equationspolar-coordinates
39
Tyler Rinker

Ceci est un exemple de tracé d'une "équation paramétrique", c'est-à-dire un appariement de deux équations distinctes pour x et y qui partagent un paramètre commun. Vous pouvez trouver de nombreuses courbes et formes courantes qui peuvent être écrites dans un tel cadre.

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"))

Autres équations cardiaques paramétriques (et implicites et polaires)

Vous pouvez également "chauffer" en utilisant la fonction "fill" de la fonction polygon:

with(dat, polygon(x,y, col="hotpink"))

Et si vous voulez juste que des petits coeurs saupoudrent à divers endroits, vous pouvez utiliser la version de police Symbol de "heart" après avoir regardé la page help(points) et utilisé la fonction TestChars:

points(c(10,-10, -15, 15), c(-10, -10, 10, 10), pch=169, font=5)

enter image description here

Les utilisateurs de Windows voudront peut-être voir si l'ajout du package Cairo permet d'accéder aux symboles de la carte, y compris les "cœurs" (lorsque j'ai testé la fonction TestChars sur le "côté" WinXP de mon MacPro, je n'ai pas eu de cœurs et j'ai paginé via le "spécial"). symboles "dans MS-Word n'a rien découvert. J'ai donc fait une recherche sur Rhelp et j'ai trouvé une publication récente par Ivo Welch. Il signalait un bug, mais ils ont l'air correct sur ma machine.) Note supplémentaire ... Je pense que le les codes des coeurs et des diamants étaient inversés.

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

81
42-

À partir d'un article de blog:

Résoudre l'équation paramétrique pour y (SO permet-il le formatage mathématique?)

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

17
Ben Bolker

Piratage simple et laid:

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

Voici un cardioïde dans 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

Et l'intrigue du cœur (liée par @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

11
Andrie

Une autre 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
9
baptiste

Si vous voulez être plus "mature", essayez ce qui suit (posté sur R-help il y a quelques années):

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)  
}
5
Carl Witthoft

Quelques autres variétés:

equations

2
Mihai Rotaru

Je ne sais rien de R, mais si vous tracez cette fonction, vous obtiendrez un cœur:

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