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%)
Please help me in this regards. (Please note on my X and Y axes Numbers
are not there instead alphabets)
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
Thanks in advance
-gaurav
Duncan Murdoch <[EMAIL PROTECTED]>
25-04-07 04:42 PM
To
[EMAIL PROTECTED]
cc
[EMAIL PROTECTED], [email protected]
Subject
Re: [R] regarding 3d Bar Plot
On 4/24/2007 9:38 AM, [EMAIL PROTECTED] wrote:
> [EMAIL PROTECTED] 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
>> Matches and Z axis as the percentage(0 - 100%) Please help me in this
>> 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, ...)
{
if (!add) clear3d()
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
quads3d(as.double(t(cbind(x$xbreaks[-nxB], x$xbreaks[-1],
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,]))
quads3d(as.double(t(cbind(x$xbreaks[-nxB], x$xbreaks[-1],
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,]))
quads3d(as.double(t(cbind(x$xbreaks[-nxB], x$xbreaks[-1],
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,]))
quads3d(as.double(t(cbind(x$xbreaks[-nxB], x$xbreaks[-nxB],
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,]))
quads3d(as.double(t(cbind(x$xbreaks[-1], x$xbreaks[-1],
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(!add) {
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 ...{{dropped}}
______________________________________________
[email protected] mailing list
https://stat.ethz.ch/mailman/listinfo/r-help
PLEASE do read the posting guide http://www.R-project.org/posting-guide.html
and provide commented, minimal, self-contained, reproducible code.
