library(rmf)
library(qcc)
data(studenti)

str(df$residenza)
df$residenza
df[121,5]

# Distribuzioni di frequenza
table(df$residenza)
tbl <- table(df$residenza)
prop.table(tbl)
prop.table(tbl)*100
table(df$residenza)/sum(table(df$residenza))*100
frequenze(df$residenza)
frq(data.frame(df$sex,df$residenza))

# Alcune rappresentazioni grafiche
torta(df$residenza) # Figura 2.1
# oppure
tbl <- table(df$residenza)
pie(tbl)


# Figura 2.2
figura_1.1 <- c(0.112,0.055,0.078,0.374,0.107,0.068,0.055,0.119,0.032)
names(figura_1.1) <- c("Rifiuti organici", "Vetro", "Metalli", "Carta, cartone",
                        "Plastica", "Gomma, pelle, fibre tessili", "Legno",
                        "Erba tagliata", "Altro")
pie(figura_1.1)

tbl <- table(df$residenza)
barplot(tbl)                 # Figura 2.3
barplot(prop.table(tbl))
barplot(prop.table(tbl)*100) # Figura 2.4
rettangoli(df$residenza)

names(df[,19:30])
str(df$libro)
frequenze(df$libro, cumul=TRUE)


# Figura 2.5 (occorre il package qcc)
# Diagramma di Pareto (Tabella 2.3 da Levine et al. (2006))
x <- rep("Puntini neri",413)
y <- rep("Danneggiamento", 1039)
z <- rep("Getto di inchiostro", 258)
w <- rep("Piccoli segni", 834)
u <- rep("Graffi", 442)
v <- rep("Base ammaccata", 275)
k <- rep("Striature", 413)
m <- rep("Segni di colpi", 371)
n <- rep("Segni di spray", 292)
o <- rep("Base curvata", 1987)
a <- c(x,y,z,w,u,v,k,m,n,o)
Difetti <- table(a)
pareto.chart(Difetti)
pareto.chart(Difetti,cumperc=seq(0,100,by = 5))

frequenze(a)
frequenze(a,sort=TRUE,cumul=TRUE)


# Una distribuzione bimodale
x <- rep("Puntini neri",413)
y <- rep("Danneggiamento", 1039)
z <- rep("Getto di inchiostro", 258)
w <- rep("Piccoli segni", 834)
u <- rep("Graffi", 442)
v <- rep("Base ammaccata", 275)
k <- rep("Striature", 413)
m <- rep("Segni di colpi", 1987)
n <- rep("Segni di spray", 292)
o <- rep("Base curvata", 1987)
a <- c(x,y,z,w,u,v,k,m,n,o)
Difetti <- table(a)
barplot(Difetti)
barplot(Difetti,las=2)
barplot(Difetti,las=2,cex.names=0.5) # Figura 2.7

# Strumenti analitici
median(df$libro)
frequenze(df$libro, cumul=TRUE)

# L'entropia
# Grafico dell'entropia binaria (Figura 2.8)
x <- c(0:1000)/1000
y <- x*(1-x)*4
plot(x,y,type="l",xlab=expression(italic(f[1])),ylab=expression(italic(H(x))))

# Entropia
x <- df[,19:30]
entr <- numeric(ncol(x))
for (j in 1:ncol(x))
{
    y <- table(x[,j])
    f <- y/sum(y)
    h <- f * log(1/f, base=2)
    entr[j] <- sum(h)
    cat(round(f,3),"\n")
}

# entropia massima (tutti i voti 1/5)
f <- rep(1/5,5)
h <- f * log(1/f, base=2)
(maxEntr <- sum(h))

tmp <- data.frame(colnames(x),entr,entr/maxEntr)
o   <- order(tmp[,3])
tmp[o,]

# la funzione sort.list produce lo stesso risultato
oo   <- sort.list(tmp[,3])
tmp[oo,]

# con il logaritmo in base 5 si evita di dividere per il massimo
# e si perviene direttamente all'indice relativo
entr <- numeric(ncol(x))
for (j in 1:ncol(x))
{
    y <- table(x[,j])
    f <- y/sum(y)
    h <- f * log(1/f, base=5)
    entr[j] <- sum(h)
}
tmp <- data.frame(colnames(x),entr)
o <- order(tmp[,2]); tmp[o,]

# da 5 modalità a 3
ris <- matrix(nrow=ncol(x),ncol=3)
for (j in 1:ncol(x))
{
    y <- table(factor(x[,j],levels=c(1:5)))
    f <- prop.table(y)
    ris[j,1] <- f[1]+f[2]
    ris[j,2] <- f[3]
    ris[j,3] <- f[4]+f[5]
}
colnames(ris) <- c("1-2","3","4-5")
round(ris,3)

# "Micidialità di R"
y <- table(factor(x[,j],levels=c(1:5)))
x <- df[df$sex=="F",19:30]
table(x[,12])
x <- df[df$sex=="F",19:30]
table(factor(x[,12],levels=c(1:5)))

# Il grafico in coordinate triangolari (Figura 2.9)
triplot(ris,cex.vert=1,cex.text=1)
thicks()
centro()


# Figura 2.10
# Un'analisi per genere (per i maschi sostituire "M" a "F")
x <- df[df$sex=="F",19:30]
ris <- matrix(nrow=ncol(x),ncol=3)
for (j in 1:ncol(x))
{
    y <- table(factor(x[,j],levels=c(1:5)))
    p <- prop.table(y)
    ris[j,1] <- p[1]+p[2]
    ris[j,2] <- p[3]
    ris[j,3] <- p[4]+p[5]
}
round(ris,3)
colnames(ris) <- c("1-2","3","4-5")
triplot(ris,cex.vert=0.9,cex.text=0.7)
centro()