FreeStatistics.org

Free Statistics

of Irreproducible Research!

Description of Statistical Computation

Author's title

Author*The author of this computation has been verified*
R Software Modulerwasp_meanplot.wasp
Title produced by softwareMean Plot
Date of computationSun, 02 Nov 2008 04:17:48 -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/02/t1225624725k5osq3gbz0l7v8w.htm/, Retrieved Sat, 18 May 2024 21:20:02 +0000
Statistical Computations at FreeStatistics.org, Office for Research Development and Education, URL https://freestatistics.org/blog/index.php?pk=20495, Retrieved Sat, 18 May 2024 21:20:02 +0000
QR Codes:

Original text written by user:
IsPrivate?No (this computation is public)
User-defined keywords
Estimated Impact212

Tree of Dependent Computations

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 R  D    [Mean Plot] [task4, 5%] [2008-11-02 11:17:48] [1aceffc2fa350402d9e8f8edd757a2e8] [Current]
F R  D      [Mean Plot] [task5, mean plot ...] [2008-11-02 14:38:16] [44a98561a4b3e6ab8cd5a857b48b0914]
F RMPD      [Kendall tau Correlation Matrix] [kendau tau corr q1] [2008-11-02 16:05:03] [44a98561a4b3e6ab8cd5a857b48b0914]
Feedback Forum
2008-11-09 13:53:24 [Kristof Augustyns] [reply] 
Het is hier inderdaad juist gedaan door 2,5% van iedere staart weg te halen.
Er zijn inderdaad nog maar vier waarden waaruit dus blijkt dat de pieken kleiner zijn geworden.
De seizoenspiek is naar links opgeschoven waaruit dus blijkt dat die in juni plaatsvindt en dus een sterke daling in juli en augustus.
Alles is dus eigenlijk opgeschoven.
Bij de sequential blocks is er geen blijvende daling meer, maar geeft het vijfde blokje terug een stijging weer.
Het blijft wel zo dat er geen sprake is van significatie en dat alles wat stijgt of daalt gewoon toevallig is.
Alles is hier perfect uitgelegd.
2008-11-09 15:26:08 [Natascha Meeus] [reply] 
Dit is ook correct. Door het gebruik van quantiles wordt de spreiding kleiner, omdat de outliers wegvallen.
2008-11-11 15:04:18 [Jan Mols] [reply] 
Correct.Wanneer men naar de grafieken kijkt van de 2 verschillende links, dus met en zonder de 5% hoogste en laagste observaties kan men besluiten dat er een verschil is tussen de 2.Dit kan men vooral zien op de Notch Boxed Plots. Er zijn minder spreidingen tussen de verschillende gemiddelden en medianen. We zien ook dan dat de outliers door de code aan te passen ook weg gefilterd zijn.
2008-11-11 22:23:32 [Liese Tormans] [reply] 
De student heeft de R code juist gewijzigd.
x <- x[x>quantile(x,0.05) & xOok zijn conclusie is juist geformuleerd.

Als we de twee berekeningen gaan vergelijken met mekaar. Zien we dat in de berekening met de gewijzigde R-code aan beide kanten 2,5% van de staart is afgeknipt.
Als we beide grafieken dan gaan vergelijken kunnen we opmerken dat bij de tweede grafiek (grafiek van gewijzigde R-code) de spreiding veel kleiner is. Ook zien we dat door de R-code aan te passen de outliers zijn weggefilterd.

Post a new message

Dataset

Dataseries X:
Download CSV
Histogram
Boxplots 
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

Tables (Output of Computation)





Summary of computational transaction
Raw Inputview raw input (R code)
Raw Outputview raw output of R engine
Computing time2 seconds
R Server'Gwilym Jenkins' @ 72.249.127.135

\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 & 'Gwilym Jenkins' @ 72.249.127.135 \tabularnewline
\hline
\end{tabular}
%Source: https://freestatistics.org/blog/index.php?pk=20495&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]'Gwilym Jenkins' @ 72.249.127.135[/C][/ROW]
[/TABLE]
Source: https://freestatistics.org/blog/index.php?pk=20495&T=0

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

As an alternative you can also use a QR Code:  
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'Gwilym Jenkins' @ 72.249.127.135


Figures (Output of Computation)

Input Parameters & R Code

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()