The variance is the mean squared deviation from the mean. The variance for population data is denoted by \(\sigma^2\) (read as sigma squared) and the variance calculated for sample data is denoted by \(s^2\).
\[ \sigma^2 = \frac{\sum_{i=1}^n (x_i-\mu)^2}{N} \]
and
\[ s^2 = \frac{\sum_{i=1}^n (x_i-\bar x)^2}{n-1} \]
where \(\sigma^2\) is the population variance and \(s^2\) is the sample variance. The quantity \(x_i-\mu\) or \(x_i-\bar x\) in the above formulas is called the deviation of the \(x_i\) value (\(x_1, x_2,...,x_n\)) from the mean (Mann 2012).
The standard deviation is the most-used measure of dispersion. The value of the standard deviation tells us how closely the values of a data set are clustered around the mean. In general, a lower value of the standard deviation indicates that the values of the data set are spread over a relatively smaller range around the mean. In contrast, a larger value of the standard deviation for a data set indicates that the values of that data set are spread over a relatively larger range around the mean (Mann 2012).
The standard deviation is obtained by taking the square root of the variance. Consequently, the standard deviation calculated for population data is denoted by \(\sigma\) and the standard deviation calculated for sample data is denoted by \(s\).
\[ \sigma = \sqrt{\frac{\sum_{i=1}^N (x_i-\mu)^2}{N}} \]
and
\[ s = \sqrt{\frac{\sum_{i=1}^n (x_i-\bar x)^2}{n-1}} \]
where \(\sigma\) is the standard deviation of the population and \(s\) is the standard deviation of the sample.
As an exercise we compute the mean, the median, the variance and the
standard deviation for some numerical variables of interest in the
students
data set, and present them in a nice format.
students <- read.csv("https://userpage.fu-berlin.de/soga/data/raw-data/students.csv")
quant_vars <- c("name", "age", "nc.score", "height", "weight")
students_quant <- students[quant_vars]
head(students_quant, 10)
## name age nc.score height weight
## 1 Gonzales, Christina 19 1.91 160 64.8
## 2 Lozano, T'Hani 19 1.56 172 73.0
## 3 Williams, Hanh 22 1.24 168 70.6
## 4 Nem, Denzel 19 1.37 183 79.7
## 5 Powell, Heather 21 1.46 175 71.4
## 6 Perez, Jadrian 19 1.34 189 85.8
## 7 Clardy, Anita 21 1.11 156 65.9
## 8 Allen, Rebecca Marie 21 2.03 167 65.7
## 9 Tracy, Robert 18 1.29 195 94.4
## 10 Nimmons, Laura 18 1.19 165 66.0
# mean
students_quant_mean <- apply(students_quant[, !(colnames(students_quant) == "name")], 2, mean)
# median
students_quant_median <- apply(students_quant[, !(colnames(students_quant) == "name")], 2, median)
# variance
students_quant_var <- apply(students_quant[, !(colnames(students_quant) == "name")], 2, var)
# standard deviation
students_quant_sd <- apply(students_quant[, !(colnames(students_quant) == "name")], 2, sd)
# concatenate the vectors and round to 2 digits
students_quant_stats <- round(cbind(
students_quant_mean,
students_quant_median,
students_quant_var,
students_quant_sd
), 2)
# rename column names
colnames(students_quant_stats) <- c("mean", "median", "variance", "standard deviation")
students_quant_stats
## mean median variance standard deviation
## age 22.54 21.00 36.79 6.07
## nc.score 2.17 2.04 0.66 0.81
## height 171.38 171.00 122.71 11.08
## weight 73.00 71.80 74.57 8.64
By using the mean and standard deviation we can find the proportion or percentage of the total observations that fall within a given interval around the mean.
Chebyshev’s theorem gives a lower bound for the area under a curve between two points that are on opposite sides of the mean and at the same distance from the mean.
For any number \(k\) greater than 1, at least \((1-1/k^2)*100\) % of the data values lie within \(k\) standard deviations of the mean.
Let us use R to gain some intuition for Chebyshev’s theorem.
k <- seq(1, 4, by = 0.1)
auc <- 1 - (1 / k^2)
auc_percent <- round(auc * 100)
cbind(k, auc_percent)
## k auc_percent
## [1,] 1.0 0
## [2,] 1.1 17
## [3,] 1.2 31
## [4,] 1.3 41
## [5,] 1.4 49
## [6,] 1.5 56
## [7,] 1.6 61
## [8,] 1.7 65
## [9,] 1.8 69
## [10,] 1.9 72
## [11,] 2.0 75
## [12,] 2.1 77
## [13,] 2.2 79
## [14,] 2.3 81
## [15,] 2.4 83
## [16,] 2.5 84
## [17,] 2.6 85
## [18,] 2.7 86
## [19,] 2.8 87
## [20,] 2.9 88
## [21,] 3.0 89
## [22,] 3.1 90
## [23,] 3.2 90
## [24,] 3.3 91
## [25,] 3.4 91
## [26,] 3.5 92
## [27,] 3.6 92
## [28,] 3.7 93
## [29,] 3.8 93
## [30,] 3.9 93
## [31,] 4.0 94
To put it in words: Let us pick a value for \(k\): \(k= 3\). This means that at least 89% of the data values lie within 3 standard deviations of the mean.
Let us plot Chebyshev’s theorem with R:
plot(k,
auc_percent,
col = "blue",
pch = 19,
xlab = "k",
ylab = "percent",
main = "Chebyshev's theorem"
)
The theorem applies to both sample and population data. Note that Chebyshev’s theorem is applicable to a distribution of any shape. However, Chebyshev’s theorem can be used only for \(k>1\). This is so because when \(k = 1\), the value of \((1-1/k^2)\) is zero, and when \(k<1\), the value of \((1-1/k^2)\) is negative (Mann 2012).
While Chebyshev’s theorem is applicable to any kind of distribution, the empirical rule applies only to a specific type of distribution called a bell-shaped distribution or normal distribution. There are 3 rules:
For a bell-shaped distribution, approximately
Since we have sufficient coding abilities by now, we will try to test
if the three rules are valid. (1) First, we will
explore the rnorm
function in R to generate normally
distributed data and (2) second, we will go back to our
students
data set and validate those rules on that data
set.
The normal distribution belongs to the family of continuous distributions. In R there are a lot of
probability distributions available (here). To generate data from a normal distribution
one may use the rnorm()
function, which is a random
variable generator for the normal distribution.
We can sample n
values from a normal distribution with a
given mean (default is 0) and standard deviation (default is 1) using
the rnorm()
function:
rnorm(n=1, mean=0, sd=1)
. Let us give it a try:
rnorm(n = 1, mean = 0, sd = 1)
## [1] 0.3024223
rnorm(n = 1, mean = 0, sd = 1)
## [1] 0.1607108
rnorm(n = 1, mean = 0, sd = 1)
## [1] -0.5589824
rnorm(n = 1, mean = 0, sd = 1)
## [1] -0.0868194
As we can see, the rnorm()
function returns (pseudo-)random numbers. We can fairly easily ask
the function to draw hundreds or thousands or even more (pseudo-)random
numbers:
rnorm(n = 10, mean = 0, sd = 1)
## [1] 0.305534 -1.449842 1.124206 -1.250876 1.520984 1.292920 -0.506880
## [8] -1.755317 1.399782 -2.066587
rnorm(n = 100, mean = 0, sd = 1)
## [1] -0.95408954 -0.36226697 0.81396156 0.53698581 1.57695272 -0.51980926
## [7] -0.34556678 -0.06558639 -0.94565297 -0.20274276 1.00864513 1.26060728
## [13] 1.52324542 -0.81329537 -0.04527783 -0.73954000 0.33078526 -1.61404629
## [19] -0.75955544 0.44716717 -0.43674032 -1.38611811 1.11213934 -1.91651982
## [25] 0.64893972 1.67199076 -0.56596237 0.15142877 -0.08794681 -0.91326167
## [31] 0.81229043 -1.62428413 0.14954278 -0.95877422 0.26793841 0.80352371
## [37] -0.20803389 0.71325008 1.60517143 0.39996411 0.15522763 -0.83475926
## [43] 2.40961970 -0.49223334 0.66283628 -1.30077324 0.46532720 -1.04467400
## [49] -1.73866438 0.26044254 2.10025571 -1.85331303 -0.88941184 0.33500572
## [55] 0.07303722 -2.07474575 0.42468379 -1.06423040 0.36929172 -0.07309428
## [61] 0.42295545 0.70401118 0.10954828 -0.72429535 -0.50137046 -0.33520835
## [67] 0.56041721 -0.33140872 0.62048804 1.34317852 0.24645206 0.30737213
## [73] -0.17031416 -0.48449711 -1.20424081 -0.97730543 0.07287897 -0.31357427
## [79] -0.13024810 0.51945538 0.95817660 -1.79337310 -0.63578623 1.43155929
## [85] 1.29249493 -0.98061237 0.46659636 1.04861061 0.19487780 -0.89221195
## [91] 2.12972550 0.62830767 -1.17800505 0.42219325 0.21551023 1.70225208
## [97] -0.98230728 0.13922632 -0.25711721 -0.18386610
y_norm <- rnorm(n = 100000, mean = 0, sd = 1)
If we plot a histogram of those numbers, we see the eponymous bell shaped distribution.
hist(y_norm, breaks = 100, main = "Normal distribution", xlab = "")
We already know the mean and the standard deviation of the
y_norm
vector, as we explicitly called the function
rnorm()
with mean = 0
and sd = 1
.
So, we just have to count those numbers of the y_norm
vector bigger than 1, and respectively smaller than -1, bigger than 2,
respectively -2, and 3, respectively -3, and relate them to the length
of the vector, in our case 100,000, to validate the three rules claimed
above.
sd1 <- sum(y_norm > -1 & y_norm < 1) / length(y_norm) * 100
sd2 <- sum(y_norm > -2 & y_norm < 2) / length(y_norm) * 100
sd3 <- sum(y_norm > -3 & y_norm < 3) / length(y_norm) * 100
cbind(c("1sd", "2sd", "3sd"), c(sd1, sd2, sd3))
## [,1] [,2]
## [1,] "1sd" "68.107"
## [2,] "2sd" "95.323"
## [3,] "3sd" "99.735"
Perfect match! The three empirical rules are obviously valid. To
visualize our findings we re-plot the histogram and add some
annotations. Please note that in the hist()
function we set
the argument freq = F
, which is the same as
freq = FALSE
. As a consequence, the resulting histogram
does not show counts on the y-axis anymore, but the
density values (normalized count divided by
bin width), which means that the bar areas sum to 1.
h <- hist(y_norm, breaks = 100, plot = F)
cuts <- cut(h$breaks, c(-Inf, -3, -2, -1, 1, 2, 3, Inf), right = F) # right = False;
# sets intervals to be open on the right closed on the left
plot(h,
col = rep(c("white", "4", "3", "2", "3", "4", "white"))[cuts],
main = "Normal distribution",
xlab = "",
freq = F,
ylim = c(0, 0.6)
)
lwd <- 3
# horizontal lines
lines(x = c(2, -2), y = c(0.48, 0.48), type = "l", col = 3, lwd = lwd)
lines(x = c(3, -3), y = c(0.55, 0.55), type = "l", col = 4, lwd = lwd)
lines(x = c(1, -1), y = c(0.41, 0.41), type = "l", col = 2, lwd = lwd)
# vertical lines
lines(x = c(1, 1), y = c(0, 0.41), type = "l", col = 2, lwd = lwd)
lines(x = c(-1, -1), y = c(0, 0.41), type = "l", col = 2, lwd = lwd)
lines(x = c(2, 2), y = c(0, 0.48), type = "l", col = 3, lwd = lwd)
lines(x = c(-2, -2), y = c(0, 0.48), type = "l", col = 3, lwd = lwd)
lines(x = c(3, 3), y = c(0, 0.55), type = "l", col = 4, lwd = lwd)
lines(x = c(-3, -3), y = c(0, 0.55), type = "l", col = 4, lwd = lwd)
# text
text(0, 0.44, "68 %", cex = 1.5, col = 2)
text(0, 0.51, "95 %", cex = 1.5, col = 3)
text(0, 0.58, "99.7 %", cex = 1.5, col = 4)
Well, now let us work on our 2nd task:
Validate the three empirical rules on the students
data
set. For this, we have to check whether any of the numeric variables in
the students
data set are normally distributed. We start by
extracting numeric variables of interest from the students
data set. Then we check the data set by calling the function
head()
.
cont_vars <- c("age", "nc.score", "height", "weight", "score1", "score2", "salary")
students_quant <- students[, cont_vars]
head(students_quant, 10)
## age nc.score height weight score1 score2 salary
## 1 19 1.91 160 64.8 NA NA NA
## 2 19 1.56 172 73.0 NA NA NA
## 3 22 1.24 168 70.6 45 46 NA
## 4 19 1.37 183 79.7 NA NA NA
## 5 21 1.46 175 71.4 NA NA NA
## 6 19 1.34 189 85.8 NA NA NA
## 7 21 1.11 156 65.9 NA NA NA
## 8 21 2.03 167 65.7 58 62 NA
## 9 18 1.29 195 94.4 57 67 NA
## 10 18 1.19 165 66.0 NA NA NA
To get an overview of the shape of the distribution of each
particular variable, we apply the histogram()
function of
the lattice
package. If the lattice
package is
not yet installed on your computer, type
install.packages("lattice")
in your console. The coding is a
little bit different than for standard histograms.
library(lattice)
histogram(~ height + age + weight + nc.score + score1 + score2 + salary,
breaks = 50,
type = "density",
xlab = "",
ylab = "density",
layout = c(4, 2),
scales = list(relation = "free"),
col = "black",
data = students_quant
)
We immediately realize that some variables are positively skewed, thus we exclude them and keep those that appear to be normally distributed.
histogram(~ height + salary,
breaks = 50,
type = "density",
xlab = "",
ylab = "density",
layout = c(2, 1),
scales = list(relation = "free"),
col = "black",
data = students_quant
)
Both the height
and the salary
variable
seem to more or less follow a normal distribution. So, the choice which
to pick for further analysis is a matter of taste. For now, we stick to
the salary
variable and check, if the three empirical rules
claimed above are valid. Let us switch to R and validate those rules by
calculating the mean and the standard deviations first. Please note,
that the salary
variable includes empty cells marked by
NA
. Thus, we first exclude all NA
values by
applying the na.omit()
function.
salary_vector <- na.omit(students$salary)
# calculate mean
salary_vector_mean <- mean(salary_vector)
# calculate standard deviations
salary_vector_sd1_pos <- salary_vector_mean + sd(salary_vector)
salary_vector_sd2_pos <- salary_vector_mean + sd(salary_vector) * 2
salary_vector_sd3_pos <- salary_vector_mean + sd(salary_vector) * 3
salary_vector_sd1_neg <- salary_vector_mean - sd(salary_vector)
salary_vector_sd2_neg <- salary_vector_mean - sd(salary_vector) * 2
salary_vector_sd3_neg <- salary_vector_mean - sd(salary_vector) * 3
As in the generic example from above, we count the number of values, which are bigger than +1 s.d., respectively smaller than -1 s.d., and +2 s.d., respectively -2 s.d., and +3 s.d., respectively -3 s.d., and relate them to the length of the vector, in our case 1753.
salary_sd1 <- 100 - sum(salary_vector > salary_vector_sd1_pos | salary_vector < salary_vector_sd1_neg) /
length(salary_vector) * 100
salary_sd2 <- 100 - sum(salary_vector > salary_vector_sd2_pos | salary_vector < salary_vector_sd2_neg) /
length(salary_vector) * 100
salary_sd3 <- 100 - sum(salary_vector > salary_vector_sd3_pos | salary_vector < salary_vector_sd3_neg) /
length(salary_vector) * 100
cbind(c("1sd", "2sd", "3sd"), c(round(sd1), round(sd2), round(sd3, 1)), c(salary_sd1, salary_sd2, salary_sd3))
## [,1] [,2] [,3]
## [1,] "1sd" "68" "67.0849971477467"
## [2,] "2sd" "95" "95.6075299486594"
## [3,] "3sd" "99.7" "99.7718197375927"
Wow, quite close! Obviously the salary
variable shows a
strong tendency to support the so called empirical rule. We plot the
histogram of the salary
variable to confirm our impression.
We colorize the standard deviations for a better visual impression.
There are several ways to pick a particular color in R. In this code
example we use the color name “white” (type colors()
in
your console to see a full list of colors) and combine it with numbers
2, 3, 4, a shortcut for accessing the colors of the standard color
palette (type palette()
in your console to see the list of
colors in the standard color palette).
h <- hist(salary_vector, breaks = 100, plot = F)
x_vector2plot <- seq(salary_vector_sd3_neg * 0.9, salary_vector_sd3_pos * 1.1, 1)
cuts <- cut(h$breaks, c(
-Inf,
salary_vector_sd1_neg,
salary_vector_sd2_neg,
salary_vector_sd3_neg,
salary_vector_sd1_pos,
salary_vector_sd2_pos,
salary_vector_sd3_pos,
Inf
))
plot(h,
col = rep(c("white", "4", "3", "2", "3", "4", "white"))[cuts],
main = "Normal distribution",
xlab = "Annual Salary in EUR",
freq = F
)
# add legend
legend(
x = min(x_vector2plot) * 1.1,
y = max(h$density) * 0.9,
legend = c("1 s.d.", "2 s.d.", "3 s.d."),
col = c(2, 3, 4),
pch = 15
)
We can now extend our visualization approach by plotting the
empirical density estimate, using the
density()
function, and checking its shape. We display the
empirical density estimate as a dashed line by setting the line type argument lty = 2
with a line
width of 3 (argument lwd = 3
).
h <- hist(salary_vector, breaks = 100, plot = F)
x_vector2plot <- seq(salary_vector_sd3_neg * 0.9, salary_vector_sd3_pos * 1.1, 1)
cuts <- cut(h$breaks, c(
-Inf,
salary_vector_sd1_neg,
salary_vector_sd2_neg,
salary_vector_sd3_neg,
salary_vector_sd1_pos,
salary_vector_sd2_pos,
salary_vector_sd3_pos,
Inf
))
plot(h,
col = rep(c("white", "4", "3", "2", "3", "4", "white"))[cuts],
main = "Normal distribution",
xlab = "Annual Salary in EUR",
freq = F
)
# add empirical density
lines(density(salary_vector), col = "black", lty = 2, lwd = 3)
# add legend
legend(
x = min(x_vector2plot) * 1.1,
y = max(h$density) * 0.9,
legend = c("1 s.d.", "2 s.d.", "3 s.d.", "emp. density"),
col = c(2, 3, 4, "black"),
lty = c(NA, NA, NA, 2),
lwd = c(NA, NA, NA, 2),
pch = c(15, 15, 15, NA),
cex = 0.7
)
Finally, we compare our empirical density estimate
to the theoretical probability density function based
on the actual mean and standard deviation of the data
(salary_vector
). For a better visual comparison, we switch
back to a non-colorized histogram plot.
h <- hist(salary_vector, breaks = 100, plot = F)
x_vector2plot <- seq(salary_vector_sd3_neg * 0.9, salary_vector_sd3_pos * 1.1, 1)
plot(h,
main = "Normal distribution",
xlab = "Annual Salary in EUR",
freq = F
)
# add pdf
lines(x_vector2plot,
# dnorm() function, returns the probability density function (pdf) of the normal distribution
dnorm(
x = x_vector2plot,
mean = salary_vector_mean,
sd = sd(salary_vector)
),
lwd = 3,
col = "red"
)
# add empirical density
lines(density(salary_vector), col = "black", lty = 2, lwd = 3)
# add legend
legend(
x = min(x_vector2plot) * 1.1,
y = max(h$density) * 0.9,
legend = c("pdf", "emp. density"),
col = c("red", "black"),
lty = c(1, 2),
lwd = 2,
cex = 0.7
)
We may conclude, that the salary
variable in the
students
data set is roughly normally distributed. However,
the plot indicates that the distribution of the salary
variable is slightly skewed to the left. We can see that by the small
deviation between the empirical density estimate and
the probability density function.
Citation
The E-Learning project SOGA-R was developed at the Department of Earth Sciences by Kai Hartmann, Joachim Krois and Annette Rudolph. You can reach us via mail by soga[at]zedat.fu-berlin.de.
Please cite as follow: Hartmann, K., Krois, J., Rudolph, A. (2023): Statistics and Geodata Analysis using R (SOGA-R). Department of Earth Sciences, Freie Universitaet Berlin.