AppA.R
In labstatR: Libreria Del Laboratorio Di Statistica Con R

#-*- R -*-

##########################################################
###                                                    ###
### Script tratti da `Laboratorio di statistica con R' ###
###                                                    ###
###          Stefano M. Iacus & Guido Masaratto        ###
###                                                    ###
### APPENDICE A                                        ###
##########################################################

require(labstatR)
require(xtable)

### Sez A.3.1 SPESSORE, COLORE E TIPO DI TRATTO
load("dati1.rda")
plot(table(dati$Z), main = "lwd=1")
plot(table(dati$Z),lwd=10, main = "lwd=10")

str(colors())
palette()

plot(1,type="n")
abline(h=0.6, lty=2)
abline(h=0.8, lty=3)
abline(h=0.9, lty=4)
abline(h=1.2, lty=5)
abline(h=1.4, lty=6)

par(mfrow=c(4,2))
plot(dati$Z)
plot(dati$Z,type="l",main="type=\"l\"")
plot(dati$Z,type="b",main="type=\"b\"")
plot(dati$Z,type="c",main="type=\"c\"")
plot(dati$Z,type="o",main="type=\"o\"")
plot(dati$Z,type="h",main="type=\"h\"")
plot(dati$Z,type="s",main="type=\"s\"")
plot(dati$Z,type="S",main="type=\"S\"")
par(mfrow=c(1,1))

### Sez A.3.2 TITOLI, SOTTOTITOLI E ASSI
x <- c(1,2,5,9,10,11)
y <- c(1,7,5,4,3,1)
plot(x,y, main="Titolo", sub="sottotitolo", ylab="valori di y")

plot(x,y, main="Titolo", sub="sottotitolo", axes=FALSE,  xlab="numeri ics")
axis(2)
axis(1,x,c("uno","due","cinque","nove", "dieci","undici"))

### Sez A.3.3 AGGIUNGERE TESTO E FORMULE AI GRAFICI
x <- c(1,2,5,9,10,11)
y <- c(1,7,5,4,3,1)
plot(x,y)
abline(lm(y~x),lty=3)
text(4,3,"La retta di regressione")
text(6,4,expression(y[i]==hat(beta)[0]+hat(beta)[1]*x))

plot(1, main="Allineamento del testo")
text(1,0.8,"ciao",adj=0)  # sinistra
text(1,0.9,"ciao",adj=0.5) # centro
text(1,1.1,"ciao",adj=1)  # destra
abline(v=1,lty=3)

plot(1:10, main="La funzione mtext")
mtext("in basso", side=1)
mtext("a destra", side=2)
mtext("in alto", side=3)
mtext("a sinistra", side=4)

### Sez A.3.4 LE LEGENDE
curve(dnorm(x),-5,5,lty=3)
curve(dt(x,df=1),-5,5,add=TRUE)
legend(-4.5,0.3,legend=c("normale","t Student"),lty=c(1,3))

x <- c(1,2,5,9,10,11)
y <- c(1,7,5,4,3,1)
z <- c(2,4,4,3,2,3)
plot(x,y,type="n",ylab="y,z")
points(x,y,pch=5,cex=2)
points(x,z,pch=8,cex=2)
legend(6,6.5,legend=c("uomini","donne"),pch=c(5,8))

plot(x,y,type="n",ylab="y,z")
points(x,y,pch=5,cex=2)
points(x,z,pch=8,cex=2)
lines(x,y)
lines(x,z,lty=3)
legend(6,6.5,legend=c("uomini","donne"),pch=c(5,8), lty=c(1,3))

### Sez A.4 GRAFICI DI FUNZIONI E SUPERFICI
chippy <- function(x) sin(cos(x)*exp(-x/2))
curve(chippy, -8, 7, n=2001)
curve(sin,-8,7, add=TRUE, lty=3)

hist(rnorm(1000),freq=FALSE)
curve(dnorm,-3,3,add=TRUE)

x <- seq(-10, 10, length=50)
y <- x
f <- function(x,y)
{
  r <- sqrt(x^2+y^2)
  10 * sin(r)/r
}
z <- outer(x, y, f)
z[is.na(z)] <- 1
persp(x, y, z, xlab = "X", ylab = "Y", zlab = "Z") 

persp(x, y, z, theta = 30, phi = 30, expand = 0.5, 
  col = "lightblue", ltheta = 120, shade = 0.75, 
  ticktype = "detailed", xlab="X", ylab="Y", zlab="Z") 

image(z,main="image")
contour(z,main="contour")
image(z,main="image + contour")
contour(z,add=TRUE)
filled.contour(z,main="filled.contour")

data(volcano)
x <- 10 * 1:nrow(volcano)
y <- 10 * 1:ncol(volcano)

image(x, y, volcano, col = gray(100:200/200), 
  axes = FALSE, main="Mappa topografica")
contour(x,y,volcano,add=TRUE)

persp(x, y, volcano, theta=135, phi=30, col="green3", 
  scale=FALSE,  ltheta= -120, shade=0.75, border=NA, 
  box = FALSE, main="Mappa 3D")

### Sez A.4.1. AGGIUNGERE RETINI
curve(dnorm(x),-3,3,axes=FALSE,ylab="", xlab="",ylim=c(0,.5), main="I retini")
axis(1,c(-3,-1,0,1,3),c("","-z",0,"z",""))
vals <- seq(-3,-1,length=100)
x <- c(-3, vals, -1, -3)
y <- c(0, dnorm(vals),0, 0)
polygon(x,y,density=20,angle=45)
vals <- seq(1,3,length=100)
x <- c(1, vals, 3, 1)
y <- c(miny, dnorm(vals),miny, miny)
polygon(x,y,density=20,angle=45)
abline(h=miny)
text(0,0.45,expression(Phi(-z)== 1-Phi(z)))
lines(c(0,0),c(0,dnorm(0)))

vals <- seq(-3,-1,length=100)
x <- c(-3, vals, -1, -3)
y <- c(0, dnorm(vals),0, 0)
polygon(x,y,density=20,angle=45)

### Sez A.5   ESPORTARE I GRAFICI
data(volcano)
pdf("xxxx.pdf")
image(volcano)
dev.off()

### Sez A.6 ESPORTARE TABELLE
require(xtable)
data(Titanic)
mytab <- apply(Titanic, c(2, 4), sum)
mytab
# prima in formato TeX
xtable(mytab)
# ora in formato HTML
print(xtable(mytab), type="html")

### Sez A.7.1. ZERI DI EQUAZIONI
polyroot(c(1, 2, 1))

f <- function(x) 1+2*x+x^2
uniroot(f,c(-2,2))
f <- function(x) sin(x)-x
uniroot(f,c(-pi,pi))

f <- function(x) 1+2*x+x^2
nlm(f,1)
optimize(f,c(-3,2))

A <- matrix(c(2,1,-3,8),2,2)
b <- c(2,2)
x <- solve(A,b)
x
A %*% x - b

A <- matrix(c(2,1,-3,8),2,2)
b <- matrix(c(2,2,3,-1),2,2)
x <- solve(A,b)
x
A %*% x - b

solve(A) # l'inversa
A %*% solve(A) # A * A^-1 = I
solve(A) %*% A  # A^-1 * A = I
 
### Sez A.7.2 MINIMI E MASSIMI DI FUNZIONI
fw <- function (x) 10*sin(0.3*x)*sin(1.3*x^2) + 0.00001*x^4 + 0.2*x+80
res <- optim(50, fw, method="SANN", control=list(maxit=20000, temp=20, parscale=20))
res
 
# EOF AppA.R