#Function to generate an enhanced bannerplot of mona clustering from the original observations

monaplot=function(data=data,main = paste("Enhanced Bannerplot"), sub = NULL, xlab = "Separation step", col1 = c(1,colors()[501],0,gray(.85)), col2=c(gray(.4),colors()[498]),
 axes = TRUE, adj = 0, nmax.lab = 35, max.strlen = 5,border="white",textadj=0){
  #col1 requires specification of four colors in a vector, 1st is the color for level 0 of variables, 2nd is the color for level 1, 3rd is the background color - usually white, fourth is for the no split color (default is a light grey)
  #Note that categories can be switched for any variables by releveling the categorical variables in the original data set.
  #col2 contains the colors for the text related to the negative and positive responses indicated in the text, lighter shades of bar colors used so that large n cases can still be read
  #textadj is used for multi-panel plots where the text horizontal position is slightly off, positive values move the text to the left
                #Defaults to 0
  #border adds borders around bar segments, set border=0 if bars do not display due to large n. This is checked below but may vary by computer.
                
  #data contains just the variables used in the cluster analysis, all binary
  require(cluster)
  x=mona(data)       #x contains the solution from mona()
     #Sort the data set to make the plotting code more easily
  data1=data[x$order,]
  n=length(data1[,1])
  
  if (n>300) border=0   #Turns off the border for large n cases. If plot does not display on computer, set border=0 in function call

  x=mona(data1)                     #Order of data1 is from bottom to top of plot
  x$variableR=rev(x$variable)
  
  #Number of separation steps
  s1=max(x$step)+1

  w <- rev(x$step)
    m <- max(w)
    if(any(i0 <- w == 0)) w[i0] <- m <- m+1


    #Make the initial plot to get the dimensions set
    

    bannerplot(x[c("order","order.lab")], w = w, fromLeft = TRUE,
	       yaxRight = FALSE, col = c("white",0), main = main, sub = sub, xlab = xlab,
	       adj= adj, axes= axes, nmax.lab= 40, max.strlen= max.strlen,
	       xax.pretty = m+1,border=border)
    names <- paste(" ", rev(x$variable))
    is.na(names) <- i0

  ids=1:n
  wd1=wd2=w
  tpid1=(wd1<s1)
  breaks1=ids[tpid1]
  coltext=matrix(99,nrow=n,ncol=2)

  for (i in s1:2){ #Work backwards from right to left overplotting the first plot
     wd1=wd2=w
     tpid1=(wd1<i)
     wd1[tpid1]=0           #Plotting with wd1 will exclude rows not present this far out in plot
     wd1[wd1>=i]=i
     tpid2=(wd2==i-1)      #Get rows to find variables used in the different splits

     #identify variable being used for split and plot rows in colors based on its levels
     vars=x$variableR[tpid2]
     tsplitd=tsplitu=matrix(0,nrow=n,ncol=1)
     for (j in 1:length(vars)){
      tsplitd=tsplitu=matrix(0,nrow=n,ncol=1)
        #Find the rows that need to be dealt with in this column
        #Find central row for each split in this column
        cents=ids[tpid2] 
        breaks1=ids[tpid1]
        
        #Search down to next split
        if (sum(breaks1<cents[j])>0){
        p1=max(breaks1[breaks1<cents[j]])
        }
        if (sum(breaks1<cents[j])==0){
        p1=1
        }

        tsplitd[p1:cents[j]]=1
        #Plot at this point, zeroing length of every other row
        wp=wd1
        wp[tsplitd!=1]=0
        cold=(x$data[rev(wp)==i,colnames(x$data)==vars[j]])[1]

        if (cents[j]==1) {cold=x$data[n,vars[j]]}
        coltext[cents[j],]=c(vars[j],cold)
        if (is.na(cold))  coltext[cents[j],]=c(vars[j],x$data[n-cents[j]+1,vars[j]])
        bannerplot(x[c("order","order.lab")], w = wp, fromLeft = TRUE, yaxRight = FALSE, col = c(col1[cold+1],0),xlab="", adj= adj, axes=F,nmax.lab= nmax.lab, max.strlen= max.strlen, xax.pretty = m+1,border=border,add=T)


          
        #Search up to the next split
        if (sum(breaks1>cents[j])>0){
        p1=min(breaks1[breaks1>cents[j]])
        }
        if (sum(breaks1>cents[j])==0){
        p1=n-1
        }

        tsplitu[cents[j]:p1]=1
        wp=wd1
        wp[tsplitu!=1]=0
        cold=(((x$data[rev(wp)==i,colnames(x$data)==vars[j]]))[1])
        if (is.na(cold)) {cold=(((x$data[rev(wp)==i,colnames(x$data)==vars[j]]))[2])}


        bannerplot(x[c("order","order.lab")], w = wp, fromLeft = TRUE, yaxRight = FALSE, col = c(col1[cold+1],0),xlab="", adj= adj, axes=F,nmax.lab= nmax.lab, max.strlen= max.strlen, xax.pretty = m+1,border=border,add=T)

     }

     
        #Plot the two colors of the binary variable generating splits in this column
        #Clear out the rows to ignore
  }
        
 #Plot the first column in the selected color for no splits

 wd=rep(1,n-1)
    bannerplot(x[c("order","order.lab")], w = wd, fromLeft = TRUE,
	       yaxRight = FALSE, col = c(col1[4],0),xlab="",
	       adj= adj, axes=F,nmax.lab= nmax.lab, max.strlen= max.strlen,
	       xax.pretty = m+1,border=border,add=T)

 #Add text in the appropriate colors:
 #coltext contains the variable name and color code
 coltext[coltext==99]=NA

  text(w-textadj, 1:length(names) - 0.5, names, adj = 0, col = col2[as.numeric(coltext[,2])+1],lwd=2,vfont=c("serif","bold"))



#Pass the mona object back out of the function.
  return(x=x)


  }
  
