R中具有对数轴的散点图矩阵

时间:2012-07-05 12:25:15

标签: r ggplot2

我正在尝试从我的数据集创建一个散点图矩阵,以便在结果矩阵中创建:

  • 我有两个不同的小组
    • 一年中的季度(以点数的颜色区分)
    • 日类型(指示的点的形状,周一至周五之间的周末或休闲日)
  • 对数刻度的x和y轴。
  • 轴刻度标签上的值不是对数,即值应在轴上显示为0到350之间的整数,而不是它们的log10对应物。
  • 上面板有每个季度的相关值。

到目前为止,我尝试过使用函数:

  1. 对()
  2. ggpairs()[来自GGally包]
  3. scatterplotMatrix()
  4. splom()
  5. 但是我无法用这些软件包获得不错的结果,并且每次看起来我的一个或多个要求都缺失了。

    • 使用pairs(),我可以创建散点图矩阵,但参数 log =“xy”以某种方式从结果矩阵的对角线中删除变量名称。
    • ggpairs()不直接支持对数刻度,但是我创建了一个函数,该函数根据this答案通过散点图矩阵的对角线和下平面。虽然对数缩放在较低的平面上工作,但它会弄乱变量标签和值滴答。

    创建和使用函数如下:

    ggpairs_logarithmize <- function(a) { # parameter a is a ggpairs sp-matrix
            max_limit <- sqrt(length(a$plots))
            for(row in 1:max_limit) { # index 1 is used to go through the diagonal also
                    for(col in j:max_limit) {
                            subsp <- getPlot(a,row,col)
                            subspnew <- subsp + scale_y_log10() + scale_x_log10()
                            subspnew$type <- 'logcontinous'
                            subspnew$subType <- 'logpoints'
                            a <- putPlot(a,subspnew,row,col)
                    }
            }
            return(a)
    }
    scatplot <- ggpairs(...)
    scatplot_log10 <- ggpairs_logarithmize(scatplot)
    scatplot_log10
    
    • scatterplotMatrix()似乎不支持两个分组。我能够分别为季节和日期类型做这个,但是我需要在同一个情节中的两个小组。
    • splom()以某种方式将轴刻度值标记为对数值,这些值应保持原样(在整数0和350之间)。

    是否有任何简单的解决方案可用于创建具有对数轴的散点图矩阵以满足我的要求?

    EDIT(13.7.2012):询问示例数据和输出。以下是生成演示数据集的一些代码片段:

    声明必要的功能

    logarithmize <- function(a)
    {
            max_limit <- sqrt(length(a$plots))
            for(j in 1:max_limit) {
                    for(i in j:max_limit) {
                            subsp <- getPlot(a,i,j)
                            subspnew <- subsp + scale_y_log10() + scale_x_log10()
                            subspnew$type <- 'logcontinous'
                            subspnew$subType <- 'logpoints'
                            a <- putPlot(a,subspnew,i,j)
                    }
            }
            return(a)
    }
    
    add_quarters <- function(a,datecol,targetcol) {
        for(i in 1:nrow(a)) {
            month <- 1+as.POSIXlt(as.Date(a[i,datecol]))$mon
            if ( month <= 3 ) { a[i,targetcol] <- "Q1" }
            else if (month <= 6 && month > 3) { a[i,targetcol] <- "Q2" }
            else if ( month <= 9 && month > 6 ) { a[i,targetcol] <- "Q3" }
            else if ( month > 9 ) { a[i,targetcol] <- "Q4" }
        }
        return(a)
    }
    

    创建数据集:

    days <- seq.Date(as.Date("2010-01-01"),as.Date("2012-06-06"),"day")
    bananas <- sample(1:350,length(days), replace=T)
    apples <- sample(1:350,length(days), replace=T)
    oranges <- sample(1:350,length(days), replace=T)
    weekdays <- c("Monday","Tuesday","Wednesday","Thursday","Friday","Saturday","Sunday")
    fruitsales <- data.frame(Date=days,Dayofweek=rep(weekdays,length.out=length(days)),Bananas=bananas,Apples=apples,Oranges=oranges)
    fruitsales[5:6,"Quarter"] <- NA
    fruitsales[6:7,"Daytype"] <- NA
    fruitsales$Daytype <- fruitsales$Dayofweek
    levels(fruitsales$Daytype) # Confirm the day type levels before assigning new levels
    levels(fruitsales$Daytype) <- c("Casual","Casual","Weekend","Weekend","Casual","Casual","Casual
    ")
    fruitsales <- add_quarters(fruitsales,1,6)
    

    Excecute(注意!Windows / Mac用户,根据您拥有的操作系​​统更改x11())

    # install.packages("GGally")
    require(GGally)
    x11(); ggpairs(fruitsales,columns=3:5,colour="Quarter",shape="Daytype")
    x11(); logarithmize(ggpairs(fruitsales,columns=3:5,colour="Quarter",shape="Daytype"))
    

1 个答案:

答案 0 :(得分:4)

pairs的问题源于在日志坐标系中使用用户坐标。具体来说,在对角线上添加标签时,pairs设置

par(usr = c(0, 1, 0, 1))

但是,如果您通过log = "xy"指定日志坐标系,那么您需要的是

par(usr = c(0, 1, 0, 1), xlog = FALSE, ylog = FALSE) 

请参阅this post on R help

这表明以下解决方案(使用相关数据):

## adapted from panel.cor in ?pairs
panel.cor <- function(x, y, digits=2, cex.cor, quarter, ...)
{
  usr <- par("usr"); on.exit(par(usr))
  par(usr = c(0, 1, 0, 1), xlog = FALSE, ylog = FALSE)
  r <- rev(tapply(seq_along(quarter), quarter, function(id) cor(x[id], y[id])))
  txt <- format(c(0.123456789, r), digits=digits)[-1]
  txt <- paste(names(txt), txt)
  if(missing(cex.cor)) cex.cor <- 0.8/strwidth(txt)
  text(0.5, c(0.2, 0.4, 0.6, 0.8), txt)
}

pairs(fruitsales[,3:5], log = "xy", 
      diag.panel = function(x, ...) par(xlog = FALSE, ylog = FALSE),
      label.pos = 0.5,
      col = unclass(factor(fruitsales[,6])), 
      pch = unclass(fruitsales[,7]), upper.panel = panel.cor, 
      quarter = factor(fruitsales[,6]))

这会生成以下图

pairs plot on log coordinate system