STA2020F – Applied Statistics

Tutorial Nine: Non-Paramatrics

QUESTION 1

Polygraphs (lie detectors) are increasingly being used in many different areas of work. These machines depend on measuring small changes in the skin potential as a subject is asked a series of questions. The data below come from a bigger study in which independent groups of people were measured when feeling emotions of fear, happiness, depression and calmness.

Fear 23.1 57.6 10.5
Happiness 22.7 53.2 9.7 19.6
Depression 22.5 53.7 31.0
Vailidity 14.8 13.3

  1. Use a suitable nonparametric test to investigate possible differences in location between these four groups. Conduct the test at a 1% significance level, and use the p-value approach.

    A Kruskal-Wallis test seems appropriate here because we are trying to determine whether the polygraph scores between the four groups have the same central location (median). There is no blocking variable, and so we do not consider a Friedman test, and there is independence within and between the four groups.

    For the hypothesis test, we have the following

    \[ H_{0}: \text{the ploygraph scores are the same across all four groups} \]

    \[ H_{1}: \text{at least one group differs in polygraph scores} \]

    we are testing at the \(1\%\) significance level. To calculate the test statistic manually, we have the following:

    Fear 23.1 (8) 57.6 (12) 10.5 (2)
    Happiness 22.7 (7) 53.2 (10) 9.7 (1) 19.6 (5)
    Depression 22.5 (6) 53.7 (11) 31.0 (9)
    Vailidity 14.8 (4) 13.3 (3)

    From this, we find that the sum of ranks are \(T_{1}=22\), \(T_{2}=23\), \(T_{3}=26\), and \(T_{4}=7\). Noting that \(n_{T}=12\), we find that the test statistic is

    \[ H=\left[\frac{12}{12(12+1)}\left(\frac{22^{2}}{3}+\frac{23^{2}}{4}+\frac{26^{2}}{3}+\frac{7^{2}}{2}\right)\right]-3(12+1)\approx2.801 \]

    the \(p\)-value for this test statistic will then be

    ###############
# PVALUE 
###############

k <- 4
p <- pchisq(2.801, df=k-1, lower.tail=FALSE)
p
    [1] 0.4233353

    Using R, we have the following

    #############################
# KRUSKAL-WALLIS TEST IN R
#############################

# creating the data frame
Emotions <- c(rep("Fear", 3), rep("Happiness", 4),
              rep("Depression", 3), rep("Validity", 2))
Poly_Score <- c(23.1, 57.6, 10.5, 22.7, 53.2, 9.7, 19.6, 
                     22.5, 53.7, 31.0, 14.8, 13.3)
dat <- data.frame(Emotions, Poly_Score)

# ranking 
dat$ranks <- rank(dat$Poly_Score, ties.method="average")

# sum of ranks for each group
sumranks <- aggregate(ranks ~ Emotions, data=dat, sum)

# test statistic
counts <- table(dat$Emotions) # counts up the occurrence of each sample

fear <- (sum(dat$ranks[dat$Emotions == "Fear"])^2)/counts["Fear"]
happy <- (sum(dat$ranks[dat$Emotions == "Happiness"])^2)/counts["Happiness"]
depr <- (sum(dat$ranks[dat$Emotions == "Depression"])^2)/counts["Depression"]
val <- (sum(dat$ranks[dat$Emotions == "Validity"])^2)/counts["Validity"]

total <- nrow(dat)
addition <- sum(fear, happy, depr, val)

H <- ((12/(total*(total+1)))*addition)-3*(total+1)
H
    [1] 2.801282
    # p value 

p <- pchisq(H, df=k-1, lower.tail=FALSE)
p
    [1] 0.4232889
    ############################
# USING FUNCTIONS
############################

kruskal.test(Poly_Score ~ Emotions, data = dat) 
    
    Kruskal-Wallis rank sum test

data:  Poly_Score by Emotions
Kruskal-Wallis chi-squared = 2.8013, df = 3, p-value = 0.4233

    As a result, we fail to reject the null hypothesis since the \(p\)-value is greater than the imposed significance level. We conclude that there is no significance evidence of a difference in the polygraph scores between people who feel different emotions.

  2. Does the above data meet the requirements necessary to assume that the test statistic follows a chi-squared distribution? Comment on the implications of your answer with respect to the validity of the test

    No. One of the groups only has \(2\) observations whilst the requirement is that each group contains, at least, \(3\). This gives us a reason to doubt the validity of the \(p\)-value we have calculated since this violates the requirement of the test.

Question 2

Each year the employees of a large firm are assessed for performance on a 7-point scale where 1 = very unsatisfactory and 7 = excellent. Management believes the assessment scores this year are related to last year’s. To test this belief a random sample of 10 employees’ scores from last year is drawn and the same employees’ scores from this year are recorded. Do the data below support (at the 5% level) the management’s belief? Identify (with reasons) and conduct a suitable statistical test, using a critical value.

This is consistent with the structure of a Spearman Rank Correlation Test. We are trying to determine whether there is correlation between last year’s score and this year’s scores. We have the following hypotheses:

\[ H_{0}:\text{there is no association between this year's and last year's scores} \]

\[ H_{1}: \text{there is some association between this year's and last year's scores} \]

We are testing at the \(5\%\) significant level. To find the test statistic, we will do the following:

##################################
# SPEARMAN RANK CORRELATION TEST
##################################

# forming data structure
now <- c(5, 6, 4, 5, 5, 4, 7, 6, 4, 5)
before <- c(5, 5, 3, 3, 4, 3, 4, 2, 6, 1)

df <- data.frame(now, before)

# we begin the SRCT test by first finding the test statistic
# we, therefore have the following

# ranking
df$rank_now <- rank(df$now)
df$rank_before <- rank(df$before)

# differences 
df$differences <- df$rank_now - df$rank_before

# sum of squared differences

df$sqdiff <- (df$differences)^2
ssdif <- sum(df$sqdiff)

# test stat
n <- 10

r <- 1-((6*ssdif)/(n*(n^2-1)))
r
[1] 0.03636364
# z score
z <- r*sqrt(n-1)
z
[1] 0.1090909
#critical value
zcrit <- qnorm(0.025, lower.tail = FALSE)
zcrit
[1] 1.959964
###################################
# USING FUNCTIONS
###################################

cor.test(df$now, df$before, exact=FALSE, method="spearman")

    Spearman's rank correlation rho

data:  df$now and df$before
S = 169.81, p-value = 0.9363
alternative hypothesis: true rho is not equal to 0
sample estimates:
        rho 
-0.02913858

We fail reject the null hypothesis at the \(5\%\) significance level since the test statistic calculated is less extreme than the critical value. As a result, we conclude that there is no evidence of an association between the scores from last year and this year.

Question 3

A well-known soft drink manufacturer has used the same secret recipe for its product since its introduction more than 100 years ago. In response to decreasing market share, however, the president of the company is contemplating changing the recipe. She has developed two alternative recipes. In a preliminary study, she asked 15 randomly selected people to taste the original recipe and the two new recipes. Each person was then asked to evaluate the product on a 5-point scale, where 1=awful, 2=poor, 3=fair, 4=good and 5=wonderful. The data is shown below:

A Friedman test is appropriate here because we are trying to measure whether the recipes are perceived to be different or not. The measurements for each person who tastes these flavours are dependent, but the meausrements between different people are independent. This rules out a Kruskal-Wallis test.

The treatments are the different flavours, and the blocks are the individual people asked to taste the different recipes of the soft drink.

###################
# FRIEDMAN TEST
###################

# creating the data frame 
original <- c(5, 3, 4, 2, 3, 2, 4, 5, 1, 1, 2, 3, 5, 3, 4)
recipe_one <- c(5, 4, 5, 4, 3, 2, 3, 3, 1, 3, 4, 3, 3, 2, 3)
recipe_two <- c(5, 5, 5, 4, 5, 3, 2, 5, 1, 2, 3, 4, 4, 3, 5)

drink_data <- data.frame(original, recipe_one, recipe_two)

# ranking 
ranks <- t(apply(drink_data, 1, rank)) # transposes the ranking matrix

# sum of ranks
sum_ranks <- colSums(ranks)

sr_original <- sum_ranks[1]
sr_recipe1 <- sum_ranks[2]
sr_recipe2 <- sum_ranks[3]

# test statistic
b <- nrow(drink_data)
k <- 3
sumsq <- sum((sr_original)^2,(sr_recipe1)^2,(sr_recipe2)^2)

fried <- ((12/(b*k*(k+1)))*sumsq)-(3*b*(k+1))
fried
[1] 3.633333
# critical region and p-value
pval <- pchisq(fried, df=k-1, lower.tail=F)
pval
[1] 0.1625667
#####################
# USING R FORMULAE
#####################

friedman.test(as.matrix(drink_data))

    Friedman rank sum test

data:  as.matrix(drink_data)
Friedman chi-squared = 4.8444, df = 2, p-value = 0.08872
# Note: friedman.test() applies a tie correction automatically,
# so its result may differ slightly from the manual calculation.

At the \(1\%\) significance level, we fail to reject the null hypothesis since the \(p\)-value for our test statistic is greater than \(1\%\). We, therefore, conclude that there is no significant evidence of a difference in popularity between the different recipes for the soft drink.