r - likert plot showing percentage values -
below, have r code plots likert plot.
set.seed(1234) library(e1071) probs <- cbind(c(.4,.2/3,.2/3,.2/3,.4),c(.1/4,.1/4,.9,.1/4,.1/4),c(.2,.2,.2,.2,.2)) my.n <- 100 my.len <- ncol(probs)*my.n raw <- matrix(na,nrow=my.len,ncol=2) raw <- null for(i in 1:ncol(probs)){ raw <- rbind(raw, cbind(i,rdiscrete(my.n,probs=probs[,i],values=1:5))) } r <- data.frame( cbind( as.numeric( row.names( tapply(raw[,2], raw[,1], mean) ) ), tapply(raw[,2], raw[,1], mean), tapply(raw[,2], raw[,1], mean) + sqrt( tapply(raw[,2], raw[,1], var)/tapply(raw[,2], raw[,1], length) ) * qnorm(1-.05/2,0,1), tapply(raw[,2], raw[,1], mean) - sqrt( tapply(raw[,2], raw[,1], var)/tapply(raw[,2], raw[,1], length) ) * qnorm(1-.05/2,0,1) )) names(r) <- c("group","mean","ll","ul") gbar <- tapply(raw[,2], list(raw[,2], raw[,1]), length) sgbar <- data.frame( cbind(c(1:max(unique(raw[,1]))),t(gbar)) ) sgbar.likert<- sgbar[,2:6] require(grid) require(lattice) require(latticeextra) require(hh) sgbar.likert<- sgbar[,2:6] ylabels = c(expression(a[1*x]),expression(b[2*x]),expression(c[3*x])) likert(sgbar.likert, scales = list(y = list(labels = ylabels)), xlab="percentage", main="example diverging stacked bar chart likert scale", brewerpalettename="blues", sub="likert scale") that looks below. however, want show percentage value of each category shown in below picture.
i have tried this:
likert(sgbar.likert, scales = list(y = list(labels = ylabels)), xlab="percentage", main="example diverging stacked bar chart likert scale", brewerpalettename="blues", plot.percent.low=true, # added 1 plot.percent.high=true, # added one, sub="likert scale") but, not have affect , not make differences.
so, how show percentage values each category?
afaik there isn't parameter achieve that, need define custom panel function, in way :
### reproduce input library(hh) sgbar.likert <- data.frame(x1 = c(34l, 7l, 13l),x2 = c(1l, 4l, 13l), x3 = c(7l, 84l, 24l), x4 = c(7l, 2l, 27l), x5 = c(51l, 3l, 23l)) ylabels = c(expression(a[1*x]),expression(b[2*x]),expression(c[3*x])) ### # store original col names used in custom panel function orignames <- colnames(sgbar.likert) # define custom panel function mypanelfunc <- function(...){ panel.likert(...) vals <- list(...) df <- data.frame(x=vals$x, y=vals$y, groups=vals$groups) ### convoluted calculations here... grps <- as.character(df$groups) for(i in 1:length(orignames)){ grps <- sub(paste0('^',orignames[i]),i,grps) } df <- df[order(df$y,grps),] df$correctx <- ave(df$x,df$y,fun=function(x){ x[x < 0] <- rev(cumsum(rev(x[x < 0]))) - x[x < 0]/2 x[x > 0] <- cumsum(x[x > 0]) - x[x > 0]/2 return(x) }) subs <- sub(' positive$','',df$groups) collapse <- subs[-1] == subs[-length(subs)] & df$y[-1] == df$y[-length(df$y)] df$abs <- abs(df$x) df$abs[c(collapse,false)] <- df$abs[c(collapse,false)] + df$abs[c(false,collapse)] df$correctx[c(collapse,false)] <- 0 df <- df[c(true,!collapse),] df$perc <- ave(df$abs,df$y,fun=function(x){x/sum(x) * 100}) ### panel.text(x=df$correctx, y=df$y, label=paste0(df$perc,'%'), cex=0.7) } # plot passing our custom panel function likert(sgbar.likert, scales = list(y = list(labels = ylabels)), xlab="percentage", main="example diverging stacked bar chart likert scale", brewerpalettename="blues", panel=mypanelfunc, sub="likert scale") 
the code pretty convoluted, key panel function receives, (in ellipsis ... parameter), x,y pair of coordinates each bar , group factor each of them (groups columns of original likert input). default panel function panel.likert; so, after calling that, can add our changes plotted panel (in case labels according bars coordinates).
seems easy, there 2 problems :
- groups redefined when even, central column, in case
"x3"it's split in 2 groups:"x3","x3 positive". - plotted bars "stacked", correctly compute centers of them (in order put label) need calculate cumulated sum of coordinates, using original column names ordering.
the above code calculations, in quite generic manner (read: can change input , should work...).
Comments
Post a Comment