This package does one thing: create symmetric matrices from asymmetric matrices. It is inspired by This tweet.
The basic idea is that you fold your matrix across the diagonal to create a symmetric matrix like an inkblot for a Rorschach test.
There is only one function called blot()
.
library("blotr")
set.seed(20160325)
mat <- matrix(sample(c(NA, 1), 100, replace = TRUE), 10, 10)
diag(mat) <- 0
mat
#> [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
#> [1,] 0 1 NA 1 NA 1 NA NA NA 1
#> [2,] 1 0 1 1 1 NA 1 1 NA NA
#> [3,] NA NA 0 1 1 1 NA NA NA NA
#> [4,] NA 1 1 0 NA 1 NA 1 1 1
#> [5,] NA 1 NA NA 0 NA 1 NA NA NA
#> [6,] 1 NA 1 NA 1 0 1 1 NA 1
#> [7,] 1 1 NA NA 1 1 0 1 1 1
#> [8,] NA NA 1 1 NA 1 NA 0 1 NA
#> [9,] 1 1 1 NA NA 1 NA NA 0 NA
#> [10,] 1 1 NA 1 NA NA 1 NA 1 0
isSymmetric(mat)
#> [1] FALSE
The matrix is non-symmetrical! We'll make it symmetrical with blot()
!
blot(mat)
#> [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
#> [1,] 0 1 NA 1 NA 1 1 NA 1 1
#> [2,] 1 0 1 1 1 NA 1 1 1 1
#> [3,] NA 1 0 1 1 1 NA 1 1 NA
#> [4,] 1 1 1 0 NA 1 NA 1 1 1
#> [5,] NA 1 1 NA 0 1 1 NA NA NA
#> [6,] 1 NA 1 1 1 0 1 1 1 1
#> [7,] 1 1 NA NA 1 1 0 1 1 1
#> [8,] NA 1 1 1 NA 1 1 0 1 NA
#> [9,] 1 1 1 1 NA 1 1 1 0 1
#> [10,] 1 1 NA 1 NA 1 1 NA 1 0
isSymmetric(blot(mat))
#> [1] TRUE
We can also choose to keep only the upper triangle if we wish:
blot(mat, ut = TRUE)
#> [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
#> [1,] 0 1 NA 1 NA 1 1 NA 1 1
#> [2,] NA 0 1 1 1 NA 1 1 1 1
#> [3,] NA NA 0 1 1 1 NA 1 1 NA
#> [4,] NA NA NA 0 NA 1 NA 1 1 1
#> [5,] NA NA NA NA 0 1 1 NA NA NA
#> [6,] NA NA NA NA NA 0 1 1 1 1
#> [7,] NA NA NA NA NA NA 0 1 1 1
#> [8,] NA NA NA NA NA NA NA 0 1 NA
#> [9,] NA NA NA NA NA NA NA NA 0 1
#> [10,] NA NA NA NA NA NA NA NA NA 0
Let's generate some inkblots and visualize them:
set.seed(20160326)
mat <- matrix(NA_integer_, 100, 100)
x <- replicate(10, rnorm(250, mean = sample((3:7)*10, 1), 5))
y <- replicate(10, rnorm(250, mean = sample((3:7)*10, 1), 5))
obs <- matrix(round(c(x, y)), ncol = 2)
mat[obs] <- 1L
diag(mat) <- 0L
isSymmetric(mat)
#> [1] FALSE
Now for the plotting. First, the without blotting:
robs <- range(obs)/100
fx <- seq(0, 1, length.out = 100)
omar <- par("mar")
par(mar = c(0, 0, 0, 0))
plot(NA, xlim = robs, ylim = robs, type = "n", asp = 1, ann = FALSE, axes = FALSE)
.filled.contour(fx, fx, mat, c(0, 1), col = "black")
par(mar = omar)
Now, with blotting:
par(mar = c(0, 0, 0, 0))
plot(NA, xlim = robs, ylim = robs, type = "n", asp = 1, ann = FALSE, axes = FALSE)
.filled.contour(fx, fx, blot(mat), c(0, 1), col = "black")
par(mar = omar)
You can install blotr via devtools::
devtools::install_github("zkamvar/blotr")
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.