Itemset Graph

This is a working document, and may be updated from time to time.

From a course I was doing I wanted a out ring of categories (items) and a linked inner ring of the important combined entries (itemsets). Looking around there wasn’t a handy package that produced that exact look, so I thought I would write it in base R.

Job 1 - Can I make circles of circles

library(plotrix)
items <- data.frame(circleset = 1:20)
scaleValue=1000
items$x <- cos(pi * 1:nrow(items)/(0.5*nrow(items))) * scaleValue
items$y <- sin(pi * 1:nrow(items)/(0.5*nrow(items))) * scaleValue
plot(0, 0, type="n", xlim=c(-1.1 * scaleValue, 1.1 * scaleValue), ylim=c(-1.1 * scaleValue, 1.1 * scaleValue), xaxt="n", yaxt="n", frame.plot=FALSE, xlab="", ylab="")
nullReturn <- apply(items,1, function(x) draw.circle(x=as.integer(x[2]),y=as.integer(x[3]),radius=50, col="lightblue"))

plot of chunk unnamed-chunk-1

Yep, that works (providing the plot frame is square)

Now let’s try someitems with connectors

items <- data.frame(items=c("beer", "diaper", "milk", "apples", "durian"))
twoSet <- data.frame(itemseta = c("diaper", "apples", "beer"), itemsetb = c("beer", "milk","apples"), support = c(0.4, 0.3, 0.25))

scaleValue=1000
items$x <- cos(pi * 1:nrow(items)/(0.5*nrow(items))) * scaleValue
items$y <- sin(pi * 1:nrow(items)/(0.5*nrow(items))) * scaleValue
twoSet$x <- cos(pi * 1:nrow(twoSet)/(0.5*nrow(twoSet))) * scaleValue * 0.5
twoSet$y <- sin(pi * 1:nrow(twoSet)/(0.5*nrow(twoSet))) * scaleValue * 0.5

lineSet <- merge(twoSet, items, by.x="itemseta", by.y="items")
names(lineSet)[4:7] <- c("itemsetx", "itemsety", "sourceax", "sourceay")
lineSet <- merge(lineSet, items, by.x="itemsetb", by.y="items")
names(lineSet)[8:9]  <- c("sourcebx", "sourceby")

plot(0, 0, type="n", xlim=c(-1.1 * scaleValue, 1.1 * scaleValue), ylim=c(-1.1 * scaleValue, 1.1 * scaleValue), xaxt="n", yaxt="n", frame.plot=FALSE, xlab="", ylab="")

apply(lineSet,1, function(aline) lines(c(aline[6],aline[4]),c(aline[7],aline[5])))

## NULL

apply(lineSet,1, function(aline) lines(c(aline[8],aline[4]),c(aline[9],aline[5])))

## NULL

library(plotrix)
nullReturn <- apply(items,1, function(x) draw.circle(x=as.integer(x[2]),y=as.integer(x[3]),radius=100, col="lightblue"))
nullReturn <- apply(twoSet,1, function(x) draw.circle(x=as.integer(x[4]),y=as.integer(x[5]),radius=100, col="lightgreen"))
text(items$x,items$y, labels=items$items)
text(twoSet$x,twoSet$y, labels=twoSet$support)

Next I worked out adding a bunch of settings for the look:

putting an offset on the inner ring
text scale for the outer ring
inner ring colour

also adding:

coloured outside items
connector lines coloured by outside item
outside item circle size by support

#libraries
library(plotrix)

#example data
items <- data.frame(items=c("beer", "diaper", "milk", "apples", "durian"),support = c(0.6, 0.7, 0.4, 0.35, 0.1))
twoSet <- data.frame(itemseta = c("diaper", "apples", "beer"), itemsetb = c("beer", "milk","apples"), support = c(0.4, 0.3, 0.25))
#settings
scaleValue=1000 # overall size
innerOffset <- 0.15 #rotation applied to inner Ring
outerlabelScale <- 0.75 #scaler for text labels on outer ring
innerlabelScale <- 1 #scaler for text labels on inner ring
innerRingFill <- "#FFFFFF" #colour of inner itemsets fill
innerRingBorder <- "#000000" #colour of inner itemsets border
outerRingMinRadius <- 120
outerRingMaxRadius <- 200
innerRingMinRadius <- 120
innerRingMaxRadius <- 200
innerRingPosition <- 500 # how far out the inner ring is

#setup calculations
items$x <- cos(pi * 1:nrow(items)/(0.5*nrow(items))) * scaleValue
items$y <- sin(pi * 1:nrow(items)/(0.5*nrow(items))) * scaleValue
twoSet$x <- cos(pi * (1:nrow(twoSet)/(0.5*nrow(twoSet)) + innerOffset)) * innerRingPosition
twoSet$y <- sin(pi * (1:nrow(twoSet)/(0.5*nrow(twoSet)) + innerOffset)) * innerRingPosition
grayness <- 0:nrow(items)/nrow(items)
items$colours <- grayness[1:(length(grayness) -1)]
                 

#merging and name control
lineSet <- merge(twoSet, items, by.x="itemseta", by.y="items")
names(lineSet)[3:9] <- c("itemsetSupport", "itemsetX", "itemsetY", "itemASupport", "itemAX", "itemAY", "itemAcolours")
lineSet <- merge(lineSet, items, by.x="itemsetb", by.y="items")
names(lineSet)[10:13]  <- c("itemBSupport", "itemBX", "itemBY", "itemBcolours")

#the plot area
plot(0, 0, type="n", xlim=c(-1.1 * scaleValue, 1.1 * scaleValue), ylim=c(-1.1 * scaleValue, 1.1 * scaleValue), xaxt="n", yaxt="n", frame.plot=FALSE, xlab="", ylab="")

#connector lines first, in background
apply(lineSet,1, function(aline) lines(c(aline[7],aline[4]),c(aline[8],aline[5]), col=gray(aline[9])))

## NULL

apply(lineSet,1, function(aline) lines(c(aline[11],aline[4]),c(aline[12],aline[5]), col=gray(aline[13])))

## NULL

#outerRing
items$radius <- items$support* (outerRingMaxRadius - outerRingMinRadius) + outerRingMinRadius
nullReturn <- apply(items,1, function(x) draw.circle(x=as.integer(x[3]),y=as.integer(x[4]),radius=as.integer(x[6]), col=gray(x[5]), border="white", lwd=2))

#innerRing
twoSet$radius <- twoSet$support * (innerRingMaxRadius - innerRingMinRadius) + innerRingMinRadius
nullreturn <- apply(twoSet,1, function(x) draw.circle(x=as.integer(x[4]),y=as.integer(x[5]), radius=as.integer(x[6]), col="white", border="black", lwd=2))

#outerRinglabels
items$textcolour <- items$colours - 0.5
items$textcolour[items$colours < 0.5] <- items$textcolour[items$colours < 0.5] + 1
text(items$x,items$y, labels=paste(items$items,items$support,sep="\n"), col= gray(items$textcolour), cex=outerlabelScale)

#innerRinglabels
text(twoSet$x,twoSet$y, labels=twoSet$support,col= "black", cex=innerlabelScale)

plot of chunk unnamed-chunk-3