ggpairs 中的数字四舍五入

2024-04-21

是否可以将 ggpairs 中的相关数字舍入为例如 2 位数字?

library(GGally)
ggpairs(iris,
        columns = 1:4,
        mapping = ggplot2::aes(col = Species))

这是一个修改版本ggally_cor.
我添加了sgnf参数,表示有效位数。

mycor <- function(data, mapping, alignPercent = 0.6, method = "pearson", 
    use = "complete.obs", corAlignPercent = NULL, corMethod = NULL, 
    corUse = NULL, sgnf=3, ...) {
    if (!is.null(corAlignPercent)) {
        stop("'corAlignPercent' is deprecated.  Please use argument 'alignPercent'")
    }
    if (!is.null(corMethod)) {
        stop("'corMethod' is deprecated.  Please use argument 'method'")
    }
    if (!is.null(corUse)) {
        stop("'corUse' is deprecated.  Please use argument 'use'")
    }
    useOptions <- c("all.obs", "complete.obs", "pairwise.complete.obs", 
        "everything", "na.or.complete")
    use <- pmatch(use, useOptions)
    if (is.na(use)) {
        warning("correlation 'use' not found.  Using default value of 'all.obs'")
        use <- useOptions[1]
    } else {
        use <- useOptions[use]
    }
    cor_fn <- function(x, y) {
        cor(x, y, method = method, use = use)
    }
    xCol <- deparse(mapping$x)
    yCol <- deparse(mapping$y)
    if (GGally:::is_date(data[[xCol]]) || GGally:::is_date(data[[yCol]])) {
        if (!identical(class(data), "data.frame")) {
            data <- fix_data(data)
        }
        for (col in c(xCol, yCol)) {
            if (GGally:::is_date(data[[col]])) {
                data[[col]] <- as.numeric(data[[col]])
            }
        }
    }
    if (is.numeric(GGally:::eval_data_col(data, mapping$colour))) {
        stop("ggally_cor: mapping color column must be categorical, not numeric")
    }
    colorCol <- deparse(mapping$colour)
    singleColorCol <- ifelse(is.null(colorCol), NULL, paste(colorCol, 
        collapse = ""))
    if (use %in% c("complete.obs", "pairwise.complete.obs", "na.or.complete")) {
        if (length(colorCol) > 0) {
            if (singleColorCol %in% colnames(data)) {
                rows <- complete.cases(data[c(xCol, yCol, colorCol)])
            } else {
                rows <- complete.cases(data[c(xCol, yCol)])
            }
        } else {
            rows <- complete.cases(data[c(xCol, yCol)])
        }
        if (any(!rows)) {
            total <- sum(!rows)
            if (total > 1) {
                warning("Removed ", total, " rows containing missing values")
            } else if (total == 1) {
                warning("Removing 1 row that contained a missing value")
            }
        }
        data <- data[rows, ]
    }
    xVal <- data[[xCol]]
    yVal <- data[[yCol]]
    if (length(names(mapping)) > 0) {
        for (i in length(names(mapping)):1) {
            tmp_map_val <- deparse(mapping[names(mapping)[i]][[1]])
            if (tmp_map_val[length(tmp_map_val)] %in% colnames(data)) 
                mapping[[names(mapping)[i]]] <- NULL
            if (length(names(mapping)) < 1) {
                mapping <- NULL
                break
            }
        }
    }
    if (length(colorCol) < 1) {
        colorCol <- "ggally_NO_EXIST"
    }
    if ((singleColorCol != "ggally_NO_EXIST") && (singleColorCol %in% 
        colnames(data))) {
        cord <- plyr::ddply(data, c(colorCol), function(x) {
            cor_fn(x[[xCol]], x[[yCol]])
        })
        colnames(cord)[2] <- "ggally_cor"
        cord$ggally_cor <- signif(as.numeric(cord$ggally_cor), 
            sgnf)
        lev <- levels(data[[colorCol]])
        ord <- rep(-1, nrow(cord))
        for (i in 1:nrow(cord)) {
            for (j in seq_along(lev)) {
                if (identical(as.character(cord[i, colorCol]), 
                  as.character(lev[j]))) {
                  ord[i] <- j
                }
            }
        }
        cord <- cord[order(ord[ord >= 0]), ]
        cord$label <- GGally:::str_c(cord[[colorCol]], ": ", cord$ggally_cor)
        xmin <- min(xVal, na.rm = TRUE)
        xmax <- max(xVal, na.rm = TRUE)
        xrange <- c(xmin - 0.01 * (xmax - xmin), xmax + 0.01 * 
            (xmax - xmin))
        ymin <- min(yVal, na.rm = TRUE)
        ymax <- max(yVal, na.rm = TRUE)
        yrange <- c(ymin - 0.01 * (ymax - ymin), ymax + 0.01 * 
            (ymax - ymin))
        p <- ggally_text(label = GGally:::str_c("Corr: ", signif(cor_fn(xVal, 
            yVal), sgnf)), mapping = mapping, xP = 0.5, yP = 0.9, 
            xrange = xrange, yrange = yrange, color = "black", 
            ...) + theme(legend.position = "none")
        xPos <- rep(alignPercent, nrow(cord)) * diff(xrange) + 
            min(xrange, na.rm = TRUE)
        yPos <- seq(from = 0.9, to = 0.2, length.out = nrow(cord) + 
            1)
        yPos <- yPos * diff(yrange) + min(yrange, na.rm = TRUE)
        yPos <- yPos[-1]
        cordf <- data.frame(xPos = xPos, yPos = yPos, labelp = cord$label)
        cordf$labelp <- factor(cordf$labelp, levels = cordf$labelp)
        p <- p + geom_text(data = cordf, aes(x = xPos, y = yPos, 
            label = labelp, color = labelp), hjust = 1, ...)
        p
    }  else {
        xmin <- min(xVal, na.rm = TRUE)
        xmax <- max(xVal, na.rm = TRUE)
        xrange <- c(xmin - 0.01 * (xmax - xmin), xmax + 0.01 * 
            (xmax - xmin))
        ymin <- min(yVal, na.rm = TRUE)
        ymax <- max(yVal, na.rm = TRUE)
        yrange <- c(ymin - 0.01 * (ymax - ymin), ymax + 0.01 * 
            (ymax - ymin))
        p <- ggally_text(label = paste("Corr:\n", signif(cor_fn(xVal, 
            yVal), sgnf), sep = "", collapse = ""), mapping, xP = 0.5, 
            yP = 0.5, xrange = xrange, yrange = yrange, ...) + 
            theme(legend.position = "none")
        p
    }
}

这是显示如何在内部使用它的代码ggpairs:

library(GGally)
ggpairs(iris, columns = 1:4,
        upper=list(continuous=wrap(mycor, sgnf=1)),
        mapping = ggplot2::aes(col = Species))

Warning:请参阅以下链接了解更新:https://github.com/ggobi/ggally/issues/294 https://github.com/ggobi/ggally/issues/294

本文内容由网友自发贡献,版权归原作者所有,本站不承担相应法律责任。如您发现有涉嫌抄袭侵权的内容,请联系:hwhale#tublm.com(使用前将#替换为@)

ggpairs 中的数字四舍五入 的相关文章

  • 如何将闪亮 UI 输入框中的值传递回 R 脚本中的变量并运行它?

    我有以下代码source R我正打算逃离闪亮的 目前脚本中有硬编码值 例如 10000 55 15 200 等 以及这些值下面的一些矩阵相关元素 rnorm2 lt function n mean sd mean sd scale rnor
  • R 中的自定义对比:对比系数矩阵或对比矩阵/编码方案?以及如何到达那里?

    自定义对比在分析中应用非常广泛 例如 这个三水平因子的第 1 级和第 3 级的 DV 值是否有显着差异 直观上 这种对比用单元均值表示为 c 1 0 1 这些对比中的一个或多个 以列的形式绑定 形成对比系数矩阵 例如 mat matrix
  • 逐对计算行相似度百分比并将其添加为新列

    我有一个像这个示例一样的日期框架 我想找到相似的行 不重复 并逐个计算相似度 我发现这个解决方案 https stackoverflow com questions 52650932 how to calculate the similar
  • 通过 knit 和 igraph 在乳胶中绘制 tkplot

    这可能是一个疯狂的奇怪的梦 我梦想着我可以放一个tkplot from igraph在乳胶文档中通过knitr 我知道一辉对动画很了解 所以我想也许这是可能的 谷歌搜索没有显示我想要什么 所以这是一个无效的尝试 documentclass
  • 如何限制 viridis 色标的范围?

    我有两组数据 我想使用带有 viridis 色标的热图来呈现它们 对于第一个数据集 我的值范围从 0 到 1 2 我可以轻松看到我想要看到的差异 然而 我的第二个数据集有一些异常值 导致范围从 0 到 2 现在很难看出 0 和 1 之间有趣
  • 如何在 RSM (R) 中填充轮廓颜色并写入轴名称

    我有以下数据 ct lt structure list Conc c 50L 100L 150L 50L 100L 150L 50L 100L 150L 100L 100L 100L kGy c 10L 10L 10L 15L 15L 15
  • 闪亮错误:参数暗示行数不同

    我正在尝试开发一个简单的应用程序 从 Kijiji 网站获取本地分类广告 我用几乎相同的脚本制作了一个类似的应用程序 但我没有收到下面描述的错误 所以我不知道这个脚本出了什么问题 我尝试了我能想到的一切 但无法让它发挥作用 的结构df数据框
  • R 中带有文件名的 For 循环

    我有一个文件列表 例如 nE pT sbj01 e2 2 csv nE pT sbj02 e2 2 csv nE pT sbj04 e2 2 csv nE pT sbj05 e2 2 csv nE pT sbj09 e2 2 csv nE
  • 从 R 中的向量中选择所有可能的元组

    我正在尝试用 R 编写一个程序 当给定一个向量时 将返回所有可能的tuples http en wikipedia org wiki Tuples该向量中的元素 例如 元组 c a b c c a b c 出租车 c a c c b c c
  • 如何在R中计算文本中的句子数?

    我使用 R 将文本读入readChar 功能 我的目的是测试文本句子中字母 a 出现次数与字母 b 出现次数一样多的假设 我最近发现了 stringr 包 它帮助我对文本做很多有用的事情 例如计算字符数以及整个文本中每个字母出现的总数 现在
  • ggplot2可以在一个图例中分别控制点大小和线大小(线宽)吗?

    一个使用的例子ggplot2绘制数据点组和连接每组均值的线 并使用相同的映射aes for shape并为linetype p lt ggplot mtcars aes gear mpg shape factor cyl linetype
  • R 中具有稳健回归的异常值

    我正在使用lmrobR 中的函数使用robustbase用于稳健回归的库 我会把它用作 rob reg lt lmrob y 0 dat method MM control a1 当我想返回我使用的摘要时summary rob reg 稳健
  • 将年月格式转换为 POSIXct [重复]

    这个问题在这里已经有答案了 我有一些年月形式的数据 我想将其格式化以用于绘图ggplot date lt c 2016 03 2016 04 2016 05 2016 06 2016 07 2016 08 2016 09 2016 10 2
  • 如何在 ggplot 中保持配色方案,同时删除每个图中未使用的级别?

    我想比较一个图中的数据的一些子组和另一图中的一些其他子组 如果我绘制一个图 其中绘制了所有子组 那么这个数字将是巨大的 并且每个单独的比较都会变得困难 我认为如果给定的子组在所有图中都具有相同的颜色 这对读者来说会更有意义 这是我尝试过的两
  • 使用 broom 和 tidyverse 总结 r 平方游戏

    我发布了一个问题here https stackoverflow com questions 48627287 getting adjusted r squared value for each line in a geom smooth
  • 删除ggplot2中的负图区域[重复]

    这个问题在这里已经有答案了 如何删除 ggplot2 中 x 轴和 y 轴下方的绘图区域 请参见下面的示例 我尝试了几个主题元素 panel border panel margin plot margin 但没有任何运气 p lt ggpl
  • 如何用外部图像填充地图边界?

    我正在创建一张带有州边界的巴西地图 这可以直接使用ggplot2 and geom sf 然而 这一次 我不想用数据填充每个状态的颜色 而是想用外部图像 png 填充每个状态的边界 类似于this https online olivet e
  • R中的一元加/减是什么?

    来自 R 的详细信息部分Syntax http stat ethz ch R manual R patched library base html Syntax html帮助页面 定义了以下一元和二元运算符 他们被列出 在优先级组中 从最高
  • 如何计算R中移动窗口内的平均斜率

    我的数据集包含2个变量y 和 t 05s y 每 05 秒测量一次 我正在尝试计算移动中的平均坡度20秒窗口 即计算第一个 20 秒斜率值后 窗口向前移动一个时间单位 05 秒 并计算下一个 20 秒窗口 在以下位置生成连续 20 秒斜率值
  • 通过间接引用列来修改数据框中的某些值

    我正在整理一些数据 我们将失败的数据分类到垃圾箱中 并按批次计算每个分类箱的有限产量 我有一个描述排序箱的元表 这些行按升序测试顺序排列 一些排序标签带有非语法名称 sort tbl lt tibble tribble weight lab

随机推荐