Изменить цифры чисел в Venndiagram

Я не знаю почему, но каким-то образом, когда я использую цифры в визуализации диаграммы Венна с помощью пакета VennDiagram, перекрывающиеся части показывают разное количество цифр, как показано ниже введите здесь описание изображения
Я использовал R и Excel для расчета этих данных (на самом деле они в процентах), но все они дают мне такой результат, когда я пытаюсь его визуализировать.

код ниже:

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

данные: данные = 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))


person MYjx    schedule 05.03.2015    source источник
comment
например, для 1.73...e-18 это происходит из-за того, что если вы введете 0.03-0-0.02-0.01 в R, вы получите -1.734723e-18...   -  person Cath    schedule 05.03.2015
comment
как это исправить? это супер раздражает...   -  person MYjx    schedule 05.03.2015
comment
это происходит из-за того, как числа представлены в R (см., например, здесь). Возможно, вы можете изменить функцию, чтобы округлить значения до 2 цифр.   -  person Cath    schedule 05.03.2015
comment
проблема в том, что расчет между этими числами выполняется автоматически пакетом... для меня нет параметра, чтобы указать, что   -  person MYjx    schedule 05.03.2015
comment
нет, но вы можете создать модифицированную функцию draw.quintuple.venn, в которой вы округляете значения (от a1 до a31 в функции), вычисленные функцией   -  person Cath    schedule 05.03.2015


Ответы (1)


Чтобы завершить мой комментарий, вы можете создать свою собственную функцию, немного изменив исходную функцию, например:

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

с вашими данными вы получите:

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

введите здесь описание изображения

person Cath    schedule 05.03.2015
comment
Привет @CathG, не могли бы вы помочь мне закончить редактирование и удалить строку комментариев, так как информация довольно конфиденциальная. Спасибо! - person MYjx; 18.03.2015
comment
@MYjx, я думаю, проблема решена ;-) На самом деле, я просто скопировал / вставил функцию и прочитал только ту часть, которая меня интересовала, иначе я бы подавил эту строку. Спасибо, что сделали это! - person Cath; 19.03.2015