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 中的数字四舍五入 的相关文章

  • R中添加水印

    我在用magickR中的库 我想在一些图片上添加水印 I used image annotate功能如下 img lt image read C Users Maydin Desktop manzara png image annotate
  • 使用 R Shiny 从 XLConnect 下载 Excel 文件

    有没有人尝试过使用 R Shiny 中的下载处理程序通过 XLConnect 下载新创建的 Excel 文件 在 ui R 中有一行不起眼的行 downloadButton downloadData Download 在 server R
  • 从 R 中的向量中选择所有可能的元组

    我正在尝试用 R 编写一个程序 当给定一个向量时 将返回所有可能的tuples http en wikipedia org wiki Tuples该向量中的元素 例如 元组 c a b c c a b c 出租车 c a c c b c c
  • 如何对同一列上的数据帧列表中的所有数据帧进行排序?

    我有一个数据框列表dataframes list 举个例子 我把dput dataframes list 在底部 我想对列列表中的所有数据框进行排序enrichment 我可以对一个数据框进行排序 first dataframe lt da
  • 如何在for循环中引用变量?

    我正在循环访问不同的 data tables 和 data table 中的变量 但我在引用内部变量时遇到问题for loop dt1 lt data table a1 c 1 2 3 a2 c 4 5 2 dt2 lt data tabl
  • 计算每个唯一值出现的次数

    假设我有 v rep c 1 2 2 2 25 现在 我想计算每个唯一值出现的次数 unique v 返回唯一值是什么 但不返回它们的数量 gt unique v 1 1 2 我想要一些能给我的东西 length v v 1 1 25 le
  • 在shiny中过滤传单地图数据

    我在用传单地图设置这个闪亮的东西时遇到了麻烦 我的原帖 https stackoverflow com questions 50111566 applying leaflet map bounds to filter data within
  • R - Plm 和 lm - 固定效应

    我有一个平衡面板数据集 df 本质上由三个变量组成 A B and Y 对于一堆独特识别的区域来说 它会随着时间的推移而变化 我想运行一个回归 其中包括区域 下面等式中的区域 和时间 年份 固定效应 如果我没记错的话 我可以通过不同的方式来
  • 绘制点之间的所有线

    我有以下 R 代码 x lt c 0 01848598 0 08052353 0 06741172 0 11652034 y lt c 0 4177541 0 4042247 0 3964025 0 4074685 d lt data fr
  • R 中的快速 QR 分解

    我有大量矩阵 需要对其执行 QR 分解并存储生成的 Q 矩阵 进行归一化 以便 R 矩阵在其对角线上具有正数 除了使用之外还有其他方法吗qr 功能 这是工作示例 system time Parameters for the matrix t
  • 尝试读取 CSV 文件时出现“无法识别的字符串转义”

    我正在尝试导入一个 csv文件 以便我可以观看此视频 R ggplot2 图形直方图 http www youtube com watch v 47kWynt3b6M 我安装了所有正确的软件包 包括ggplot以及相关的包 视频中的第一个说
  • 从命令行运行 R 代码 (Windows)

    我在名为 analysis r 的文件中有一些 R 代码 我希望能够从命令行 CMD 运行该文件中的代码 而无需通过 R 终端 并且我还希望能够传递参数并在我的代码中使用这些参数 例如就像下面的伪代码 C gt execute r scri
  • R独特的列或行与NA无可比拟

    有谁知道如果incomparables的论证unique or duplicated 曾经被实施过incomparables FALSE 也许我不明白它应该如何工作 无论如何 我正在寻找一个巧妙的解决方案 以仅保留与另一列相同的唯一列 或行
  • 在 R 中创建虚拟变量,排除某些情况为 NA

    我的数据看起来像这样 V1 V2 A 0 B 1 C 2 D 3 E 4 F 5 G 9 我想创建一个虚拟变量R where 0 1 1 2 3 4 and NA 0 5 9 应该很简单 有人可以帮忙吗 我们可以转换V2 into a fa
  • R 中的列乘以子字符串

    假设我有一个数据框 其中包含多个组件及其在多个列中列出的属性 并且我想对这些列运行多个函数 我的方法是尝试将其基于每个列标题中的子字符串 但我无法弄清楚如何做到这一点 下面是数据框的示例 Basket F Type 1 F Qty 1 F
  • 将每列的值乘以 R 中另一个 data.frame 中的权重

    我有两个data frames df and weights 代码如下 df看起来像这样 id a b d EE f 1 this 0 23421153 0 02324956 0 5457353 0 73068586 0 5642554 2
  • r 中训练和测试数据的最小最大缩放/归一化

    我正在创建一个函数 它将训练集和测试集作为其参数 最小 最大缩放 标准化并返回训练集并使用这些same最小值和最小 最大范围的值 标准化并返回测试集 到目前为止 这是我想出的功能 min max scaling lt function tr
  • 只读取选定的列

    谁能告诉我如何仅读取下面每年数据的前 6 个月 7 列 例如使用read table Year Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec 2009 41 27 25 31 31 39 2
  • 将阴影区域添加到五分位数之间的直方图中

    All 我有一个包含 2 个直方图的图表 其中我还绘制了代表第 20 40 60 和 80 个百分位数的线条 下面的代码使用虚拟数据重现了类似的图表 data lt rbind data frame x rnorm 1000 0 1 g o
  • 相当于 min() 的 rowMeans()

    我在 R 邮件列表上多次看到这个问题 但仍然找不到满意的答案 假设我有一个矩阵m m lt matrix rnorm 10000000 ncol 10 我可以通过以下方式获得每行的平均值 system time rowMeans m use

随机推荐