Change the digits of numbers in Venndiagram

Question

I don't know why but somehow when I use digits in the venn diagram visualization using VennDiagram package, the overlap parts show different numbers of digits as below enter image description here
I have used both R and excel to calculate these data (they are actually percentage) but they all give me the result like this when I tried to visualize it.

code is below:

 draw.quintuple.venn(area1 = data[1,1],area2 = data[1,2],area3 = data[1,3],area4 = data[1,4],area5 = data[1,5],n12 = data[1,6],n13 = data[1,7],n14 = data[1,8],n15 = data[1,9],n23 = data[1,10],n24 = data[1,11],n25 = data[1,12],n34 = data[1,13],n35 = data[1,14],n45 = data[1,15],n123 = data[1,16],n124 = data[1,17],n125 = data[1,18],n134 = data[1,20],n135 = data[1,19],n145 = data[1,21],n234 = data[1,22],n235 = data[1,23],n245 = data[1,24],n345 = data[1,25],n1234 = data[1,26],n1235 = data[1,27],n1245 = data[1,28],n1345 = data[1,29],n2345 = data[1,30],
    n12345 = data[1,31],
    fill = c("#1f77b4", "#FF7F0E", "#2ca04e", "#d62728", "pink"),
    lwd = rep(1, 5),
    lty = "dashed",
    cex = 1,
    cat.cex = 2,
    cat.col =  c("#1f77b4", "#FF7F0E", "#2ca04e", "#d62728", "pink"))

data is: data = as.data.frame(c(68.93,29.09, 2.85, 2.59, 13.86, 7.49, 1.12, 1.97, 4.84, 0.60, 0.34, 2.03, 0.13, 0.31, 0.29, 0.24, 0.27, 0.75, 0.15, 0.10, 0.23, 0.03, 0.09, 0.06, 0.02, 0.03, 0.05, 0.05, 0.02, 0.01, 0.01))

for example for `1.73...e-18`, it comes from the fact that, if you type `0.03-0-0.02-0.01` in `R`, you get `-1.734723e-18`... — Cath, Mar 05 '15 at 10:17
it comes from how numbers are represented in `R` (see [here](http://stackoverflow.com/questions/9508518/why-are-these-numbers-not-equal) for example). You can maybe modify the function to round values to 2 digits. — Cath, Mar 05 '15 at 10:21
the problem is the calculation between these numbers is done automatically by the package...there is no parameter for me to specify that — MYjx, Mar 05 '15 at 10:25
no but you can create a modified `draw.quintuple.venn` function where you round the values (`a1` to `a31` in the function) computed by the function — Cath, Mar 05 '15 at 10:36

score 1 · Accepted Answer · edited Mar 18 '15 at 18:09

To complete my comment, you can create your own function by modifying a bit the original function, like this:

draw.quintuple.venn_mod <- function (area1, area2, area3, area4, area5, n12, n13, n14, n15, 
                                     n23, n24, n25, n34, n35, n45, n123, n124, n125, n134, n135, 
                                     n145, n234, n235, n245, n345, n1234, n1235, n1245, n1345, 
                                     n2345, n12345, category = rep("", 5),
                                     lwd = rep(2, 5), lty = rep("solid", 5),
                                     col = rep("black", 5), fill = NULL, alpha = rep(0.5, 5), 
                                     label.col = rep("black", 31), cex = rep(1, 31), 
                                     fontface = rep("plain", 31), fontfamily = rep("serif", 31), 
                                     cat.pos = c(0, 287.5, 215, 145, 70), cat.dist = rep(0.2, 5), cat.col = rep("black", 5), cat.cex = rep(1, 5), cat.fontface = rep("plain", 5), cat.fontfamily = rep("serif", 5), cat.just = rep(list(c(0.5, 0.5)), 5), rotation.degree = 0, rotation.centre = c(0.5, 0.5), ind = TRUE, 
                                     dig=2, ...) # add a parameter for number of digits by which to round your values
{
    if (length(category) == 1) {
        cat <- rep(category, 5)
    }
    else if (length(category) != 5) {
        stop("Unexpected parameter length for 'category'")
    }
    if (length(lwd) == 1) {
        lwd <- rep(lwd, 5)
    }
    else if (length(lwd) != 5) {
        stop("Unexpected parameter length for 'lwd'")
    }
    if (length(lty) == 1) {
        lty <- rep(lty, 5)
    }
    else if (length(lty) != 5) {
        stop("Unexpected parameter length for 'lty'")
    }
    if (length(col) == 1) {
        col <- rep(col, 5)
    }
    else if (length(col) != 5) {
        stop("Unexpected parameter length for 'col'")
    }
    if (length(label.col) == 1) {
        label.col <- rep(label.col, 31)
    }
    else if (length(label.col) != 31) {
        stop("Unexpected parameter length for 'label.col'")
    }
    if (length(cex) == 1) {
        cex <- rep(cex, 31)
    }
    else if (length(cex) != 31) {
        stop("Unexpected parameter length for 'cex'")
    }
    if (length(fontface) == 1) {
        fontface <- rep(fontface, 31)
    }
    else if (length(fontface) != 31) {
        stop("Unexpected parameter length for 'fontface'")
    }
    if (length(fontfamily) == 1) {
        fontfamily <- rep(fontfamily, 31)
    }
    else if (length(fontfamily) != 31) {
        stop("Unexpected parameter length for 'fontfamily'")
    }
    if (length(fill) == 1) {
        fill <- rep(fill, 5)
    }
    else if (length(fill) != 5 & length(fill) != 0) {
        stop("Unexpected parameter length for 'fill'")
    }
    if (length(alpha) == 1) {
        alpha <- rep(alpha, 5)
    }
    else if (length(alpha) != 5 & length(alpha) != 0) {
        stop("Unexpected parameter length for 'alpha'")
    }
    if (length(cat.pos) == 1) {
        cat.pos <- rep(cat.pos, 5)
    }
    else if (length(cat.pos) != 5) {
        stop("Unexpected parameter length for 'cat.pos'")
    }
    if (length(cat.dist) == 1) {
        cat.dist <- rep(cat.dist, 5)
    }
    else if (length(cat.dist) != 5) {
        stop("Unexpected parameter length for 'cat.dist'")
    }
    if (length(cat.col) == 1) {
        cat.col <- rep(cat.col, 5)
    }
    else if (length(cat.col) != 5) {
        stop("Unexpected parameter length for 'cat.col'")
    }
    if (length(cat.cex) == 1) {
        cat.cex <- rep(cat.cex, 5)
    }
    else if (length(cat.cex) != 5) {
        stop("Unexpected parameter length for 'cat.cex'")
    }
    if (length(cat.fontface) == 1) {
        cat.fontface <- rep(cat.fontface, 5)
    }
    else if (length(cat.fontface) != 5) {
        stop("Unexpected parameter length for 'cat.fontface'")
    }
    if (length(cat.fontfamily) == 1) {
        cat.fontfamily <- rep(cat.fontfamily, 5)
    }
    else if (length(cat.fontfamily) != 5) {
        stop("Unexpected parameter length for 'cat.fontfamily'")
    }
    if (!(class(cat.just) == "list" & length(cat.just) == 5 & 
        length(cat.just[[1]]) == 2 & length(cat.just[[2]]) == 
        2 & length(cat.just[[3]]) == 2 & length(cat.just[[4]]) == 
        2 & length(cat.just[[5]]) == 2)) {
        stop("Unexpected parameter format for 'cat.just'")
    }
    cat.pos <- cat.pos + rotation.degree
# for each a.., modify the computation to add a rounding step
    a31 <- round(n12345, dig)
    a30 <- round(n1234 - a31, dig)
    a29 <- round(n1235 - a31, dig)
    a28 <- round(n1245 - a31, dig)
    a27 <- round(n1345 - a31, dig)
    a26 <- round(n2345 - a31, dig)
    a25 <- round(n245 - a26 - a28 - a31, dig)
    a24 <- round(n234 - a26 - a30 - a31, dig)
    a23 <- round(n134 - a27 - a30 - a31, dig)
    a22 <- round(n123 - a29 - a30 - a31, dig)
    a21 <- round(n235 - a26 - a29 - a31, dig)
    a20 <- round(n125 - a28 - a29 - a31, dig)
    a19 <- round(n124 - a28 - a30 - a31, dig)
    a18 <- round(n145 - a27 - a28 - a31, dig)
    a17 <- round(n135 - a27 - a29 - a31, dig)
    a16 <- round(n345 - a26 - a27 - a31, dig)
    a15 <- round(n45 - a18 - a25 - a16 - a28 - a27 - a26 - a31, dig)
    a14 <- round(n24 - a19 - a24 - a25 - a30 - a28 - a26 - a31, dig)
    a13 <- round(n34 - a16 - a23 - a24 - a26 - a27 - a30 - a31, dig)
    a12 <- round(n13 - a17 - a22 - a23 - a27 - a29 - a30 - a31, dig)
    a11 <- round(n23 - a21 - a22 - a24 - a26 - a29 - a30 - a31, dig)
    a10 <- round(n25 - a20 - a21 - a25 - a26 - a28 - a29 - a31, dig)
    a9 <- round(n12 - a19 - a20 - a22 - a28 - a29 - a30 - a31, dig)
    a8 <- round(n14 - a18 - a19 - a23 - a27 - a28 - a30 - a31, dig)
    a7 <- round(n15 - a17 - a18 - a20 - a27 - a28 - a29 - a31, dig)
    a6 <- round(n35 - a16 - a17 - a21 - a26 - a27 - a29 - a31, dig)
    a5 <- round(area5 - a6 - a7 - a15 - a16 - a17 - a18 - a25 - a26 - 
        a27 - a28 - a31 - a20 - a29 - a21 - a10, dig)
    a4 <- round(area4 - a13 - a14 - a15 - a16 - a23 - a24 - a25 - a26 - 
        a27 - a28 - a31 - a18 - a19 - a8 - a30, dig)
    a3 <- round(area3 - a21 - a11 - a12 - a13 - a29 - a22 - a23 - a24 - 
        a30 - a31 - a26 - a27 - a16 - a6 - a17, dig)
    a2 <- round(area2 - a9 - a10 - a19 - a20 - a21 - a11 - a28 - a29 - 
        a31 - a22 - a30 - a26 - a25 - a24 - a14, dig)
    a1 <- round(area1 - a7 - a8 - a18 - a17 - a19 - a9 - a27 - a28 - 
        a31 - a20 - a30 - a29 - a22 - a23 - a12, dig)
    areas <- c(a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, 
        a12, a13, a14, a15, a16, a17, a18, a19, a20, a21, a22, 
        a23, a24, a25, a26, a27, a28, a29, a30, a31)
    areas.error <- c("a1 <- area1 - a7 - a8 - a18 - a17 - a19 - a9 - a27 - a28 - a31 - a20 - a30 - a29 - a22 - a23 - a12", 
        "a2 <- area2 - a9 - a10 - a19 - a20 - a21 - a11 - a28 - a29 - a31 - a22 - a30 - a26 - a25 - a24 - a14", 
        "a3 <- area3 - a21 - a11 - a12 - a13 - a29 - a22 - a23 - a24 - a30 - a31 - a26 - a27 - a16 - a6 - a17", 
        "a4 <- area4 - a13 - a14 - a15 - a16 - a23 - a24 - a25 - a26 - a27 - a28 - a31 - a18 - a19 - a8 - a30", 
        "a5 <- area5 - a6 - a7 - a15 - a16 - a17 - a18 - a25 - a26 - a27 - a28 - a31 - a20 - a29 - a21 - a10", 
        "a6 <- n35 - a16 - a17 - a21 - a26 - a27 - a29 - a31", 
        "a7 <- n15 - a17 - a18 - a20 - a27 - a28 - a29 - a31", 
        "a8 <- n14 - a18 - a19 - a23 - a27 - a28 - a30 - a31", 
        "a9 <- n12 - a19 - a20 - a22 - a28 - a29 - a30 - a31", 
        "a10 <- n25 - a20 - a21 - a25 - a26 - a28 - a29 - a31", 
        "a11 <- n23 - a21 - a22 - a24 - a26 - a29 - a30 - a31", 
        "a12 <- n13 - a17 - a22 - a23 - a27 - a29 - a30 - a31", 
        "a13 <- n34 - a16 - a23 - a24 - a26 - a27 - a30 - a31", 
        "a14 <- n24 - a19 - a24 - a25 - a30 - a28 - a26 - a31", 
        "a15 <- n45 - a18 - a25 - a16 - a28 - a27 - a26 - a31", 
        "a16 <- n345 - a26 - a27 - a31", "a17 <- n135 - a27 - a29 - a31", 
        "a18 <- n145 - a27 - a28 - a31", "a19 <- n124 - a28 - a30 - a31", 
        "a20 <- n125 - a28 - a29 - a31", "a21 <- n235 - a26 - a29 - a31", 
        "a22 <- n123 - a29 - a30 - a31", "a23 <- n134 - a27 - a30 - a31", 
        "a24 <- n234 - a26 - a30 - a31", "a25 <- n245 - a26 - a28 - a31", 
        "a26 <- n2345 - a31", "a27 <- n1345 - a31", "a28 <- n1245 - a31", 
        "a29 <- n1235 - a31", "a30 <- n1234 - a31", "a31 <- n12345")
    for (i in 1:length(areas)) {
        if (areas[i] < 0) {
            stop(paste("Impossible:", areas.error[i], "produces negative area"))
        }
    }
    grob.list <- gList()
    dist <- 0.13
    a <- 0.24
    b <- 0.46
    init.angle <- -20
    ellipse.positions <- matrix(nrow = 5, ncol = 3)
    colnames(ellipse.positions) <- c("x", "y", "rotation")
    ellipse.positions[1, ] <- c(0.5 + dist * sin(init.angle * 
        pi/180), 0.5 + dist * cos(init.angle * pi/180), 0)
    ellipse.positions[2, ] <- c(0.5 - dist * cos((288 + init.angle - 
        270) * pi/180), 0.5 + dist * sin((288 + init.angle - 
        270) * pi/180), -110)
    ellipse.positions[3, ] <- c(0.5 - dist * sin((216 + init.angle - 
        180) * pi/180), 0.5 - dist * cos((216 + init.angle - 
        180) * pi/180), 145)
    ellipse.positions[4, ] <- c(0.5 + dist * sin((180 - 144 - 
        init.angle) * pi/180), 0.5 - dist * cos((180 - 144 - 
        init.angle) * pi/180), 35)
    ellipse.positions[5, ] <- c(0.5 + dist * cos((init.angle + 
        72 - 90) * pi/180), 0.5 - dist * sin((init.angle + 72 - 
        90) * pi/180), -72.5)
    for (i in 1:5) {
        grob.list <- gList(grob.list, VennDiagram::ellipse(x = ellipse.positions[i, 
            "x"], y = ellipse.positions[i, "y"], a = a, b = b, 
            rotation = ellipse.positions[i, "rotation"], gp = gpar(lty = 0, 
                fill = fill[i], alpha = alpha[i])))
    }
    for (i in 1:5) {
        grob.list <- gList(grob.list, VennDiagram::ellipse(x = ellipse.positions[i, 
            "x"], y = ellipse.positions[i, "y"], a = a, b = b, 
            rotation = ellipse.positions[i, "rotation"], gp = gpar(lwd = lwd[i], 
                lty = lty[i], col = col[i], fill = "transparent")))
    }
    label.matrix <- matrix(nrow = 31, ncol = 3)
    colnames(label.matrix) <- c("label", "x", "y")
    label.matrix[1, ] <- c(a1, 0.4555, 0.9322)
    label.matrix[2, ] <- c(a2, 0.08, 0.6)
    label.matrix[3, ] <- c(a3, 0.3, 0.1)
    label.matrix[4, ] <- c(a4, 0.79, 0.17)
    label.matrix[5, ] <- c(a5, 0.9, 0.68)
    label.matrix[6, ] <- c(a6, 0.74, 0.695)
    label.matrix[7, ] <- c(a7, 0.63, 0.805)
    label.matrix[8, ] <- c(a8, 0.4, 0.795)
    label.matrix[9, ] <- c(a9, 0.255, 0.715)
    label.matrix[10, ] <- c(a10, 0.193, 0.48)
    label.matrix[11, ] <- c(a11, 0.225, 0.333)
    label.matrix[12, ] <- c(a12, 0.42, 0.205)
    label.matrix[13, ] <- c(a13, 0.572, 0.18)
    label.matrix[14, ] <- c(a14, 0.753, 0.32)
    label.matrix[15, ] <- c(a15, 0.823, 0.47)
    label.matrix[16, ] <- c(a16, 0.747, 0.582)
    label.matrix[17, ] <- c(a17, 0.662, 0.75)
    label.matrix[18, ] <- c(a18, 0.488, 0.761)
    label.matrix[19, ] <- c(a19, 0.323, 0.737)
    label.matrix[20, ] <- c(a20, 0.253, 0.573)
    label.matrix[21, ] <- c(a21, 0.225, 0.395)
    label.matrix[22, ] <- c(a22, 0.355, 0.29)
    label.matrix[23, ] <- c(a23, 0.515, 0.205)
    label.matrix[24, ] <- c(a24, 0.655, 0.29)
    label.matrix[25, ] <- c(a25, 0.783, 0.42)
    label.matrix[26, ] <- c(a26, 0.72, 0.445)
    label.matrix[27, ] <- c(a27, 0.605, 0.701)
    label.matrix[28, ] <- c(a28, 0.342, 0.668)
    label.matrix[29, ] <- c(a29, 0.294, 0.41)
    label.matrix[30, ] <- c(a30, 0.522, 0.273)
    label.matrix[31, ] <- c(a31, 0.5, 0.5)
    for (i in 1:nrow(label.matrix)) {
        tmp <- textGrob(label = label.matrix[i, "label"], x = label.matrix[i, 
            "x"], y = label.matrix[i, "y"], gp = gpar(col = label.col[i], 
            cex = cex[i], fontface = fontface[i], fontfamily = fontfamily[i]))
        grob.list <- gList(grob.list, tmp)
    }
    cat.pos.x <- c(0.4555, 0.08, 0.3, 0.79, 0.9)
    cat.pos.y <- c(0.9322, 0.6, 0.1, 0.17, 0.68)
    for (i in 1:5) {
        this.cat.pos <- find.cat.pos(x = cat.pos.x[i], y = cat.pos.y[i], 
            pos = cat.pos[i], dist = cat.dist[i])
        grob.list <- gList(grob.list, textGrob(label = category[i], 
            x = this.cat.pos$x, y = this.cat.pos$y, just = cat.just[[i]], 
            gp = gpar(col = cat.col[i], cex = cat.cex[i], fontface = cat.fontface[i], 
                fontfamily = cat.fontfamily[i])))
    }
    grob.list <- VennDiagram::adjust.venn(VennDiagram::rotate.venn.degrees(grob.list, 
        rotation.degree, rotation.centre[1], rotation.centre[2]), 
        ...)
    if (ind) {
        grid.draw(grob.list)
    }
    return(grob.list)
}

with your data, you'll get:

draw.quintuple.venn_mod(area1 = data[1,1],area2 = data[1,2],area3 = data[1,3],area4 = data[1,4],area5 = data[1,5],n12 = data[1,6],n13 = data[1,7],n14 = data[1,8],n15 = data[1,9],n23 = data[1,10],n24 = data[1,11],n25 = data[1,12],n34 = data[1,13],n35 = data[1,14],n45 = data[1,15],n123 = data[1,16],n124 = data[1,17],n125 = data[1,18],n134 = data[1,20],n135 = data[1,19],n145 = data[1,21],n234 = data[1,22],n235 = data[1,23],n245 = data[1,24],n345 = data[1,25],n1234 = data[1,26],n1235 = data[1,27],n1245 = data[1,28],n1345 = data[1,29],n2345 = data[1,30],
    n12345 = data[1,31],
    fill = c("#1f77b4", "#FF7F0E", "#2ca04e", "#d62728", "pink"),
    lwd = rep(1, 5),
    lty = "dashed",
    cex = 1,
    cat.cex = 2,
    cat.col =  c("#1f77b4", "#FF7F0E", "#2ca04e", "#d62728", "pink"))

enter image description here

Hi @CathG could you help me finish the editing and take down the comment line since the info is kinda sensitive. Thanks! — MYjx, Mar 18 '15 at 17:42
@MYjx, I guess the problem is solved ;-) Actually, I just copied/pasted the function and read only the part I was interested in, else I would have suppress this line. Thanks for having done it ! — Cath, Mar 19 '15 at 07:50

Change the digits of numbers in Venndiagram

1 Answers1