Skip to content

Instantly share code, notes, and snippets.

@florianhartig

florianhartig/CorrelationDensityPlotWithIpanel.r

Last active January 3, 2016 06:29
Download ZIP

Revisions

  1. florianhartig renamed this gist Jan 14, 2014. 1 changed file with 0 additions and 0 deletions.
    0 CorrelationDensityPlotWithIpanel → CorrelationDensityPlotWithIpanel.r
    View file
    File renamed without changes.
  2. florianhartig revised this gist Jan 14, 2014. 1 changed file with 2 additions and 0 deletions.
    2 changes: 2 additions & 0 deletions CorrelationDensityPlotWithIpanel
    View file
    Original file line number Diff line number Diff line change
    @@ -25,6 +25,8 @@ betterPairs <- function(YourData){
    return(pairs(YourData, lower.panel=function(...) {par(new=TRUE);ipanel.smooth(...)}, diag.panel=panel.hist, upper.panel=panel.cor))
    }

    # Example

    x = rnorm(10000)
    betterPairs(data.frame(A = x, B = 0.6 * x + 0.3 * rnorm(10000), C = rnorm(10000)))

  3. florianhartig revised this gist Jan 14, 2014. 1 changed file with 26 additions and 24 deletions.
    50 changes: 26 additions & 24 deletions CorrelationDensityPlotWithIpanel
    View file
    Original file line number Diff line number Diff line change
    @@ -1,28 +1,30 @@
    library(IDPmisc)
    library(psych)
    library(igraph)

    panel.hist <- function(x, ...)
    {
    usr <- par("usr"); on.exit(par(usr))
    par(usr = c(usr[1:2], 0, 1.5) )
    h <- hist(x, plot = FALSE)
    breaks <- h$breaks; nB <- length(breaks)
    y <- h$counts; y <- y/max(y)
    rect(breaks[-nB], 0, breaks[-1], y, col="blue4", ...)
    }

    panel.hist <- function(x, ...)
    {
    usr <- par("usr"); on.exit(par(usr))
    par(usr = c(usr[1:2], 0, 1.5) )
    h <- hist(x, plot = FALSE)
    breaks <- h$breaks; nB <- length(breaks)
    y <- h$counts; y <- y/max(y)
    rect(breaks[-nB], 0, breaks[-1], y, col="blue4", ...)
    }
    panel.cor <- function(x, y, digits=2, prefix="", cex.cor)
    {
    usr <- par("usr"); on.exit(par(usr))
    par(usr = c(0, 1, 0, 1))
    r <- abs(cor(x, y, method = "spearman"))
    txt <- format(c(r, 0.123456789), digits=digits)[1]
    txt <- paste(prefix, txt, sep="")
    if(missing(cex.cor)) cex <- 0.8/strwidth(txt)
    text(0.5, 0.5, txt, cex = cex * r)
    }

    betterPairs <- function(YourData){
    return(pairs(YourData, lower.panel=function(...) {par(new=TRUE);ipanel.smooth(...)}, diag.panel=panel.hist, upper.panel=panel.cor))
    }

    x = rnorm(10000)
    betterPairs(data.frame(A = x, B = 0.6 * x + 0.3 * rnorm(10000), C = rnorm(10000)))

    panel.cor <- function(x, y, digits=2, prefix="", cex.cor)
    {
    usr <- par("usr"); on.exit(par(usr))
    par(usr = c(0, 1, 0, 1))
    r <- abs(cor(x, y, method = "spearman"))
    txt <- format(c(r, 0.123456789), digits=digits)[1]
    txt <- paste(prefix, txt, sep="")
    if(missing(cex.cor)) cex <- 0.8/strwidth(txt)
    text(0.5, 0.5, txt, cex = cex * r)
    }
    pairs(data, lower.panel=function(...)
    {par(new=TRUE);ipanel.smooth(..., nrpoints=0)}, diag.panel=panel.hist,
    upper.panel=panel.cor)
  4. florianhartig renamed this gist Jan 14, 2014. 1 changed file with 0 additions and 0 deletions.
    0 PimpedPairs → CorrelationDensityPlotWithIpanel
    View file
    File renamed without changes.
  5. florianhartig created this gist Jan 14, 2014.
    28 changes: 28 additions & 0 deletions PimpedPairs
    View file
    Original file line number Diff line number Diff line change
    @@ -0,0 +1,28 @@
    library(IDPmisc)
    library(psych)
    library(igraph)


    panel.hist <- function(x, ...)
    {
    usr <- par("usr"); on.exit(par(usr))
    par(usr = c(usr[1:2], 0, 1.5) )
    h <- hist(x, plot = FALSE)
    breaks <- h$breaks; nB <- length(breaks)
    y <- h$counts; y <- y/max(y)
    rect(breaks[-nB], 0, breaks[-1], y, col="blue4", ...)
    }

    panel.cor <- function(x, y, digits=2, prefix="", cex.cor)
    {
    usr <- par("usr"); on.exit(par(usr))
    par(usr = c(0, 1, 0, 1))
    r <- abs(cor(x, y, method = "spearman"))
    txt <- format(c(r, 0.123456789), digits=digits)[1]
    txt <- paste(prefix, txt, sep="")
    if(missing(cex.cor)) cex <- 0.8/strwidth(txt)
    text(0.5, 0.5, txt, cex = cex * r)
    }
    pairs(data, lower.panel=function(...)
    {par(new=TRUE);ipanel.smooth(..., nrpoints=0)}, diag.panel=panel.hist,
    upper.panel=panel.cor)