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 computationMon, 03 Nov 2008 13:55:10 -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/03/t1225745732a5lggb4k6cu1crv.htm/, Retrieved Sun, 19 May 2024 11:34:31 +0000
Statistical Computations at FreeStatistics.org, Office for Research Development and Education, URL https://freestatistics.org/blog/index.php?pk=21251, Retrieved Sun, 19 May 2024 11:34:31 +0000
QR Codes:

Original text written by user:
IsPrivate?No (this computation is public)
User-defined keywords
Estimated Impact160
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    D  [Mean Plot] [Hypothesis testin...] [2008-11-01 09:11:33] [6743688719638b0cb1c0a6e0bf433315]
F         [Mean Plot] [q2] [2008-11-03 19:53:27] [988ab43f527fc78aae41c84649095267]
F             [Mean Plot] [Hypothesis testin...] [2008-11-03 20:55:10] [02e7fb326979b65614900650d62c19a6] [Current]
Feedback Forum
2008-11-05 16:41:20 [Ken Van den Heuvel] [reply
Inderdaad, het gemiddelde in 7 en 11 is de hoogte ingeschoten. De corresponderende maanden bij deze data zijn dus van belang bij seizoenaliteit.

Je had nog mogelijksverder een verklaring hiervoor kunnen zoeken. Data 6 komt ongeveer overeen met het begin van de zomer, de periode waarin mensen volop zomerkledij aankopen. M.a.w. de productie komt hier op gang om in de behoeften van de mensen te voorzien. Deze trend zet zich dan voort tot augustus om vervolgens weer af te bouwen (logisch, zomer loopt op zijn einde, mensen zullen minder geneigd zijn zomerkledij te kopen, productie volgt deze tendens en daalt. Ongeveer hetzelfde fenomeen doet zich voor in oktober, maar dan ditmaal omwille van de winter en de bijhorende winterkledij.

Het gemiddelde van de productie ligt dus hoger in deze periodes, wat we kunnen afleiden uit het stijgende verloop op de grafiek, waardoor we inderdaad kunnen stellen dat seizoenaliteit een effect heeft op de kledijproductie.

Hetzelfde vinden we terug bij Periodic subseries waar de betrouwbaarheidsintervallen bij de boxes van 6 en 10 duidelijk buiten deze van hun voorgangers liggen.
2008-11-10 17:15:06 [Olivier Uyttendaele] [reply
Je schreef in het document dat er seizoenaliteit waar te nemen is. Dit is correct. Een meer algemenere uitleg is al volgt:

Het cijfer dat bij #blocks staat, is het aantal jaar waarover de waarnemingen gaan. De cijfers op de X-as staan voor het aantal maanden per jaar.
Het cijfer 1 staat dus voor alle eerste maanden van de 5jaar waarover we gegevens hebben. Dus voor 01/03, 01/04, 01/05, 01/06, 01,07; hetzelfde voor jaar 2 enz…
Je bekijkt dezelfde maand over de jaren heen als het ware.
We kunnen dus zien dat in de periodes 6&7 er seizoenaliteit is.
Algemeen kan je bij het Mean Plot volgende zaken waarnemen:
1) Zijn er veranderingen in het niveau?
2) Wat is de impact van de veranderingen in het niveau.
3) Is er een bepaald patroon in de veranderingen van het niveau.

De Mean Plot kan dus een grafische test zijn voor de assumptie “Is er een constant niveau?”

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=21251&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=21251&T=0

Globally Unique Identifier (entire table): ba.freestatistics.org/blog/index.php?pk=21251&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 = 12 ;
Parameters (R input):
par1 = 12 ;
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()