#' The followin functions are largely copied and modified from seqLogo packages
#' (https://www.bioconductor.org/packages/release/bioc/html/seqLogo.html).
#' Generate a data frame for a polygon of "A" character
#'
#' @param x.pos The x-coordinate of the bottom left of the polygon.
#' @param y.pos The y-coordinate of the bottom left of the polygon.
#' @param ht The height of the polygon.
#' @param wt The width of the polygon.
#' @return The data frame for the polygon of "A" character.
#' @examples letter_A(0, 0, 1, 1)
letter_A <- function(x.pos, y.pos, ht, wt, id = NULL) {
x <- c(0, 4, 6, 10, 8, 6.8, 3.2, 2, 0, 3.6, 5, 6.4, 3.6)
y <- c(0, 10, 10, 0, 0, 3, 3, 0, 0, 4, 7.5, 4, 4)
x <- 0.1 * x
y <- 0.1 * y
x <- x.pos + wt * x
y <- y.pos + ht * y
if (is.null(id)) {
id <- c(rep(1, 9), rep(2, 4))
fill <- c(rep("A", 9), rep("white", 4))
} else {
id <- c(rep(id, 9),rep(id + 1, 4))
fill <- c(rep("A", 9),rep("white", 4))
}
data.frame(x = x, y = y, id = id, fill = fill)
}
#' Generate a data frame for a polygon of "T" character
#'
#' @param x.pos The x-coordinate of the bottom left of the polygon.
#' @param y.pos The y-coordinate of the bottom left of the polygon.
#' @param ht The height of the polygon.
#' @param wt The width of the polygon.
#' @return The data frame for the polygon of "T" character.
#' @examples letter_T(0, 0, 1, 1)
letter_T <- function(x.pos, y.pos, ht, wt, id = NULL) {
x <- c(0, 10, 10, 6, 6, 4, 4, 0)
y <- c(10, 10, 9, 9, 0, 0, 9, 9)
x <- 0.1 * x
y <- 0.1 * y
x <- x.pos + wt * x
y <- y.pos + ht * y
if (is.null(id)) {
id <- rep(1, 8)
fill <- rep("T", 8)
} else {
id <- rep(id, 8)
fill <- rep("T", 8)
}
data.frame(x = x, y = y, id = id, fill = fill)
}
#' Generate a data frame for a polygon of "C" character
#'
#' @param x.pos The x-coordinate of the bottom left of the polygon.
#' @param y.pos The y-coordinate of the bottom left of the polygon.
#' @param ht The height of the polygon.
#' @param wt The width of the polygon.
#' @return The data frame for the polygon of "C" character.
#' @examples letter_C(0, 0, 1, 1)
letter_C <- function(x.pos, y.pos, ht, wt, id = NULL){
angle1 <- seq(0.3 + pi / 2, pi, length = 100)
angle2 <- seq(pi, 1.5 * pi, length = 100)
x.l1 <- 0.5 + 0.5 * sin(angle1)
y.l1 <- 0.5 + 0.5 * cos(angle1)
x.l2 <- 0.5 + 0.5 * sin(angle2)
y.l2 <- 0.5 + 0.5 * cos(angle2)
x.l <- c(x.l1, x.l2)
y.l <- c(y.l1, y.l2)
x <- c(x.l, rev(x.l))
y <- c(y.l, 1 - rev(y.l))
x.i1 <- 0.5 + 0.35 * sin(angle1)
y.i1 <- 0.5 + 0.35 * cos(angle1)
x.i1 <- x.i1[y.i1 <= max(y.l1)]
y.i1 <- y.i1[y.i1 <= max(y.l1)]
y.i1[1] <- max(y.l1)
x.i2 <- 0.5 + 0.35 * sin(angle2)
y.i2 <- 0.5 + 0.35 * cos(angle2)
x.i <- c(x.i1, x.i2)
y.i <- c(y.i1, y.i2)
x1 <- c(x.i, rev(x.i))
y1 <- c(y.i, 1 - rev(y.i))
x <- c(x, rev(x1))
y <- c(y, rev(y1))
x <- x.pos + wt * x
y <- y.pos + ht * y
if (is.null(id)) {
id <- rep(1, length(x))
fill <- rep("C", length(x))
} else {
id <- rep(id, length(x))
fill <- rep("C", length(x))
}
data.frame(x = x, y = y, id = id, fill = fill)
}
#' Generate a data frame for a polygon of "G" character
#'
#' @param x.pos The x-coordinate of the bottom left of the polygon.
#' @param y.pos The y-coordinate of the bottom left of the polygon.
#' @param ht The height of the polygon.
#' @param wt The width of the polygon.
#' @return The data frame for the polygon of "G" character.
#' @examples letter_G(0, 0, 1, 1)
letter_G <- function(x.pos, y.pos, ht, wt, id = NULL) {
angle1 <- seq(0.3 + pi / 2, pi, length = 100)
angle2 <- seq(pi ,1.5 * pi, length = 100)
x.l1 <- 0.5 + 0.5 * sin(angle1)
y.l1 <- 0.5 + 0.5 * cos(angle1)
x.l2 <- 0.5 + 0.5 * sin(angle2)
y.l2 <- 0.5 + 0.5 * cos(angle2)
x.l <- c(x.l1, x.l2)
y.l <- c(y.l1, y.l2)
x <- c(x.l, rev(x.l))
y <- c(y.l, 1 - rev(y.l))
x.i1 <- 0.5 + 0.35 * sin(angle1)
y.i1 <- 0.5 + 0.35 * cos(angle1)
x.i1 <- x.i1[y.i1 <= max(y.l1)]
y.i1 <- y.i1[y.i1 <= max(y.l1)]
y.i1[1] <- max(y.l1)
x.i2 <- 0.5 + 0.35 * sin(angle2)
y.i2 <- 0.5 + 0.35 * cos(angle2)
x.i <- c(x.i1, x.i2)
y.i <- c(y.i1, y.i2)
x1 <- c(x.i, rev(x.i))
y1 <- c(y.i, 1 - rev(y.i))
x <- c(x, rev(x1))
y <- c(y, rev(y1))
h1 <- max(y.l1)
r1 <- max(x.l1)
h1 <- 0.4
x.add <- c(r1, 0.5, 0.5, r1 - 0.2, r1 - 0.2, r1, r1)
y.add <- c(h1, h1, h1 - 0.1, h1 - 0.1, 0, 0, h1)
if (is.null(id)){
id <- c(rep(1, length(x)), rep(2, length(x.add)))
fill <- rep("G", length(x) + length(x.add))
} else {
id <- c(rep(id, length(x)), rep(id + 1, length(x.add)))
fill <- rep("G", length(x) + length(x.add))
}
x <- c(rev(x), x.add)
y <- c(rev(y), y.add)
x <- x.pos + wt*x
y <- y.pos + ht*y
data.frame(x = x, y = y, id = id, fill = fill)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.