R/batman.R

Defines functions secret

Documented in secret

#' ...
#'
#' @param name Enter your name to reveal your biggest secret...
#'
#' @return
#' @export
#'
#' @examples secret(Phill)
secret <- function(name) {
  suppressMessages(suppressWarnings(require(ggplot2)))

  x <- seq(0, 2*pi, length = (15000))
  x0 <- 8*cos(x)
  y0 <- 4*sin(x)
  d0 <- data.frame(x0 = x0, y0 = y0)

  x1 <- c(seq(3, 7, 0.001), seq(-7, -3, 0.001))
  y1 <- 3*sqrt(1-(x1/7)^2)
  y1 <- c(y1, -y1)
  d1 <- data.frame(x1 = x1, y1 = y1)
  d1 <- d1[d1$y1 > -3*sqrt(33)/7,]

  d1.1 <- d1[d1$y1 > 0,]
  d1.1 <- d1.1[d1.1$x1 > 0,]
  d1.1 <- rbind(c(min(d1.1$x1), 0), d1.1)
  d1.1 <- rbind(d1.1, c(max(d1.1$x1), 0))

  d1.2 <- d1[d1$y1 > 0,]
  d1.2 <- d1.2[d1.2$x1 < 0,]
  d1.2 <- rbind(d1.2, c(max(d1.2$x1), 0))
  d1.2 <- rbind(c(min(d1.2$x1), 0), d1.2)

  d1.3 <- d1[d1$y1 < 0,]
  d1.3 <- d1.3[d1.3$x1 > 0,]
  d1.3 <- rbind(c(min(d1.3$x1), 0), d1.3)
  d1.3 <- rbind(d1.3, c(max(d1.3$x1), 0))

  d1.4 <- d1[d1$y1 < 0,]
  d1.4 <- d1.4[d1.4$x1 < 0,]
  d1.4 <- rbind(d1.4, c(max(d1.4$x1), 0))
  d1.4 <- rbind(c(min(d1.4$x1), 0), d1.4)

  x2 <- seq(-4, 4, 0.001)
  y2 <- abs(x2/2)-(3*sqrt(33)-7)*x2^2/112-3+sqrt(1-(abs(abs(x2)-2)-1)^2)
  d2 <- data.frame(x2 = x2, y2 = y2)
  d2 <- rbind(c(min(d2$x2), 0), d2)
  d2 <- rbind(d2, c(max(d2$x2), 0))

  x3 <- c(seq(0.75, 1, 0.001), seq(-1, -0.75 , 0.001))
  y3 <- 9-8*abs(x3)
  d3 <- data.frame(x3 = x3, y3 = y3)

  d3.1 <- d3[d3$x3 > 0,]
  d3.1 <- rbind(c(min(d3.1$x3), 0), d3.1)
  d3.1 <- rbind(d3.1, c(max(d3.1$x3), 0))

  d3.2 <- d3[d3$x3 < 0,]
  d3.2 <- rbind(d3.2, c(max(d3.2$x3), 0))
  d3.2 <- rbind(c(min(d3.2$x3), 0), d3.2)

  x4 <- c(seq(0.5, 0.75, 0.001), seq(-0.75, -0.5, 0.001))
  y4 <- 3*abs(x4)+0.75
  d4 <- data.frame(x4 = x4, y4 = y4)

  d4.1 <- d4[d4$x4 > 0,]
  d4.1 <- rbind(c(min(d4.1$x4), 0), d4.1)
  d4.1 <- rbind(d4.1, c(max(d4.1$x4), 0))

  d4.2 <- d4[d4$x4 < 0,]
  d4.2 <- rbind(d4.2, c(max(d4.2$x4), 0))
  d4.2 <- rbind(c(min(d4.2$x4), 0), d4.2)

  x5 <- seq(-0.5, 0.5, 0.001)
  y5 <- rep(2.25,length(x5))
  d5 <- data.frame(x5 = x5, y5 = y5)
  d5 <- rbind(c(min(d5$x5), 0), d5)
  d5 <- rbind(d5, c(max(d5$x5), 0))

  x6 <- c(seq(-3, -1, 0.001), seq(1, 3, 0.001))
  y6 <- 6 * sqrt(10)/7+(1.5-0.5*abs(x6))*sqrt(abs(abs(x6)-1)/(abs(x6)-1))-6*sqrt(10)*sqrt(4-(abs(x6)-1)^2)/14
  d6 <- data.frame(x6 = x6, y6 = y6)

  d6.1 <- d6[d6$x6 > 0,]
  d6.1[is.na(d6.1)] = 0
  d6.1 <- rbind(d6.1, c(max(d6.1$x6), 0))

  d6.2 <- d6[d6$x6 < 0,]
  d6.2[is.na(d6.2)] = 0
  d6.2 <- rbind(c(min(d6.2$x6), 0), d6.2)

  bat <- ggplot() +
    geom_polygon(data = d0, aes(x = x0, y = y0), color = 'black', fill = 'goldenrod', lwd = 5) +
    geom_polygon(data = d1.1, aes(x = x1, y = y1), color = 'black', fill = 'black') +
    geom_polygon(data = d1.2, aes(x = x1, y = y1), color = 'black', fill = 'black') +
    geom_polygon(data = d1.3, aes(x = x1, y = y1), color = 'black', fill = 'black') +
    geom_polygon(data = d1.4, aes(x = x1, y = y1), color = 'black', fill = 'black') +
    geom_polygon(data = d2, aes(x = x2, y = y2), color = 'black', fill = 'black') +
    geom_polygon(data = d3.1, aes(x = x3, y = y3), color = 'black', fill = 'black') +
    geom_polygon(data = d3.2, aes(x = x3, y = y3), color = 'black', fill = 'black') +
    geom_polygon(data = d4.1, aes(x = x4, y = y4), color = 'black', fill = 'black') +
    geom_polygon(data = d4.2, aes(x = x4, y = y4), color = 'black', fill = 'black') +
    geom_polygon(data = d5, aes(x = x5, y = y5), color = 'black', fill = 'black') +
    geom_polygon(data = d6.1, aes(x = x6, y = y6), color = 'black', fill = 'black') +
    geom_polygon(data = d6.2, aes(x = x6, y = y6), color = 'black', fill = 'black') +
    theme(panel.background = element_blank(),
          panel.grid.major = element_blank(),
          panel.grid.minor = element_blank(),
          axis.ticks = element_blank(),
          axis.text = element_blank(),
          plot.title = element_text(family = 'URWBookman', face = 'bold.italic', size = 20, hjust = 0.5)) +
    ggtitle(paste0(deparse(substitute(name)),' is BATMAN ! ! !')) +
    ylab(NULL) +
    xlab(NULL) +
    coord_fixed()

  return(bat)
}
strnda/Batman documentation built on May 26, 2017, 10 p.m.