Magnificent 7
stem and leaf: ph di n=32 laghi norvegesi
Si osservano i dati del 2006 e del 2007.
x_2006<-c(3.58,3.84,4.22,4.49,4.52,4.83,4.83,4.88,4.91,5.10,5.17,5.22,5.23,5.23,5.29,5.29,5.32,5.37,5.51,5.52,5.59,5.63,5.68,5.79,5.83,5.87,5.92,5.96,5.97,6.26,6.38,6.77)
x_2007<-c(4.32,4.52,4.56,4.64,4.71,4.77,4.98,5.10,5.16,5.2,5.23,5.33,5.33,5.39,5.39,5.39,5.40,5.50,5.63,5.67,5.80,5.81,5.87,5.89,5.93,5.96,5.97,6.01,6.09,6.09,6.17,6.28)
stem(x_2006,scale=4) # Visualizzo i dati del 2006 con il diagramma stem-leaf##
## The decimal point is 1 digit(s) to the left of the |
##
## 35 | 8
## 36 |
## 37 |
## 38 | 4
## 39 |
## 40 |
## 41 |
## 42 | 2
## 43 |
## 44 | 9
## 45 | 2
## 46 |
## 47 |
## 48 | 338
## 49 | 1
## 50 |
## 51 | 07
## 52 | 23399
## 53 | 27
## 54 |
## 55 | 129
## 56 | 38
## 57 | 9
## 58 | 37
## 59 | 267
## 60 |
## 61 |
## 62 | 6
## 63 | 8
## 64 |
## 65 |
## 66 |
## 67 | 7Digitare ?stem per vedere le specifiche della funzione.
Visualizzo i dati del 2006 e del 2007.
boxplot(cbind(x_2006,x_2007),names=c(2006,2007))
Visualizzo entrambi i dati attraverso il diagramma stem-leaf
library(aplpack)
#?stem.leaf
#?stem.leaf.backback
stem.leaf.backback(x_2006,x_2007,unit=0.1,m=1)## _____________________________________________________________
## 1 | 2: represents 1.2, leaf unit: 0.1
## x_2006 x_2007
## _____________________________________________________________
## 2 85| 3 |
## 9 9888542| 4 |3556779 7
## (20) 99988766555332222211| 5 |11223333345668888999 (20)
## 3 732| 6 |00012 5
## | 7 |
## _____________________________________________________________
## n: 32 32
## _____________________________________________________________Cause and effect diagram
library(qcc)## Warning: il pacchetto 'qcc' è stato creato con R versione 4.2.3## Package 'qcc' version 2.7## Type 'citation("qcc")' for citing this R package in publications.#?cause.and.effect
library(SixSigma)## Warning: il pacchetto 'SixSigma' è stato creato con R versione 4.2.3#?ss.ceDiag
effect <- "Flight Time"
causes.gr <- c("Operator", "Environment", "Tools", "Design",
"Raw.Material", "Measure.Tool")
causes <- vector(mode = "list", length = length(causes.gr))
causes[1] <- list(c("operator #1", "operator #2", "operator #3"))
causes[2] <- list(c("height", "cleaning"))
causes[3] <- list(c("scissors", "tape"))
causes[4] <- list(c("rotor.length", "rotor.width2", "paperclip"))
causes[5] <- list(c("thickness", "marks"))
causes[6] <- list(c("calibrate", "model"))
ss.ceDiag(effect, causes.gr, causes, sub = "Paper Helicopter Project")
Scheda di controllo
nt<-12 # numero di istanti temporali considerati
nd<-5 #numero di diffetti
controlsheet<-matrix(0,nrow=nd,ncol=nt); colnames(controlsheet)<-paste("t",1:nt,sep="_")
rownames(controlsheet)<-paste("D",1:nd,sep="_")
pvett<-c(0.3,0.4,0.2,0.05,0.1); nvett<-c(5,10,20,10,10)
for (k in 1:nrow(controlsheet)){
set.seed(k)
controlsheet[k,]<-rbinom(nt,nvett[k],prob=pvett[k]) # anche modello di poisson
}
n<-sum(controlsheet)
x2<-chisq.test(controlsheet)$statistic
nu1<-sqrt(x2/(n*min(nd-1,nt-1)))
controlsheet[,6]<-controlsheet[,5]+c(0,1,1,0,1)
controlsheet[,7]<-controlsheet[,6]+c(1,2,0,0,2)
controlsheet[,8]<-controlsheet[,7]+c(2,3,1,0,3)
n<-sum(controlsheet)
x2<-chisq.test(controlsheet)$statistic
nu2<-sqrt(x2/(n*min(nd-1,nt-1)))
boxplot(controlsheet,cex.axis=0.7,main="Total number of defects")
allx<-names<-c()
for (k in 1:12){
allx<-c(allx,controlsheet[,k])
names<-c(names,rep(colnames(controlsheet)[k],nrow(controlsheet)))
}
library(ggplot2)
df<-data.frame(Ndefect=allx,time=names)
ggplot(df, aes(x=time, y=Ndefect, fill=time)) +
geom_violin(trim=FALSE) +
scale_x_discrete(limits=colnames(controlsheet)) +
ylim(0, 15) 
Pareto chart
total_sheet<-rowSums(controlsheet)
library(qcc)
#?pareto.chart
# attraverso la funzione pareto.chart
pc<-pareto.chart(total_sheet, main="Pareto Chart for total number of defects",col=1:5)
# manualmente
mat<-cbind(sort(total_sheet,decreasing=TRUE),1:5)
barplot(mat[,1],names.arg=colnames(mat),col=1:5,ylim=c(0,100))
Pareto chart 2
defect <- c(89, 37, 46, 84, 39)
names(defect) <- c("price code", "schedule date", "supplier code", "contact num.", "part num.")
pareto.chart(defect, ylab = "Error frequency")
##
## Pareto chart analysis for defect
## Frequency Cum.Freq. Percentage Cum.Percent.
## price code 89.00000 89.00000 30.16949 30.16949
## contact num. 84.00000 173.00000 28.47458 58.64407
## supplier code 46.00000 219.00000 15.59322 74.23729
## part num. 39.00000 258.00000 13.22034 87.45763
## schedule date 37.00000 295.00000 12.54237 100.00000pareto.chart(defect, ylab = "Error frequency", xlab = "Error causes", las=1)
##
## Pareto chart analysis for defect
## Frequency Cum.Freq. Percentage Cum.Percent.
## price code 89.00000 89.00000 30.16949 30.16949
## contact num. 84.00000 173.00000 28.47458 58.64407
## supplier code 46.00000 219.00000 15.59322 74.23729
## part num. 39.00000 258.00000 13.22034 87.45763
## schedule date 37.00000 295.00000 12.54237 100.00000pareto.chart(defect, ylab = "Error frequency", col=rainbow(length(defect)))
##
## Pareto chart analysis for defect
## Frequency Cum.Freq. Percentage Cum.Percent.
## price code 89.00000 89.00000 30.16949 30.16949
## contact num. 84.00000 173.00000 28.47458 58.64407
## supplier code 46.00000 219.00000 15.59322 74.23729
## part num. 39.00000 258.00000 13.22034 87.45763
## schedule date 37.00000 295.00000 12.54237 100.00000pareto.chart(defect, cumperc = seq(0, 100, by = 5), ylab2 = "A finer tickmarks grid")
##
## Pareto chart analysis for defect
## Frequency Cum.Freq. Percentage Cum.Percent.
## price code 89.00000 89.00000 30.16949 30.16949
## contact num. 84.00000 173.00000 28.47458 58.64407
## supplier code 46.00000 219.00000 15.59322 74.23729
## part num. 39.00000 258.00000 13.22034 87.45763
## schedule date 37.00000 295.00000 12.54237 100.00000DIAGRAMMA DI DISPERSIONE
data(boiler)
xmin<-min(boiler)
xmax<-max(boiler)
cor(boiler)## t1 t2 t3 t4 t5 t6
## t1 1.00000000 0.05927848 0.5841412 0.90153383 0.81892106 -0.1469017
## t2 0.05927848 1.00000000 0.2809033 0.25854808 0.04372109 0.6587643
## t3 0.58414123 0.28090331 1.0000000 0.44402079 0.30757378 0.2000743
## t4 0.90153383 0.25854808 0.4440208 1.00000000 0.84954593 -0.2263854
## t5 0.81892106 0.04372109 0.3075738 0.84954593 1.00000000 -0.2311929
## t6 -0.14690171 0.65876429 0.2000743 -0.22638537 -0.23119288 1.0000000
## t7 0.81315461 0.09398073 0.3961165 0.78844123 0.92438382 -0.1031505
## t8 0.01443630 0.79698534 0.2941526 0.01760836 -0.04269942 0.8930960
## t7 t8
## t1 0.81315461 0.01443630
## t2 0.09398073 0.79698534
## t3 0.39611653 0.29415264
## t4 0.78844123 0.01760836
## t5 0.92438382 -0.04269942
## t6 -0.10315052 0.89309601
## t7 1.00000000 0.07889952
## t8 0.07889952 1.00000000sapply(1:(NCOL(boiler)-1),function(x) plot(boiler[,x],boiler[,x+1],pch=19,main="Temperatura bruciatori",xlim=c(xmin,xmax),ylim=c(xmin,xmax),xlab=names(boiler)[x],ylab=names(boiler)[x+1]))
## [[1]]
## NULL
##
## [[2]]
## NULL
##
## [[3]]
## NULL
##
## [[4]]
## NULL
##
## [[5]]
## NULL
##
## [[6]]
## NULL
##
## [[7]]
## NULLpairs(boiler[,1:6])
istogrammi
library(MASS)
data(anorexia)
hist(anorexia$Prewt,freq=FALSE,breaks = seq(70,105,by=5),ylim=c(0,0.1),main="Pre-weight",xlab="")
hist(anorexia$Postwt,freq=FALSE,breaks = seq(70,105,by=5),ylim=c(0,0.1),main="Post-weight",ylab="")
abline(v=85,lty=1,col="red",lwd=2)
abline(v=75,lty=2,col="red",lwd=2)
abline(v=95,lty=2,col="red",lwd=2)
unique(anorexia$Treat)## [1] Cont CBT FT
## Levels: CBT Cont FT#[1] Cont CBT FT
t1<-which(anorexia$Treat=="Cont")
t2<-which(anorexia$Treat=="CBT")
t3<-which(anorexia$Treat=="FT")
par(mfrow=c(1,3))
hist(anorexia$Prewt[t1],freq=FALSE,breaks = seq(70,105,by=5),main="Pre-weight: Treat=Cont",ylim=c(0,0.15),xlab="")
hist(anorexia$Prewt[t2],freq=FALSE,breaks = seq(70,105,by=5),main="Pre-weight: Treat=CBT",ylim=c(0,0.15),xlab="")
hist(anorexia$Prewt[t3],freq=FALSE,breaks = seq(70,105,by=5),main="Pre-weight: Treat=FT",ylim=c(0,0.15),xlab="")
Istogrammi post-trattamento
hist(anorexia$Postwt[t1],freq=FALSE,breaks = seq(70,105,by=5),main="Post-weight: Treat=Cont",ylim=c(0,0.15),xlab="")
abline(v=85,lty=1,col="red",lwd=2)
abline(v=75,lty=2,col="red",lwd=2)
abline(v=95,lty=2,col="red",lwd=2)
hist(anorexia$Postwt[t2],freq=FALSE,breaks = seq(70,105,by=5),main="Post-weight: Treat=CBT",ylim=c(0,0.15),xlab="")
abline(v=85,lty=1,col="red",lwd=2)
abline(v=75,lty=2,col="red",lwd=2)
abline(v=95,lty=2,col="red",lwd=2)
hist(anorexia$Postwt[t3],freq=FALSE,breaks = seq(70,105,by=5),main="Post-weight: Treat=FT",ylim=c(0,0.15),xlab="")
abline(v=85,lty=1,col="red",lwd=2)
abline(v=75,lty=2,col="red",lwd=2)
abline(v=95,lty=2,col="red",lwd=2)