You may edit all and any parts of this document to prepare your report, except for #1 and #2 of the “Student Confirmation” statement chunk at the start of your report, and the word count chunk at the end of your report. Remember to complete #3 of the “Student Confirmation” statement chunk. Failure to do this will result application of penalties as described in the ICA guidance.
#Student Confirmation
#1.I hereby confirm that I have only used generative Artificial Intelligence (AI), such as ChatGPT, according to the rules set out in the instructions of this assessment. I acknowledge that using generative AI in a manner different to that stipulated will constitute an examination offence and will be formerly investigated as such.
#2.I hereby confirm that I have read the College and BMB guidance on the use of Generative AI, in addition to the academic misconduct policy (specifically, point 14i) and have used AI appropriately according to these guidelines and the rules stipulated by this assessment.
#3. DELETE AS APPLICABLE:
#I have not used Generative AI in this assessment
#OR
#I acknowledge the use of...
REPORT GOES HERE
To assess biomedical voice measurements (NHR, HNR, RPDE, spread2, D2, ,PPE) which could be used to diagnose Parkinson’s Disease and investigate the relationships between the six voice measures.
Impaired voice production (Dysphonia) is common in Parkinson’s disease. Measures of noise are used as indicatorrs of vocal impairment. The voice measurements: NHR, HNR, RPDE, spread2, D2, PPE are often correlated, so investigating the relationship of them can shows which could be used to predict others and which are redundant.
#visualizing the data
Parkinsons <-read.csv("parkinsons.csv", row.names = 1)
pairs(Parkinsons)
cor(Parkinsons)
## NHR HNR RPDE spread2 D2 PPE
## NHR 1.0000000 -0.7140724 0.3708905 0.3180990 0.4709488 0.5525913
## HNR -0.7140724 1.0000000 -0.5987363 -0.4315637 -0.6014010 -0.6928759
## RPDE 0.3708905 -0.5987363 1.0000000 0.4799045 0.2369314 0.5458857
## spread2 0.3180990 -0.4315637 0.4799045 1.0000000 0.5235317 0.6447110
## D2 0.4709488 -0.6014010 0.2369314 0.5235317 1.0000000 0.4805845
## PPE 0.5525913 -0.6928759 0.5458857 0.6447110 0.4805845 1.0000000
From the correlation coefficients, we can see that NHR and HNR have the strongest correlation of -0.71. Followed by PPE and HNR with -0.69, then spread2 and PPE with, +0.64
Object <- lm(NHR ~ HNR, data = Parkinsons)
plot(Object$residuals ~ Object$fitted.values, xlab = "fitted values", ylab = "residual values", main = "Fitted & Residual plot")
abline (h=0)
Here the distribution of the points is not random, on the left and right
ends, more points are above the line and in the middle, a lot of the
points are below the line.
Then we can try the second one.
Object2 <- lm(PPE ~ HNR, data = Parkinsons)
plot(Object2$residuals ~ Object2$fitted.values, xlab = "fitted values", ylab = "residual values", main = "Fitted & Residual plot 2")
abline (h=0)
The data points are not evenly distributed, with a majority of them on
the left. Let’s try another one!
Object3 <- lm(spread2 ~ PPE, data = Parkinsons)
plot(Object3$residuals ~ Object3$fitted.values, xlab = "fitted values", ylab = "residual values", main = "Fitted & Residual plot 3")
abline (h=0)
On this one, the plot is random, meaning it has a true linear
correlation. Therefore the regression equation is suitable.
PPE x D2: weak positive correlation. PPE x spread2: moderate positive correlation PPE x RPDE: moderate positive correlation PPE x HNR: moderate negative correlation PPE x NHR: moderate positive correlation
PPE x D2
#Getting summary stats
plot (PPE ~ D2, data = Parkinsons)
PPExD2 <- lm(PPE ~ D2, data = Parkinsons)
abline (PPExD2)
summary(PPExD2)
##
## Call:
## lm(formula = PPE ~ D2, data = Parkinsons)
##
## Residuals:
## Min 1Q Median 3Q Max
## -0.15632 -0.05571 -0.01118 0.04392 0.24191
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -0.06293 0.03585 -1.755 0.0808 .
## D2 0.11314 0.01486 7.613 1.16e-12 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.07923 on 193 degrees of freedom
## Multiple R-squared: 0.231, Adjusted R-squared: 0.227
## F-statistic: 57.96 on 1 and 193 DF, p-value: 1.158e-12
#residuals
plot(PPExD2$residuals ~ PPExD2$fitted.values, xlab = "fitted values", ylab = "residual values", main = "Fitted & Residual: PPE x D2")
abline (h=0)
PPE x spread2
plot (PPE ~ spread2, data = Parkinsons)
PPExspread2 <- lm(PPE ~ spread2, data = Parkinsons)
abline (PPExspread2)
summary(PPExspread2)
##
## Call:
## lm(formula = PPE ~ spread2, data = Parkinsons)
##
## Residuals:
## Min 1Q Median 3Q Max
## -0.146147 -0.045599 -0.008829 0.039457 0.207481
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.04876 0.01435 3.399 0.000822 ***
## spread2 0.69661 0.05945 11.717 < 2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.06907 on 193 degrees of freedom
## Multiple R-squared: 0.4157, Adjusted R-squared: 0.4126
## F-statistic: 137.3 on 1 and 193 DF, p-value: < 2.2e-16
plot(PPExspread2$residuals ~ PPExspread2$fitted.values, xlab = "fitted values", ylab = "residual values", main = "Fitted & Residual: PPE x spread2")
abline (h=0)
PPE x RPDE
plot (PPE ~ RPDE, data = Parkinsons)
PPExRPDE <- lm(PPE ~ RPDE, data = Parkinsons)
abline (PPExRPDE)
summary(PPExRPDE)
##
## Call:
## lm(formula = PPE ~ RPDE, data = Parkinsons)
##
## Residuals:
## Min 1Q Median 3Q Max
## -0.17308 -0.04932 -0.01385 0.03222 0.26055
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -0.02940 0.02663 -1.104 0.271
## RPDE 0.47329 0.05229 9.051 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.0757 on 193 degrees of freedom
## Multiple R-squared: 0.298, Adjusted R-squared: 0.2944
## F-statistic: 81.93 on 1 and 193 DF, p-value: < 2.2e-16
plot(PPExRPDE$residuals ~ PPExRPDE$fitted.values, xlab = "fitted values", ylab = "residual values", main = "Fitted & Residual: PPE x RPDE")
abline (h=0)
PPE x HNR
plot (PPE ~ HNR, data = Parkinsons)
PPExHNR <- lm(PPE ~ HNR, data = Parkinsons)
abline (PPExHNR)
summary(PPExHNR)
##
## Call:
## lm(formula = PPE ~ HNR, data = Parkinsons)
##
## Residuals:
## Min 1Q Median 3Q Max
## -0.146053 -0.046084 -0.006357 0.038739 0.202933
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.515333 0.023596 21.84 <2e-16 ***
## HNR -0.014109 0.001057 -13.35 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.06515 on 193 degrees of freedom
## Multiple R-squared: 0.4801, Adjusted R-squared: 0.4774
## F-statistic: 178.2 on 1 and 193 DF, p-value: < 2.2e-16
plot(PPExHNR$residuals ~ PPExHNR$fitted.values, xlab = "fitted values", ylab = "residual values", main = "Fitted & Residual: PPE x HNR")
abline (h=0)
PPE x NHR
plot (PPE ~ NHR, data = Parkinsons)
PPExNHR <- lm(PPE ~ NHR, data = Parkinsons)
abline (PPExNHR)
summary(PPExNHR)
##
## Call:
## lm(formula = PPE ~ NHR, data = Parkinsons)
##
## Residuals:
## Min 1Q Median 3Q Max
## -0.19286 -0.05393 -0.00577 0.04402 0.21888
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.175938 0.006335 27.774 <2e-16 ***
## NHR 1.232090 0.133764 9.211 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.0753 on 193 degrees of freedom
## Multiple R-squared: 0.3054, Adjusted R-squared: 0.3018
## F-statistic: 84.84 on 1 and 193 DF, p-value: < 2.2e-16
plot(PPExNHR$residuals ~ PPExNHR$fitted.values, xlab = "fitted values", ylab = "residual values", main = "Fitted & Residual: PPE x NHR")
abline (h=0)
PPE x spread2 is the best graph to use to predict the values of PPE. This is because it has the strongest correlation coefficient, and the residuals x fitted graph shows that the data is suitbale to use for a regression equation as there is a random distribution.
#loading the new data
p_new <-read.csv("parkinsons_new.csv", row.names = 1)
newdata <- data.frame(spread2 = c(0.008, 0.034, 0.55))
predict(PPExspread2, newdata, interval = "confidence")
## fit lwr upr
## 1 0.05433613 0.02691887 0.08175338
## 2 0.07244787 0.04785598 0.09703975
## 3 0.43189632 0.39272884 0.47106379
so coordinates would be: 0.008, 0.0543 0.034, 0.072 0.55, 0.432
plot (PPE ~ spread2, data = Parkinsons, xlim = c(0, 0.6), ylim = c(0, 0.45))
PPExspread2 <- lm(PPE ~ spread2, data = Parkinsons)
abline (PPExspread2)
points(0.008, 0.0543, col = "red")
points(0.034,0.072, col = "red")
points(0.55, 0.432, col = "red")
#Discussion All 5 variables have association with PPE. HNR has the R^2 value of 0.480 but some data points were not randomly scattered so linear model is not suitable for it. Spread2 has a lower R^2 value of 0.416 but it has random residuals so it is chosen to be the predictor. However, the rediction at spread2 = 0.55 may be an extrapolation and not using the original data so only three new readings were available.
#Conclusion spread2 was the most suitable predictor of PPE with a r value of 0.645, but its predictions are only comparatively reliable.
END OF REPORT - followed by this chunk:
#word count chunk - the number under "words" is your official word count
if (!require("rmdwc")) {
install.packages("rmdwc")
library(rmdwc)
}
## Loading required package: rmdwc
rmdcountAddin()
## $code
## [1] "data.frame(file='Group24 copied.Rmd', lines=96, words=560, bytes=3471, chars=3467, nonws=2842)"
## attr(,"class")
## [1] "rs.scalar"
##
## $echo
## [1] FALSE
## attr(,"class")
## [1] "rs.scalar"
##
## $execute
## [1] TRUE
## attr(,"class")
## [1] "rs.scalar"
##
## $focus
## [1] TRUE
## attr(,"class")
## [1] "rs.scalar"
##
## $animate
## [1] FALSE
## attr(,"class")
## [1] "rs.scalar"
##
## $language
## [1] "R"
#BIBLIOGRAPHY 1.National Health Service (NHS). Parkinson’s disease [Internet]. NHS. NHS; 2022 [cited 2026 Oct 29]. Available from: https://www.nhs.uk/conditions/parkinsons-disease/ 2.Xiu N, Li W, Liu L, Liu Z, Zhuo C, Li L, et al. A study on voice measures in patients with Parkinson’s disease. Journal of Voice [Internet]. 2024 June 17 [cited 2026 Oct 29];. Available from: https://www.sciencedirect.com/science/article/pii/S0892199724001681