Free Statistics

of Irreproducible Research!

Author's title

Author*The author of this computation has been verified*
R Software Modulerwasp_meanplot.wasp
Title produced by softwareMean Plot
Date of computationTue, 04 Nov 2008 00:54:17 -0700
Cite this page as followsStatistical Computations at FreeStatistics.org, Office for Research Development and Education, URL https://freestatistics.org/blog/index.php?v=date/2008/Nov/04/t1225785343w9j8csbyaly911l.htm/, Retrieved Sun, 19 May 2024 05:37:06 +0000
Statistical Computations at FreeStatistics.org, Office for Research Development and Education, URL https://freestatistics.org/blog/index.php?pk=21446, Retrieved Sun, 19 May 2024 05:37:06 +0000
QR Codes:

Original text written by user:
IsPrivate?No (this computation is public)
User-defined keywords
Estimated Impact167
Family? (F = Feedback message, R = changed R code, M = changed R Module, P = changed Parameters, D = changed Data)
F     [Mean Plot] [workshop 3] [2007-10-26 12:14:28] [e9ffc5de6f8a7be62f22b142b5b6b1a8]
F   PD  [Mean Plot] [Task 1 - Q3] [2008-11-03 19:15:48] [6f54f97492451bf8edc5dd186465ee4a]
F           [Mean Plot] [taak 1 - Q3] [2008-11-04 07:54:17] [5040d663c8831657aab853d3d80c5057] [Current]
Feedback Forum
2008-11-10 14:08:57 [Inge Meelberghs] [reply
Om na te gaan ofdat de productie van kleding over de jaren heen is veranderd kan je best de Notched box plot gebruiken. Deze geeft een veel beter beeld hiervan.

http://www.freestatistics.org/blog/date/2008/Nov/02/t1225632521jbn2ys6bu2c23bb.htm

Op de grafiek kunnen we duidelijk zien dat de kledingproductie jaarlijks verminderd. Maar is deze daling ook significant?

Dit kunnen we nagaan door naar de betrouwbaarheids-intervallen door de jaren heen te gaan kijken en te vergelijken.
Als we naar jaar 1 tot jaar 4 kijken kunnen we zeggen dat deze intervallen overeenkomen en dat de daling te wijten zou kunnen zijn aan toeval. Maar als we dan naar jaar 1 en jaar 5 kijken komen deze betrouwbaarheidsintervallen niet exact overeen en is er maar een kleine overlapping. Dit is dus eerder een twijfelgeval en gaat men eerder spreken van een niet toevallige daling.
Jaar 6 kunnen we niet gebruiken doordat de data van deze reeks niet volledig is.
2008-11-11 12:08:04 [Evelien Blockx] [reply
Hier kan je gewoon je berekening gebruiken met blockwith 12.

http://www.freestatistics.org/blog/date/2008/Nov/04/t12257851374zpo7kg2e6v40eu.htm

Om de vraag op te lossen gebruik je de 5de grafiek (Notched Boxplots-Sequential Blocks). Je vergelijkt 5 jaren, want het figuurtje bij het 6de jaar is erg klein (doordat er maar enkele observaties zijn voor het 6de jaar).

Ook hier moet je weer kijken of de daling significant is. Dit is niet het geval, omdat de betrouwbaarheidsintervallen van elk jaar telkens overlappen met het vorige jaar. (Zelfde werkwijze als Q1).

De conclusie is dat het niveau van kledingproductie gedaald is over de jaren heen, maar dat dit niet significant is. Je kan het toeschrijven aan toevalligheid.
2008-11-11 17:42:46 [Yara Van Overstraeten] [reply
Het is hier inderdaad niet nodig om de blokwidth op 36 te zetten, 12 is hier voldoende.
Er is inderdaad een dalende trend in de productie van kledij waarneembaar over de 5 jaren, maar deze is echter niet significant verschillend omdat de 95% betrouwbaarheidsintervallen van de notched box plots elkaar overlappen. Het kan hier dus om een toevallige daling gaan.

Post a new message
Dataseries X:
109.20
88.60
94.30
98.30
86.40
80.60
104.10
108.20
93.40
71.90
94.10
94.90
96.40
91.10
84.40
86.40
88.00
75.10
109.70
103.00
82.10
68.00
96.40
94.30
90.00
88.00
76.10
82.50
81.40
66.50
97.20
94.10
80.70
70.50
87.80
89.50
99.60
84.20
75.10
92.00
80.80
73.10
99.80
90.00
83.10
72.40
78.80
87.30
91.00
80.10
73.60
86.40
74.50
71.20
92.40
81.50
85.30
69.90
84.20
90.70
100.30




Summary of computational transaction
Raw Inputview raw input (R code)
Raw Outputview raw output of R engine
Computing time2 seconds
R Server'George Udny Yule' @ 72.249.76.132

\begin{tabular}{lllllllll}
\hline
Summary of computational transaction \tabularnewline
Raw Input & view raw input (R code)  \tabularnewline
Raw Output & view raw output of R engine  \tabularnewline
Computing time & 2 seconds \tabularnewline
R Server & 'George Udny Yule' @ 72.249.76.132 \tabularnewline
\hline
\end{tabular}
%Source: https://freestatistics.org/blog/index.php?pk=21446&T=0

[TABLE]
[ROW][C]Summary of computational transaction[/C][/ROW]
[ROW][C]Raw Input[/C][C]view raw input (R code) [/C][/ROW]
[ROW][C]Raw Output[/C][C]view raw output of R engine [/C][/ROW]
[ROW][C]Computing time[/C][C]2 seconds[/C][/ROW]
[ROW][C]R Server[/C][C]'George Udny Yule' @ 72.249.76.132[/C][/ROW]
[/TABLE]
Source: https://freestatistics.org/blog/index.php?pk=21446&T=0

Globally Unique Identifier (entire table): ba.freestatistics.org/blog/index.php?pk=21446&T=0

As an alternative you can also use a QR Code:  

The GUIDs for individual cells are displayed in the table below:

Summary of computational transaction
Raw Inputview raw input (R code)
Raw Outputview raw output of R engine
Computing time2 seconds
R Server'George Udny Yule' @ 72.249.76.132



Parameters (Session):
par1 = 36 ;
Parameters (R input):
par1 = 36 ;
R code (references can be found in the software module):
par1 <- as.numeric(par1)
(n <- length(x))
(np <- floor(n / par1))
arr <- array(NA,dim=c(par1,np+1))
ari <- array(0,dim=par1)
j <- 0
for (i in 1:n)
{
j = j + 1
ari[j] = ari[j] + 1
arr[j,ari[j]] <- x[i]
if (j == par1) j = 0
}
ari
arr
arr.mean <- array(NA,dim=par1)
arr.median <- array(NA,dim=par1)
arr.midrange <- array(NA,dim=par1)
for (j in 1:par1)
{
arr.mean[j] <- mean(arr[j,],na.rm=TRUE)
arr.median[j] <- median(arr[j,],na.rm=TRUE)
arr.midrange[j] <- (quantile(arr[j,],0.75,na.rm=TRUE) + quantile(arr[j,],0.25,na.rm=TRUE)) / 2
}
overall.mean <- mean(x)
overall.median <- median(x)
overall.midrange <- (quantile(x,0.75) + quantile(x,0.25)) / 2
bitmap(file='plot1.png')
plot(arr.mean,type='b',ylab='mean',main='Mean Plot',xlab='Periodic Index')
mtext(paste('#blocks = ',np))
abline(overall.mean,0)
dev.off()
bitmap(file='plot2.png')
plot(arr.median,type='b',ylab='median',main='Median Plot',xlab='Periodic Index')
mtext(paste('#blocks = ',np))
abline(overall.median,0)
dev.off()
bitmap(file='plot3.png')
plot(arr.midrange,type='b',ylab='midrange',main='Midrange Plot',xlab='Periodic Index')
mtext(paste('#blocks = ',np))
abline(overall.midrange,0)
dev.off()
bitmap(file='plot4.png')
z <- data.frame(t(arr))
names(z) <- c(1:par1)
(boxplot(z,notch=TRUE,col='grey',xlab='Periodic Index',ylab='Value',main='Notched Box Plots - Periodic Subseries'))
dev.off()
bitmap(file='plot5.png')
z <- data.frame(arr)
names(z) <- c(1:np)
(boxplot(z,notch=TRUE,col='grey',xlab='Block Index',ylab='Value',main='Notched Box Plots - Sequential Blocks'))
dev.off()
bitmap(file='plot6.png')
z <- data.frame(cbind(arr.mean,arr.median,arr.midrange))
names(z) <- list('mean','median','midrange')
(boxplot(z,notch=TRUE,col='grey',ylab='Overall Central Tendency',main='Notched Box Plots'))
dev.off()