Tracer un cœur en R

Question

Possible Duplicate:
Formes concentriques ombragées en douceur, générées par équation

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

J'aimerais avoir le code pour cela afin de pouvoir le faire moi-même et de pouvoir généraliser cela à des besoins futurs similaires. J'ai vu des tracés encore plus élaborés que cela donc c'est tout à fait faisable, c'est juste que je manque de connaissance pour le faire.

Answer 1

Ceci est un exemple de traçage d'une "équation paramétrique", c'est-à-dire un couplage 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 paramétriques (et implicites et polaires) de cœur

Vous pouvez également "chauffer" les choses en utilisant la fonction "remplissage" de la fonction polygon :

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

Et si vous voulez juste de petits cœurs à saupoudrer à divers endroits, vous pouvez utiliser la version de police Symbol du "cœur" après avoir consulté la page d'aide de points et utilisé la fonction TestChars :

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

Les utilisateurs de Windows peuvent essayer d'ajouter le package Cairo pour accéder aux symboles de cartes, y compris les "cœurs".( Lorsque j'ai testé la fonction TestChars sur le côté WinXP de mon MacPro je n'ai pas obtenu de cœurs, et le défilement des "symboles spéciaux" dans MS-Word n'a rien révélé. J'ai donc fait une recherche sur Rhelp et trouvé un message récent de Ivo Welch. Il signalait un bug, mais ils semblent corrects sur ma machine.) Note supplémentaire... je pense que les codes des cœurs et des carreaux dans son message é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])
}

# Essayez aussi ceci
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')))

Answer 2

D'un article de blog :

Résoudre l'équation paramétrique pour y (est-ce que SO autorise la mise en forme 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)

Answer 3

Simple et vilain hack :

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

Answer 4

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

Et le graphique du cœur (lié 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)

Answer 5

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