#
# Per scaricare ed uare il programma vai qui. Poi prosegui
#
# INIZIO dell'"algoritmo" per tracciare un istogramma 3d di dati già classificati.
# Queste righe, fino a "Fine", vanno messe una sola volta. Vedi gli esempi
# successivi per il suo uso.
isto3D <- function(tabella,theta,phi,box) {
es <- 1; r <- dim(tabella)[1]; c <- dim(tabella)[2]
z1 <- tabella; fr <- array(0,dim=c(r,c)); x1 <- seq(1,r,1); x2 <- seq(1,c,1)
if (floor(theta)!=theta) {es <- theta-floor(theta); theta <- floor(theta)}
ax <- FALSE; if(trunc(box)==1) ax <- "TRUE"; t <- theta; p <- phi; box=1-(box-trunc(box))
pr <- persp(x1,x2,fr,theta=t,phi=p,zlim=c(0,max(z1)),xlim=c(0,r+1),ylim=c(0,c+1),border="white",box=ax,expand=es)
title(paste("max ",max(z1),sep=""),cex.main=0.8) # c("max",max(z1)))
co <- function(m) switch(m-trunc(m/3)*3+1,"green3","black","red") # colore dei "tetti"; se vuoi cambia
col <- "blue"; if (floor(phi)!=phi) col <- "white"
# segmento (a1,b1,c1)-(a2,b2,c2)
segm <- function(a1,a2,b1,b2,c1,c2,co) lines(trans3d(c(a1,a2),c(b1,b2),c(c1,c2),pmat=pr),col=co)
ppd <- function(i,j,f,co) {
segm(i-1/2*box,i-1/2*box,j-1/2*box,j-1/2*box,0,f,co); segm(i+1/2*box,i+1/2*box,j-1/2*box,j-1/2*box,0,f,co)
segm(i-1/2*box,i-1/2*box,j+1/2*box,j+1/2*box,0,f,co); segm(i+1/2*box,i+1/2*box,j+1/2*box,j+1/2*box,0,f,co) }
ppd2 <- function(i,j,f,co) {
segm(i-1/2*box,i+1/2*box,j+1/2*box,j+1/2*box,f,f,co); segm(i-1/2*box,i+1/2*box,j-1/2*box,j-1/2*box,f,f,co)
segm(i+1/2*box,i+1/2*box,j+1/2*box,j-1/2*box,f,f,co); segm(i-1/2*box,i-1/2*box,j+1/2*box,j-1/2*box,f,f,co) }
if (box != .99) {
for(x in 1:r) for(y in 1:c) ppd2(x,y,fr,"blue")
if (col == "blue") for(x in 1:r) for(y in 1:c) ppd(x,y,z1[x,y],col)
for(x in 1:r) for(y in 1:c) ppd2(x,y,z1[x,y],co(x))} else {
for(x in 1:r) for(y in 1:(c-1)) segm(x,x,y,y+1,z1[x,y],z1[x,y+1],co(x))
for(y in 1:c) for(x in 1:(r-1)) segm(x,x+1,y,y,z1[x,y],z1[x+1,y],col)} }
# FINE algoritmo
#
# Esempio. Una tabella di frequenze:
#
# 117 66
# 526 166
# 768 518
#
# e la sua memorizzazione, colonna per colonna:
u <- c(117,526,768,66,166,518); x <- 3; y <- 2
edit(array(u,dim=c(x,y)))
col1 col2
[1,] 117 66
[2,] 526 166
[3,] 768 518
tab <- array(u,dim=c(x,y))
tab
[,1] [,2]
[1,] 117 66
[2,] 526 166
[3,] 768 518
dim(tab)
[1] 3 2
# L'istogramma di distribuzione (dei dati qui memorizzati in tab) con theta=-50 e phi=30;
# l'ultimo parametro, 1, indica di tracciare il box.
# Per ridurre lo spazio bianco posso premettere par( mai=c(0,0,0.4,0) )
isto3D(tab,-50,30,1)
# Con l'ultimo parametro uguale a 0 non è tracciato il box
dev.new(); isto3D(tab,-50,30,0)
# L'istogramma da un altro punto di vista:
dev.new(); isto3D(tab,230,35,0)
# Se all'ultimo parametro aggiungo .d (es.: .3) le colonne vengono
# tracciate più piccole, ridotte di d/10 (3/10)
dev.new(); isto3D(tab,245,40,1.3)
dev.new(); isto3D(tab,245,40,0.4)
# L'ultimo istogramma è stato salvato in Paint e poi colorato.
# L'estrazione della prima colonna
a <- tabella[,1]; a
[1] 117 526 768
# La sua rappresentazione grafica, con i dati assoluti e con
# le percentuali
barplot(a); dev.new(); barplot(a/sum(a))
# La matrice "trasposta" (scambio righe con colonne)
t(tab)
[,1] [,2] [,3]
[1,] 117 526 768
[2,] 66 166 518
#
# Volendo puoi rappresentare invece di un istogramma una "poligonale".
# Basta che metti come "box" 1.01 (o 0.01). Ecco un esempio.
v <- c(70,100,400,117,526,750,66,166,518,50,100,350,40,95,350); x <- 3; y <- 6
tab2 <- array(v,dim=c(x,y))
dev.new(); isto3D(tab2,300,20,1.3)
dev.new(); isto3D(tab2,300,20,1.01)
#
# Volendo posso scalare verticalmente l'istogramma: se aggiungo .s a theta
# l'asse z viene rappresentato più corto, moltiplicato per 0.s:
dev.new(); isto3D(tab2,300.4,20,1.3)
dev.new(); isto3D(tab2,300.4,20,1.01)
#
# Ecco la distribuzione teorica delle coppie di uscite di due dadi equi
dadi <- NULL; for(i in 1:6) for(j in 1:6) dadi <- c(dadi,1)
dati <- array(dadi,dim=c(6,6)); dati
isto3D(dati,0.6,35,0.5)
#
# Se nell'indicare "phi" uso un numero non intero, ottengo solo i "tetti"
isto3D(dati,0.6,35.1,0.2)
# La rappresentazione a destra l'ottengo con:
isto3D(dati,0.6,35,1.01)