# [R] regarding 3d Bar Plot

Duncan Murdoch murdoch at stats.uwo.ca
Wed Apr 25 15:15:56 CEST 2007

```On 4/25/2007 7:56 AM, gyadav at ccilindia.co.in wrote:
> Hi Duncan
>
> I am restating the problem and thanks you for sending me such a good
> function histogram in 3d. Thanks for that but i think my problem has been
> misinterpreted. I just wanted a simple 3d bar Plot. Although I have not
> written anything for R but i will surely like to contribute to R and if i
> can assist someone in writing then it would be a great help to me.
>
> Problem was :-)
>
> I have data in a two dimensional table. each row of the data adds upto 100
>
> ( hence they are percentages ).
> it can be interpreted as like this A - I are the matches and  P - X are
> the players. Thus Player P scored 20% of the runs during this season in
> Match C, 60% in Match D and remaining 20% in Match G.
>
> I want to plot 3-d bar plot, where X axis have players, Y axis have
> Matches and Z axis as the percentage(0 - 100%)
> are not there instead alphabets)

The plot.histogram function I sent does most of what you want.  The
hist3d function calculates the matrix of counts that it plots, and
plot.histogram plots the resulting bar chart.

Duncan Murdoch

>
>         A       B       C       D       E       F       G       H       I
> P       0       0       20      60      0       0       20      0       0
> Q       0       16.86747        26.907631       11.646586       0
> 12.449799       0.8032129       0       31.325301
> R       0       59.649123       10.526316       12.280702       0       0
> 1.754386        0       15.789474
> S       3.57909807      20.281556       33.404915       7.31329 0.584586
> 5.965163        1.1930327       0       27.678358
> T       0       0       0       0       0       0       0       0       0
> U       0       9.090909        27.272727       18.181818       0
> 36.363636       0       0       9.090909
> V       0       33.333333       33.333333       0       0       33.333333
> 0       0       0
> W       0       2.188184        1.094092        36.105033       0
> 44.420131       5.2516411       0       10.940919
> X       0.05994234      51.550409       16.304315       6.997668        0
> 17.383277       0.5994234       0.4741439       6.630821
>
>
>
> -gaurav
>
>
>
>
> Duncan Murdoch <murdoch at stats.uwo.ca>
> 25-04-07 04:42 PM
>
> To
> rolf at math.unb.ca
> cc
> gyadav at ccilindia.co.in, r-help at stat.math.ethz.ch
> Subject
> Re: [R] regarding 3d Bar Plot
>
>
>
>
>
>
> On 4/24/2007 9:38 AM, rolf at math.unb.ca wrote:
>>
>>> I have data in a two dimensional table. each row of the data adds
>>> upto 100 ( hence they are percentages ).  it can be interpreted as
>>> like this A - I are the matches and  P - X are the players. Thus
>>> Player P scored 20% of the runs during this season in Match C, 60% in
>>> Match D and remaining 20% in Match G.
>>>
>>> I want to plot 3-d bar plot, where X axis have players, Y axis have
>>> regards.
>>          <snip>
>>
>>                Many years ago I picked up from the snews mailing list a
>>                suite of functions for plotting 2D barplots (barplots
> with 2D
>>                bases) written by a chap named Colin Goodall, from (at
> that
>>                time) the University of Bristol and/or from Penn State.
>>
>>                I never actually did anything with this suite until
>>                recently.  Seeing no replies to the enquiry about 3D
>>                histograms,  I thought I'd try to get Goodal's code
> running
>>                in R to see if it might solve guarav's problem.
>>
>>                The trouble is, all the guts of the procedure,
> *including*
>>                the plotting are done from within Fortran.  The actual
>>                plotting seems to be done through a call to a subroutine
>>                ``segmtz'' which is a piece of Splus software that does
> not
>>                exist in R.
>>
>>                Is there an equivalent subroutine in R that could be
> called?
>>                I dug around a bit but couldn't figure out what was going
>>                on.  The function segments() simply calls
>>                .Internal(segments(....
>>
>>                I looked around a bit for corresponding C or Fortran code
> but
>>                obviously didn't know how to look properly.
>>
>>                I think that the Fortran code could be translated into
> raw R
>>                and the call to segmtz changed to a call to segments()
> ---
>>                but this would seem to be a lot of work.
>>
>>                Can anyone suggest a reasonably simple way of replacing
> the
>>                call to segmtz in the Fortran?
>
> I don't know how to do what you want, but I'd suggest working in R code
> rather than Fortran.  I did write a hist3d function for the djmrgl
> package (based on hist), mostly to show off the graphics, but haven't
> found it useful enough to port to rgl.  Here's a quick port, not good
> enough to use, but maybe it will give you a starting point.
>
> Duncan Murdoch
>
>
>
>
> hist3d <-
>     function (x, y, xbreaks, ybreaks, freq= NULL, probability = !freq,
> include.lowest= TRUE,
>               right= TRUE,
>               xlim = range(xbreaks), ylim = range(ybreaks), zlim = NULL,
>               xlab = xname, ylab = yname, zlab,
>               plot = TRUE, top = TRUE, nclass = NULL, ...)
> {
>     if (!is.numeric(x) | !is.numeric(y))
>         stop("`x' and `y' must be numeric")
>     xname <- deparse(substitute(x))
>     yname <- deparse(substitute(y))
>     n <- length(x <- x[!is.na(x)])
>     use.xbr <- !missing(xbreaks)
>     if(use.xbr) {
>         if(!missing(nclass))
>             warning("`nclass' not used when `xbreaks' specified")
>     }
>     else if(!is.null(nclass) && length(nclass) == 1)
>         xbreaks <- nclass
>     use.xbr <- use.xbr && (nB <- length(xbreaks)) > 1
>     if(use.xbr)
>         xbreaks <- sort(xbreaks)
>     else {                              # construct vector of breaks
>         rx <- range(x)
>         nnb <-
>             if(missing(xbreaks)) 1 + log2(n)
>             else {                      # breaks = `nclass'
>                 if (is.na(xbreaks) | xbreaks < 2)
>                     stop("invalid number of xbreaks")
>                 xbreaks
>             }
>         xbreaks <- pretty (rx, n = nnb, min.n=1, eps.corr = 2)
>                  }
>     nxB <- length(xbreaks)
>     if(nxB <= 1) ##-- Impossible !
>     stop(paste("hist3d: error, xbreaks=",format(xbreaks)))
>
>     storage.mode(x) <- "double"
>     storage.mode(xbreaks) <- "double"
>         use.ybr <- !missing(ybreaks)
>         if(use.ybr) {
>             if(!missing(nclass))
>                 warning("`nclass' not used when `ybreaks' specified")
>         }
>         else if(!is.null(nclass) && length(nclass) == 1)
>             ybreaks <- nclass
>         use.ybr <- use.ybr && (nB <- length(ybreaks)) > 1
>         if(use.ybr)
>             ybreaks <- sort(ybreaks)
>         else {                              # construct vector of breaks
>             ry <- range(y)
>             nnb <-
>                 if(missing(ybreaks)) 1 + log2(n)
>                 else {                      # breaks = `nclass'
>                     if (is.na(ybreaks) | ybreaks < 2)
>                         stop("invalid number of ybreaks")
>                     ybreaks
>                 }
>             ybreaks <- pretty (ry, n = nnb, min.n=1, eps.corr = 2)
>                                  }
>         nyB <- length(ybreaks)
>         if(nyB <= 1) ##-- Impossible !
>         stop(paste("hist3d: error, ybreaks=",format(ybreaks)))
>
>         storage.mode(y) <- "double"
>     storage.mode(ybreaks) <- "double"
>     counts <- table(cut(x,xbreaks),cut(y,ybreaks))
>     if (sum(counts) < n)
>         stop("some data not counted; maybe breaks do not span range of
> data")
>     xh <- diff(xbreaks)
>     if (!use.xbr && any(xh <= 0))
>         stop("not strictly increasing `xbreaks'.")
>     yh <- diff(ybreaks)
>     if (!use.ybr && any(yh <= 0))
>         stop("not strictly increasing `ybreaks'.")
>     if (is.null(freq)) {
>         freq <- if(!missing(probability))
>             !as.logical(probability)
>         else if(use.xbr | use.ybr) {
>             ##-- Do frequencies if breaks are evenly spaced
>             (max(xh)-min(xh) < 1e-7 * mean(xh)) &  (max(yh)-min(yh) < 1e-7
> * mean(yh))
>         } else TRUE
>     } else if(!missing(probability) && any(probability == freq))
>         stop("`probability' is an alias for `!freq', however they
> differ.")
>     density <- counts/(n*outer(xh,yh))
>     xmids <- 0.5 * (xbreaks[-1] + xbreaks[-nxB])
>     ymids <- 0.5 * (ybreaks[-1] + ybreaks[-nyB])
>     equidist <- (!use.xbr & !use.ybr) || (diff(range(xh)) < 1e-7 *
> mean(yh)) & (diff(range(yh)) < 1e-7 * mean(yh))
>     r <- structure(list(xbreaks = xbreaks, ybreaks = ybreaks, counts =
> counts,
>                         intensities = density,
>             density = density, xmids = xmids, ymids = ymids,
>                         xname = xname, yname = yname, equidist =
> equidist),
>                    class="histogram3d")
>     if (plot) {
>         plot(r, freq = freq,
>              xlim = xlim, ylim = ylim, zlim = zlim, xlab = xlab, ylab =
> ylab, zlab = zlab,
>                                                   top = top, ...)
>         invisible(r)
>     }
>     else r
> }
>
> plot.histogram3d <-
>     function (x, freq = equidist, col = 'gray', rgb = col,
>               main = paste("Histogram of", x\$xname, "and", x\$yname),
>               xlim = range(x\$xbreaks), ylim = range(x\$ybreaks), zlim =
> NULL,
>               xlab = x\$xname, ylab = x\$yname, zlab,
>               axes = TRUE, box = TRUE, add = FALSE,
>                                                    top = TRUE, ...)
> {
>     save <- par3d(skipRedraw = TRUE, ...)
>     on.exit(par3d(save))
>
>     equidist <- x\$equidist
>     if(freq && !equidist)
>         warning("the AREAS in the plot are wrong -- rather use
> `freq=FALSE'!")
>
>     z <- if (freq) x\$counts else x\$density
>     nxB <- length(x\$xbreaks)
>     nyB <- length(x\$ybreaks)
>
>     if(is.null(z) || 0 == nxB || 0 == nyB) stop("`x' is wrongly
> structured")
>
>                  rgb <- matrix(rgb,nxB-1,nyB-1)
>     for (i in 1:(nyB-1)) {
>         keep <- z[,i] > 0
> x\$xbreaks[-1], x\$xbreaks[-nxB])[keep,])),
>
> as.double(t(cbind(rep(x\$ybreaks[i],nxB-1),rep(x\$ybreaks[i],nxB-1),rep(x\$ybreaks[i+1],nxB-1),rep(x\$ybreaks[i+1],nxB-1))[keep,])),
>                 as.double(t(cbind(z[,i],z[,i],z[,i],z[,i])[keep,])),
>                 col = t(cbind(rgb[,i],rgb[,i],rgb[,i],rgb[,i])[keep,]))
> x\$xbreaks[-1], x\$xbreaks[-nxB])[keep,])),
>                 as.double(rep(rep(x\$ybreaks[i],(nxB-1))[keep],4)),
>                 as.double(t(cbind(rep(0,nxB-1),    rep(0,nxB-1),  z[,i],
>  z[,i])[keep,])),
>                                                                  col =
> t(cbind(rgb[,i],rgb[,i],rgb[,i],rgb[,i])[keep,]))
> x\$xbreaks[-1], x\$xbreaks[-nxB])[keep,])),
>                 as.double(rep(rep(x\$ybreaks[i+1],(nxB-1))[keep],4)),
>                 as.double(t(cbind(rep(0,nxB-1),    rep(0,nxB-1),  z[,i],
>  z[,i])[keep,])),
>                                                                  col =
> t(cbind(rgb[,i],rgb[,i],rgb[,i],rgb[,i])[keep,]))
> x\$xbreaks[-nxB], x\$xbreaks[-nxB])[keep,])),
>
> as.double(t(cbind(rep(x\$ybreaks[i],nxB-1),rep(x\$ybreaks[i+1],nxB-1),rep(x\$ybreaks[i+1],nxB-1),rep(x\$ybreaks[i],nxB-1))[keep,])),
>                 as.double(t(cbind(rep(0,nxB-1),    rep(0,nxB-1),  z[,i],
>  z[,i])[keep,])),
>                 col = t(cbind(rgb[,i],rgb[,i],rgb[,i],rgb[,i])[keep,]))
> x\$xbreaks[-1], x\$xbreaks[-1])[keep,])),
>
> as.double(t(cbind(rep(x\$ybreaks[i],nxB-1),rep(x\$ybreaks[i+1],nxB-1),rep(x\$ybreaks[i+1],nxB-1),rep(x\$ybreaks[i],nxB-1))[keep,])),
>                 as.double(t(cbind(rep(0,nxB-1),    rep(0,nxB-1),  z[,i],
>  z[,i])[keep,])),
>                                                                  col =
> t(cbind(rgb[,i],rgb[,i],rgb[,i],rgb[,i])[keep,]))
>     }
>         if(is.null(zlim))
>             zlim <- range(z, 0)
>         if (missing(zlab))
>             zlab <- if (!freq) "Density" else "Frequency"
>         title3d(main = main, xlab = xlab, ylab = ylab, zlab = zlab)
>         if(axes) {
>            axes3d()
>         }
>         if(box) {
>            box3d()
>         }
>     }
>                  if (top) rgl.bringtotop()
>                  invisible()
> }
>
>
> ============================================================================================
> DISCLAIMER AND CONFIDENTIALITY CAUTION:
>
> This message and any attachments with it (the "message") are confidential and intended