R Notebook
LAB REPORT 3 SMS
Name: NUR FARAHIEMAH BINTI AB RAHIN
ID: SD23068
Section: 01G
# Load packages
library(dplyr)##
## Attaching package: 'dplyr'## The following objects are masked from 'package:stats':
##
## filter, lag## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, unionlibrary(ggplot2)
library(pscl)## Classes and Methods for R originally developed in the
## Political Science Computational Laboratory
## Department of Political Science
## Stanford University (2002-2015),
## by and under the direction of Simon Jackman.
## hurdle and zeroinfl functions by Achim Zeileis.library(pROC)## Type 'citation("pROC")' for a citation.##
## Attaching package: 'pROC'## The following objects are masked from 'package:stats':
##
## cov, smooth, varlibrary(caret)## Loading required package: lattice# ============================================
# 1. DATA GENERATION
# ============================================
set.seed(2501)
n <- 200
knowledge_score <- pmin(pmax(rnorm(n, mean = 6, sd = 2), 0), 10)
campaign_exposure <- rbinom(n, 1, 0.45)
household_size <- sample(1:9, n, replace = TRUE)
# True logistic model used for simulation
logit_p <- -1 +
0.35 * knowledge_score +
0.90 * campaign_exposure -
0.12 * household_size +
0.18 * (knowledge_score * campaign_exposure)
prob <- plogis(logit_p)
preventive_measures <- rbinom(n, 1, prob)
d <- data.frame(
knowledge_score,
campaign_exposure,
household_size,
preventive_measures
)
head(d)# ============================================
# 2. DESCRIPTIVE STATISTICS
# ============================================
summary(d)## knowledge_score campaign_exposure household_size preventive_measures
## Min. : 0.000 Min. :0.00 Min. :1.000 Min. :0.000
## 1st Qu.: 4.636 1st Qu.:0.00 1st Qu.:2.000 1st Qu.:0.000
## Median : 5.975 Median :0.00 Median :4.000 Median :1.000
## Mean : 6.044 Mean :0.37 Mean :4.545 Mean :0.675
## 3rd Qu.: 7.503 3rd Qu.:1.00 3rd Qu.:7.000 3rd Qu.:1.000
## Max. :10.000 Max. :1.00 Max. :9.000 Max. :1.000table(d$campaign_exposure)##
## 0 1
## 126 74table(d$preventive_measures)##
## 0 1
## 65 135INTERPRETATION:
The descriptive statistics show that participants generally had moderate to high levels of knowledge about disease prevention, with a mean knowledge score of 6.04 out of 10. The scores ranged from 0 to 10, indicating some respondents had very low knowledge, but most fell between approximately 4.6 and 7.5.
Household size varied widely across the sample, ranging from 1 to 9 members, with an average household consisting of about 4 to 5 people. This suggests a mix of both small and large families within the dataset.
For the categorical variables, the majority of respondents (126 individuals) reported no exposure to the awareness campaign, while 74 individuals did receive campaign exposure. This distribution provides a meaningful comparison group to assess the campaign’s effect.
In terms of preventive behaviour, 135 respondents (67.5%) reported engaging in preventive measures, while 65 respondents (32.5%) did not. This indicates that most participants practiced some form of protective behaviour.
Overall, the descriptive statistics suggest that the sample consists mostly of individuals with relatively good knowledge, moderate household sizes, and high levels of preventive action, while exposure to the campaign remains less common.
# ============================================
# 3. MODEL 1: LOGISTIC REGRESSION (NO INTERACTION)
# ============================================
model1 <- glm(
preventive_measures ~ knowledge_score +
campaign_exposure +
household_size,
data = d,
family = binomial
)
summary(model1)##
## Call:
## glm(formula = preventive_measures ~ knowledge_score + campaign_exposure +
## household_size, family = binomial, data = d)
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -1.78119 0.62706 -2.841 0.0045 **
## knowledge_score 0.36027 0.09185 3.923 8.76e-05 ***
## campaign_exposure 1.74510 0.40740 4.284 1.84e-05 ***
## household_size -0.02713 0.06753 -0.402 0.6879
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 252.23 on 199 degrees of freedom
## Residual deviance: 213.25 on 196 degrees of freedom
## AIC: 221.25
##
## Number of Fisher Scoring iterations: 4INTERPRETATION:
The results of Model 1 show that both knowledge score and campaign exposure are significant predictors of preventive behaviour, while household size does not appear to influence the outcome. The coefficient for knowledge score (β = 0.360, p < 0.001) indicates that individuals with higher knowledge levels are significantly more likely to engage in preventive measures. In other words, as a person’s knowledge increases, their probability of practicing preventive actions also increases.
Campaign exposure also shows a strong and significant effect (β = 1.745, p < 0.001), suggesting that respondents who were exposed to the awareness campaign were much more likely to take preventive measures compared to those who were not exposed. This highlights the effectiveness of campaign efforts in promoting positive health behaviors.
On the other hand, household size has a negative but non-significant coefficient (β = –0.027, p = 0.688), meaning that family size does not have a meaningful statistical relationship with preventive behavior in this sample. Overall, the model demonstrates that knowledge and campaign exposure play key roles in shaping preventive actions, while household size does not contribute significantly to the prediction.
# ============================================
# 4. ODDS RATIOS (MODEL 1)
# ============================================
or1 <- exp(cbind(OR = coef(model1), confint.default(model1)))
or1## OR 2.5 % 97.5 %
## (Intercept) 0.1684376 0.04928204 0.5756908
## knowledge_score 1.4337220 1.19752409 1.7165072
## campaign_exposure 5.7264535 2.57696653 12.7251439
## household_size 0.9732386 0.85258390 1.1109679INTERPRETATION:
The odds ratio results show that knowledge score has a meaningful and statistically significant effect on preventive behaviour. Specifically, the odds ratio of 1.43 indicates that for every one-unit increase in knowledge score, the odds of taking preventive measures increase by approximately 43%. Because the confidence interval (1.20–1.72) does not include 1, this confirms that higher knowledge consistently leads to greater likelihood of preventive action.
Campaign exposure also shows a strong and significant influence, with an odds ratio of 5.73. This means that individuals who were exposed to the awareness campaign have almost six times higher odds of engaging in preventive measures compared to those who were not exposed. The wide confidence interval (2.58–12.73), which remains above 1, further supports the strong positive impact of campaign exposure.
On the other hand, household size has an odds ratio of 0.97, suggesting a very small and non-significant decrease in the odds of taking preventive measures as household size increases. Since the confidence interval (0.85–1.11) includes 1, household size does not appear to have any meaningful effect on preventive behaviour in this model.
Overall, these odds ratio results indicate that knowledge level and campaign exposure are important factors that increase the likelihood of preventive action, while household size does not play a significant role.
# ============================================
# 5. MODEL 1 DIAGNOSTICS
# ============================================
# Predicted probabilities
prob1 <- predict(model1, type = "response")
# ROC + AUC
roc1 <- roc(d$preventive_measures, prob1)## Setting levels: control = 0, case = 1## Setting direction: controls < casesauc(roc1)## Area under the curve: 0.7589plot(roc1, col = "hotpink", main = "ROC Curve: Model 1")
# Confusion matrix at threshold 0.5
pred1_class <- ifelse(prob1 >= 0.5, 1, 0)
confusionMatrix(factor(pred1_class), factor(d$preventive_measures), positive = "1")## Confusion Matrix and Statistics
##
## Reference
## Prediction 0 1
## 0 27 18
## 1 38 117
##
## Accuracy : 0.72
## 95% CI : (0.6523, 0.781)
## No Information Rate : 0.675
## P-Value [Acc > NIR] : 0.09859
##
## Kappa : 0.3065
##
## Mcnemar's Test P-Value : 0.01112
##
## Sensitivity : 0.8667
## Specificity : 0.4154
## Pos Pred Value : 0.7548
## Neg Pred Value : 0.6000
## Prevalence : 0.6750
## Detection Rate : 0.5850
## Detection Prevalence : 0.7750
## Balanced Accuracy : 0.6410
##
## 'Positive' Class : 1
## # Manual McFadden R2
ll_null <- model1$null.deviance / -2
ll_model <- model1$deviance / -2
1 - (ll_model / ll_null)## [1] 0.1545657# AIC
AIC(model1)## [1] 221.2459The ROC curve for Model 1 demonstrates that the model has good discriminatory ability in predicting whether individuals engage in preventive measures. The curve rises well above the diagonal reference line, indicating that the model performs substantially better than random guessing. This pattern shows that Model 1 is able to correctly distinguish between individuals who take preventive actions and those who do not. Overall, the ROC curve suggests that Model 1 has a strong classification performance.
# ============================================
# 6. MODEL 2: LOGISTIC REGRESSION WITH INTERACTION
# ============================================
model2 <- glm(
preventive_measures ~ knowledge_score * campaign_exposure +
household_size,
data = d,
family = binomial
)
summary(model2)##
## Call:
## glm(formula = preventive_measures ~ knowledge_score * campaign_exposure +
## household_size, family = binomial, data = d)
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -1.36987 0.66411 -2.063 0.03914 *
## knowledge_score 0.29689 0.09684 3.066 0.00217 **
## campaign_exposure -0.39588 1.41509 -0.280 0.77966
## household_size -0.03376 0.06803 -0.496 0.61974
## knowledge_score:campaign_exposure 0.42153 0.27782 1.517 0.12920
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 252.23 on 199 degrees of freedom
## Residual deviance: 210.61 on 195 degrees of freedom
## AIC: 220.61
##
## Number of Fisher Scoring iterations: 5INTERPRETATION:
Model 2 includes an interaction term between knowledge score and campaign exposure to examine whether the effect of knowledge on preventive behaviour varies depending on campaign exposure. The results show that knowledge score remains a significant predictor (β = 0.297, p = 0.002), meaning that individuals with higher knowledge levels are still more likely to engage in preventive measures, even after accounting for the interaction.
Campaign exposure alone is not statistically significant in this model (β = –0.396, p = 0.780), suggesting that when the interaction term is included, the direct effect of campaign exposure by itself is no longer strong enough to predict preventive behaviour. Similarly, household size remains non-significant (β = –0.034, p = 0.620), indicating that it does not play a meaningful role in predicting preventive actions.
The interaction term between knowledge score and campaign exposure is positive but not statistically significant (β = 0.422, p = 0.129). This means that although the relationship suggests that the positive effect of knowledge on preventive behaviour may be slightly stronger for individuals who were exposed to the campaign, the evidence is not strong enough to conclude that a true interaction effect exists.
Overall, Model 2 shows that knowledge score continues to be the most important predictor, while campaign exposure and household size do not significantly impact preventive behaviour when considered together with the interaction term. The non-significant interaction suggests that campaign exposure does not meaningfully change or enhance the effect of knowledge on preventive behaviour.
# ============================================
# 7. ODDS RATIOS (MODEL 2)
# ============================================
or2 <- exp(cbind(OR = coef(model2), confint.default(model2)))
or2## OR 2.5 % 97.5 %
## (Intercept) 0.2541392 0.06914813 0.9340343
## knowledge_score 1.3456672 1.11304178 1.6269113
## campaign_exposure 0.6730859 0.04202829 10.7795150
## household_size 0.9668046 0.84611688 1.1047070
## knowledge_score:campaign_exposure 1.5242947 0.88427097 2.6275593INTERPRETATION:
The odds ratio for knowledge score is 1.35, meaning that for every one-unit increase in knowledge, the odds of engaging in preventive behaviour increase by approximately 35%. The confidence interval (1.11–1.63) does not include 1, indicating that this effect is statistically significant even after considering the interaction term.
The odds ratio for campaign exposure is 0.67, suggesting that individuals who were exposed to the campaign have lower odds of taking preventive measures compared to those who were not exposed. However, the confidence interval is very wide (0.04–10.78) and includes 1, meaning this effect is not statistically reliable. Therefore, campaign exposure alone does not significantly influence preventive behaviour in Model 2.
For household size, the odds ratio is 0.97, indicating a negligible reduction in the odds of engaging in preventive behaviour as household size increases. Since the confidence interval (0.85–1.10) includes 1, household size remains a non-significant predictor.
The odds ratio for the interaction term (knowledge_score × campaign_exposure) is 1.52, implying that the effect of knowledge on preventive behaviour may be stronger among individuals who were exposed to the campaign. However, because the confidence interval (0.88–2.63) crosses 1, this interaction is not statistically significant. This means we cannot conclude that campaign exposure meaningfully changes the influence of knowledge on preventive behaviour.
Overall, the odds ratios show that knowledge score is the only consistent and significant predictor, while campaign exposure, household size, and the interaction term do not significantly affect preventive behaviour in Model 2.
# ============================================
# 8. MODEL 2 DIAGNOSTICS
# ============================================
prob2 <- predict(model2, type = "response")
roc2 <- roc(d$preventive_measures, prob2)## Setting levels: control = 0, case = 1## Setting direction: controls < casesauc(roc2)## Area under the curve: 0.7624plot(roc2, col = "pink", main = "ROC Curve: Model 2")
pred2_class <- ifelse(prob2 >= 0.5, 1, 0)
confusionMatrix(factor(pred2_class), factor(d$preventive_measures), positive = "1")## Confusion Matrix and Statistics
##
## Reference
## Prediction 0 1
## 0 26 17
## 1 39 118
##
## Accuracy : 0.72
## 95% CI : (0.6523, 0.781)
## No Information Rate : 0.675
## P-Value [Acc > NIR] : 0.098590
##
## Kappa : 0.3004
##
## Mcnemar's Test P-Value : 0.005012
##
## Sensitivity : 0.8741
## Specificity : 0.4000
## Pos Pred Value : 0.7516
## Neg Pred Value : 0.6047
## Prevalence : 0.6750
## Detection Rate : 0.5900
## Detection Prevalence : 0.7850
## Balanced Accuracy : 0.6370
##
## 'Positive' Class : 1
## # Manual McFadden R2
ll_null2 <- model2$null.deviance / -2
ll_model2 <- model2$deviance / -2
1 - (ll_model2 / ll_null2)## [1] 0.1650196AIC(model2)## [1] 220.6091The ROC curve for Model 2 shows a clear improvement over the diagonal reference line, indicating that the model is able to distinguish between individuals who do and do not adopt preventive measures. The curve bends upward toward the top-left corner, showing good sensitivity across various specificity levels. The AUC value (Area Under the Curve), which summarises overall discriminative ability, indicates that Model 2 performs reasonably well in classifying the outcome, suggesting that adding the interaction term helps capture additional predictive information, although the improvement is modest.
# ============================================
# 9. LIKELIHOOD RATIO TEST (MODEL COMPARISON)
# ============================================
anova(model1, model2, test = "Chisq")The likelihood ratio test compares Model 1 and Model 2 to determine whether adding the interaction term (knowledge_score × campaign_exposure) significantly improves model fit. The test shows a deviance difference of 2.6368 with 1 degree of freedom, yielding a p-value of 0.1044. Since this p-value is greater than 0.05, the improvement in model fit is not statistically significant. In simpler terms, including the interaction term does not provide enough additional explanatory power to justify its inclusion.
# ============================================
# 10. INTERACTION VISUALIZATION
# ============================================
grid <- expand.grid(
knowledge_score = seq(
min(d$knowledge_score, na.rm = TRUE),
max(d$knowledge_score, na.rm = TRUE),
length.out = 100
),
campaign_exposure = c(0, 1),
household_size = mean(d$household_size, na.rm = TRUE)
)
grid$pred <- predict(model2, newdata = grid, type = "response")
print(
ggplot(grid, aes(x = knowledge_score, y = pred,
color = factor(campaign_exposure))) +
geom_line(size = 1.3) +
labs(
title = "Interaction Plot: Knowledge × Campaign Exposure",
x = "Knowledge Score",
y = "Predicted Probability",
color = "Campaign Exposure"
) +
theme_minimal()
)## Warning: Using `size` aesthetic for lines was deprecated in ggplot2 3.4.0.
## ℹ Please use `linewidth` instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.
The interaction plot illustrates how the predicted probability of practicing dengue preventive measures changes with increasing knowledge scores for individuals who were exposed to the campaign compared with those who were not. As knowledge increases, both groups show a strong upward trend in the likelihood of adopting preventive behaviors, but the pattern differs noticeably between them. Individuals who were exposed to the campaign (represented by the blue line) consistently have higher predicted probabilities across almost all knowledge levels. This advantage becomes especially pronounced at moderate to high knowledge scores, where the exposed group rises sharply toward probabilities close to 1.0, indicating near-certain adoption of preventive practices. In contrast, individuals who were not exposed to the campaign (the red line) still improve as knowledge increases, but at a slower rate and with a lower overall ceiling. The widening gap between the two lines at higher knowledge levels suggests that campaign exposure enhances the effect of knowledge, leading to greater preventive action among those who are both knowledgeable and aware of the campaign. Overall, this plot visually supports the idea that campaign exposure strengthens the influence of dengue-related knowledge on preventive behavior.