set.seed(2025)
pop <- data.frame(
exam_score = round(rnorm(5000, mean = 72, sd = 10)),
pass = rbinom(5000, 1, 0.7)
)
head(pop)
## exam_score pass
## 1 78 0
## 2 72 1
## 3 80 0
## 4 85 0
## 5 76 1
## 6 70 0
#a/Tampilkan 6 baris pertama, ringkasan statistik (mean, sd, min, maks) exam_score, dan histogramnya.
head(pop)
## exam_score pass
## 1 78 0
## 2 72 1
## 3 80 0
## 4 85 0
## 5 76 1
## 6 70 0
mean_pop <- mean(pop$exam_score)
sd_pop <- sd(pop$exam_score)
min_pop <- min(pop$exam_score)
max_pop <- max(pop$exam_score)
cat("Mean:", mean_pop, "SD:", sd_pop, "Min:", min_pop, "Max:", max_pop, "\n")
## Mean: 71.8192 SD: 10.1005 Min: 40 Max: 111
hist(pop$exam_score, main="Histogram Skor Ujian (Populasi)", xlab="Skor", col="yellow")
# b/Sampel acak n=30, 1000 kali pengulangan
set.seed(123)
n_30 <- 30
sampel_30 <- replicate(1000, mean(sample(pop$exam_score, n_30, replace = TRUE)))
head(sampel_30)
## [1] 71.93333 74.63333 70.43333 72.10000 72.26667 69.03333
hist(sampel_30, main="Distribusi Sampling Rata-rata (n=30)", xlab="Rata-rata Sampel", col="lightgreen")
sd_empiris_30 <- sd(sampel_30)
se_teoretis_30 <- sd_pop / sqrt(n_30)
cat("SD Empiris (n=30):", sd_empiris_30, "SE Teoretis (n=30):", se_teoretis_30, "\n")
## SD Empiris (n=30): 1.849776 SE Teoretis (n=30): 1.844091
# c/Ulangi untuk n=5, 30, dan 100
set.seed(123)
sampel_5 <- replicate(1000, mean(sample(pop$exam_score, 5, replace = TRUE)))
sampel_100 <- replicate(1000, mean(sample(pop$exam_score, 100, replace = TRUE)))
par(mfrow=c(1,3)) # Menampilkan 3 grafik dalam satu baris
hist(sampel_5, main="n = 5", xlab="Rata-rata", col="coral")
hist(sampel_30, main="n = 30", xlab="Rata-rata", col="lightgreen")
hist(sampel_100, main="n = 100", xlab="Rata-rata", col="mediumpurple")
par(mfrow=c(1,1)) # Mengembalikan layout grafik ke awal
#2: Uji normalitas data tunggal dan dua variabel
penjualan <- c(45, 52, 47, 50, 49, 53, 54, 48, 51, 50,55, 46, 49, 47, 52, 50, 48, 53, 54, 49)
berat <- c(55, 60, 62, 58, 64, 70, 68, 72, 59, 61,63, 65, 66, 67, 71, 69, 60, 58, 62, 64,73, 75, 77, 68, 70, 72, 74, 69, 63, 65)
tinggi <- c(160, 162, 164, 158, 166, 172, 170, 175, 161, 163,165, 167, 169, 171, 173, 174, 160, 159, 164, 166,176, 178, 180, 172, 174, 176, 177, 171, 165, 167)
# a/Data Penjualan
hist(penjualan, main="Histogram Penjualan", col="lightblue")
qqnorm(penjualan, main="Q-Q Plot Penjualan"); qqline(penjualan, col="red")
#Uji hapiro-wilk
shapiro.test(penjualan)
##
## Shapiro-Wilk normality test
##
## data: penjualan
## W = 0.96996, p-value = 0.754
# Uji Kolmogorov-Smirnov (Data Terstandarisasi)
ks.test(scale(penjualan), "pnorm")
## Warning in ks.test.default(scale(penjualan), "pnorm"): ties should not be
## present for the one-sample Kolmogorov-Smirnov test
##
## Asymptotic one-sample Kolmogorov-Smirnov test
##
## data: scale(penjualan)
## D = 0.11402, p-value = 0.9573
## alternative hypothesis: two-sided
# b) Uji Normalitas Berat dan Tinggi sekaligus
data_bt <- list(berat = berat, tinggi = tinggi)
lapply(data_bt, shapiro.test)
## $berat
##
## Shapiro-Wilk normality test
##
## data: X[[i]]
## W = 0.98257, p-value = 0.8889
##
##
## $tinggi
##
## Shapiro-Wilk normality test
##
## data: X[[i]]
## W = 0.96475, p-value = 0.4071
par(mfrow=c(1,2))
qqnorm(berat, main="Q-Q Plot Berat"); qqline(berat, col="lightblue")
qqnorm(tinggi, main="Q-Q Plot Tinggi"); qqline(tinggi, col="green")
par(mfrow=c(1,1))
#3/Uji kesamaan rata-rata data berpasangan
bp <- data.frame(
id = 1:30,
before = c(140, 150, 135, 142, 128, 155, 138, 147, 131, 144, 129, 152, 141, 137, 148, 133, 149, 136, 130, 145, 139, 143, 134, 151, 127, 146, 132, 140, 138, 135),
after = c(132, 145, 130, 138, 125, 148, 135, 140, 128, 136, 125, 146, 135, 132, 142, 130, 144, 133, 127, 140, 134, 138, 130, 145, 124, 139, 128, 137, 134, 131)
)
# a) Selisih dan statistik deskriptif
bp$selisih <- bp$before - bp$after
cat("Mean Before:", mean(bp$before), "SD Before:", sd(bp$before), "\n")
## Mean Before: 139.8333 SD Before: 7.70617
cat("Mean After:", mean(bp$after), "SD After:", sd(bp$after), "\n")
## Mean After: 135.0333 SD After: 6.713257
cat("Mean Selisih:", mean(bp$selisih), "SD Selisih:", sd(bp$selisih), "\n")
## Mean Selisih: 4.8 SD Selisih: 1.562491
# b) Boxplot dan Histogram
boxplot(bp$before, bp$after, names=c("Before", "After"), main="Boxplot Tekanan Darah", col=c("pink", "lightblue"))
hist(bp$selisih, main="Histogram Selisih Tekanan Darah", col="khaki")
# c) Uji Normalitas Selisih
shapiro.test(bp$selisih)
##
## Shapiro-Wilk normality test
##
## data: bp$selisih
## W = 0.89942, p-value = 0.008129
# d) Uji Hipotesis
# Hipotesis:
# H0: Rata-rata tekanan darah sebelum = sesudah (Tidak ada perbedaan)
# H1: Rata-rata tekanan darah sebelum != sesudah (Ada perbedaan)
# Uji t berpasangan
t_test_res <- t.test(bp$before, bp$after, paired = TRUE, conf.level = 0.95)
print(t_test_res)
##
## Paired t-test
##
## data: bp$before and bp$after
## t = 16.826, df = 29, p-value < 2.2e-16
## alternative hypothesis: true mean difference is not equal to 0
## 95 percent confidence interval:
## 4.216556 5.383444
## sample estimates:
## mean difference
## 4.8
# Uji Wilcoxon signed-rank
wilcox_res <- wilcox.test(bp$before, bp$after, paired = TRUE)
print(wilcox_res)
##
## Wilcoxon signed rank exact test
##
## data: bp$before and bp$after
## V = 465, p-value = 1.863e-09
## alternative hypothesis: true location shift is not equal to 0
# e) Cohen's d Berpasangan (Manual calculation: Mean diff / SD diff)
cohens_d <- mean(bp$selisih) / sd(bp$selisih)
cat("Cohen's d:", cohens_d, "\n")
## Cohen's d: 3.072017