R/bi.bars.R

In frenchja/psych: Procedures for Psychological, Psychometric, and Personality Research

bi.bars <- function(x,grp,horiz,color,label=NULL,zero=FALSE,xlab,ylab,...) {
if(missing(horiz)) horiz <- TRUE
if(missing(color)) color <- c("blue","red")
if(horiz) {

  if(missing(xlab)) xlab <- "Frequency"
  if(missing(ylab)) ylab <- paste0(levels(grp))
  } else {
      if(missing(ylab)) ylab <- "Frequency"
      if(missing(xlab)) xlab <- paste0(levels(grp))}

groups <- table(grp)
max.val <- max(x,na.rm=TRUE)
min.val <- min(x,na.rm=TRUE)
#gr1 <- as.numeric(names(groups)[1])
#gr2 <- as.numeric(names(groups)[2])
gr1 <- (names(groups)[1])
gr2 <- (names(groups)[2])
g1 <- subset(x,grp==gr1)
g2 <- subset(x,grp==gr2)
t1 <-  tabulate(g1-min.val*zero,nbins=(max.val-min.val+1))
t2 <-  tabulate(g2-min.val*zero,nbins=(max.val-min.val+1)) 
#t1 <- table(g1-min.val*zero)
#t2 <- table(g2-min.val*zero)


m1 <- max(t1,t2)
m2 <- max(t1,t2)
xlim <- c(-m1,m2)*1.04
if(horiz) {
#t1 <- t1[t1 > 0]
xloc <- barplot(-t1,xlim=xlim,col=color[1],horiz=horiz,xlab=xlab,ylab=ylab,axes=FALSE,axisnames=FALSE,...)
barplot(t2,add=TRUE,col=color[2],horiz=horiz,axes=FALSE,axisnames=FALSE,...)
box()
if((max.val - min.val) < 10) {
if(is.null(label)) {axis(2,at=xloc+min.val*zero,labels=min.val:max.val,...)} else {
                    axis(2,at=xloc+min.val*zero,labels=label,las=2,...)}} else {
                    at <- axTicks(2,usr=c(min.val,max.val))
                    axis(2,at=at,labels=at + min.val*zero,las=2,...)}
atv <- axTicks(1)
axis(1,at=atv,labels=abs(atv),...)} else { #the vertical case
ylim <- c(-m1,m2)*1.04
xloc <- barplot(-t1,ylim=ylim,col=color[1],horiz=horiz,xlab=xlab,ylab=ylab,axes=FALSE,...)
barplot(t2 ,add=TRUE,col=color[2],horiz=horiz,axes=FALSE,...)
box()
atv <- axTicks(2)
axis(2,at=atv,labels=abs(atv),las=2,...)
if((max.val - min.val) < 10) {
if(is.null(label)) {axis(1,at=xloc,labels=min.val:max.val,...)} else {
     axis(1,at=xloc,labels=label,...)}
    } else {
    at <- axTicks(1,usr=c(min.val,max.val))
                    axis(1,at=at,labels=at+min.val*zero,...)
                    }}
}