Tugas Akhir Sesi UTS Pemograman Statistika
2022-10-19
Muhammad Hasan Itqoni
G1501221029
Nomor 1
- Buatlah program R untuk melakukan proses berikut ini!
Bangkitkan data frame Populasi yang terdiri atas 100 amatan dengan peubah:
- No : 1 - 150 (integer)
- NIM : G1501221001 - G1501221100,G1601221001 - G1501221050 (dapat dibangkitkan berdasarkan kolom No)
- Kelas : “S2” jika kode NIM G15, “S3” jika kode NIM G12 (factor)
- UTS : Diperoleh dengan membangkitkan bilangan acak yang menyebar N(μ=75,σ2=7)
- Indeks : Diperoleh dengan membangkitkan bilangan acak yang menyebar Exp(θ=1)
Jawab:
- Mengatur random state/set seed dengan 2 angka terakhir nim yaitu 29 dengan fungsi set.seed()
- Menginisiasi vektor No sebanyak 150 amatan
- Menginisiasi vektor NIM dengan merepetisi NIM awal “G1501221” sebanyak 100 dan NIM “G1601221” sebanyak 50 amatan dengan fungsi rep()
- Menginisiasi vektor Kelas dengan merepetisi kelas “S2” sebanyak 100 dan kelas “S3” sebanyak 50 amatan dengan fungsi rep()
- Menginisiasi vektor nim.terakhir yaitu 3 angka terakhir Nim mahasiswa dengan formatC() dengan lebar 3 dan flag nya = 0
- Menginisiasi nilai UTS dengan membangkitkan bilangan acak sebanyak 150 amatan yang menyebar N(μ=75,σ2=7) dengan fungsi rnorm() dan dibulatkan 3 angka dibelakang koma.
- Menginisiasi Indeks dengan membangkitkan bilangan acak sebanyak 150 amatan yang menyebar Exp(θ=1)
set.seed(29)
n <- 150
No <- c(1:n)
NIM <- c(rep("G1501221",100), rep("G1601221",50))
Kelas <- c(rep("S2",100), rep("S3",50))
nim.terakhir <- formatC(c(1:100, 1:50), width = 3, flag = 0)
UTS <- round(c(rnorm(n,75,sqrt(7))),3)
Indeks <- round(rexp(n,1),3)- Melakukan perulangan/looping untuk vektor NIM dengan fungsi paste0() yang menggabungkan vektor NIM dan nim.terakhir
for(i in 1:n) {
NIM[i] <- paste0(NIM[i], nim.terakhir[i])
}- Membuat dataframe populasi dengan nama kolom sesuai vektor yang sudah diinisiasi
populasi <- data.frame(No=No,
NIM=NIM,
Kelas=Kelas,
UTS=UTS,
Indeks=Indeks)
populasi## No NIM Kelas UTS Indeks
## 1 1 G1501221001 S2 71.605 0.142
## 2 2 G1501221002 S2 71.657 0.611
## 3 3 G1501221003 S2 75.568 1.143
## 4 4 G1501221004 S2 77.505 1.029
## 5 5 G1501221005 S2 71.891 0.349
## 6 6 G1501221006 S2 80.584 0.595
## 7 7 G1501221007 S2 73.620 0.074
## 8 8 G1501221008 S2 72.539 0.030
## 9 9 G1501221009 S2 76.110 1.412
## 10 10 G1501221010 S2 77.940 3.789
## 11 11 G1501221011 S2 76.134 1.560
## 12 12 G1501221012 S2 80.093 0.062
## 13 13 G1501221013 S2 75.820 0.127
## 14 14 G1501221014 S2 74.916 0.190
## 15 15 G1501221015 S2 76.249 0.263
## 16 16 G1501221016 S2 74.095 5.366
## 17 17 G1501221017 S2 71.185 1.482
## 18 18 G1501221018 S2 74.949 1.252
## 19 19 G1501221019 S2 78.748 0.250
## 20 20 G1501221020 S2 73.819 0.893
## 21 21 G1501221021 S2 75.747 0.809
## 22 22 G1501221022 S2 80.816 0.490
## 23 23 G1501221023 S2 71.167 1.395
## 24 24 G1501221024 S2 79.630 0.301
## 25 25 G1501221025 S2 75.669 0.308
## 26 26 G1501221026 S2 74.752 1.263
## 27 27 G1501221027 S2 72.787 1.132
## 28 28 G1501221028 S2 75.008 1.151
## 29 29 G1501221029 S2 75.111 0.121
## 30 30 G1501221030 S2 75.408 3.497
## 31 31 G1501221031 S2 74.436 0.798
## 32 32 G1501221032 S2 75.397 1.309
## 33 33 G1501221033 S2 75.096 1.732
## 34 34 G1501221034 S2 75.088 0.095
## 35 35 G1501221035 S2 74.471 0.950
## 36 36 G1501221036 S2 71.861 1.438
## 37 37 G1501221037 S2 73.191 1.748
## 38 38 G1501221038 S2 69.865 0.089
## 39 39 G1501221039 S2 78.348 0.767
## 40 40 G1501221040 S2 68.560 1.183
## 41 41 G1501221041 S2 76.110 2.668
## 42 42 G1501221042 S2 77.531 0.963
## 43 43 G1501221043 S2 73.900 0.462
## 44 44 G1501221044 S2 79.660 0.120
## 45 45 G1501221045 S2 71.227 0.231
## 46 46 G1501221046 S2 76.271 0.218
## 47 47 G1501221047 S2 75.195 2.150
## 48 48 G1501221048 S2 73.313 1.766
## 49 49 G1501221049 S2 74.899 3.918
## 50 50 G1501221050 S2 76.897 0.851
## 51 51 G1501221051 S2 72.268 0.100
## 52 52 G1501221052 S2 73.475 4.195
## 53 53 G1501221053 S2 78.179 1.347
## 54 54 G1501221054 S2 74.211 1.114
## 55 55 G1501221055 S2 75.317 2.054
## 56 56 G1501221056 S2 75.169 1.521
## 57 57 G1501221057 S2 74.120 2.048
## 58 58 G1501221058 S2 71.571 1.671
## 59 59 G1501221059 S2 76.391 0.719
## 60 60 G1501221060 S2 75.555 1.007
## 61 61 G1501221061 S2 74.315 0.811
## 62 62 G1501221062 S2 77.739 0.128
## 63 63 G1501221063 S2 73.010 0.160
## 64 64 G1501221064 S2 75.303 0.055
## 65 65 G1501221065 S2 71.093 1.190
## 66 66 G1501221066 S2 78.535 1.043
## 67 67 G1501221067 S2 74.193 0.226
## 68 68 G1501221068 S2 74.785 0.848
## 69 69 G1501221069 S2 70.719 0.776
## 70 70 G1501221070 S2 73.566 5.540
## 71 71 G1501221071 S2 77.922 5.709
## 72 72 G1501221072 S2 72.146 4.278
## 73 73 G1501221073 S2 76.654 0.110
## 74 74 G1501221074 S2 70.549 0.125
## 75 75 G1501221075 S2 73.421 1.184
## 76 76 G1501221076 S2 68.852 0.009
## 77 77 G1501221077 S2 71.862 0.039
## 78 78 G1501221078 S2 72.147 0.946
## 79 79 G1501221079 S2 73.351 0.527
## 80 80 G1501221080 S2 68.967 1.257
## 81 81 G1501221081 S2 72.361 0.376
## 82 82 G1501221082 S2 71.975 0.331
## 83 83 G1501221083 S2 77.443 0.321
## 84 84 G1501221084 S2 74.366 0.811
## 85 85 G1501221085 S2 71.345 1.923
## 86 86 G1501221086 S2 73.963 0.005
## 87 87 G1501221087 S2 75.413 0.159
## 88 88 G1501221088 S2 75.711 1.664
## 89 89 G1501221089 S2 77.054 1.146
## 90 90 G1501221090 S2 74.591 0.198
## 91 91 G1501221091 S2 74.455 0.254
## 92 92 G1501221092 S2 75.597 2.867
## 93 93 G1501221093 S2 72.414 1.931
## 94 94 G1501221094 S2 74.304 0.307
## 95 95 G1501221095 S2 77.740 2.207
## 96 96 G1501221096 S2 77.147 0.191
## 97 97 G1501221097 S2 79.394 0.108
## 98 98 G1501221098 S2 79.091 0.943
## 99 99 G1501221099 S2 71.641 0.372
## 100 100 G1501221100 S2 74.590 1.315
## 101 101 G1601221001 S3 75.234 1.313
## 102 102 G1601221002 S3 76.424 0.407
## 103 103 G1601221003 S3 70.955 0.004
## 104 104 G1601221004 S3 71.586 2.777
## 105 105 G1601221005 S3 77.079 0.457
## 106 106 G1601221006 S3 80.012 0.246
## 107 107 G1601221007 S3 79.056 0.011
## 108 108 G1601221008 S3 74.775 3.712
## 109 109 G1601221009 S3 70.772 1.858
## 110 110 G1601221010 S3 78.691 1.224
## 111 111 G1601221011 S3 69.710 0.945
## 112 112 G1601221012 S3 80.526 0.704
## 113 113 G1601221013 S3 75.823 0.138
## 114 114 G1601221014 S3 74.549 0.794
## 115 115 G1601221015 S3 78.834 0.715
## 116 116 G1601221016 S3 74.340 0.474
## 117 117 G1601221017 S3 76.025 1.657
## 118 118 G1601221018 S3 69.060 4.686
## 119 119 G1601221019 S3 74.704 2.674
## 120 120 G1601221020 S3 72.433 0.533
## 121 121 G1601221021 S3 75.607 2.536
## 122 122 G1601221022 S3 76.941 4.564
## 123 123 G1601221023 S3 77.396 1.250
## 124 124 G1601221024 S3 73.847 0.253
## 125 125 G1601221025 S3 78.945 0.158
## 126 126 G1601221026 S3 78.249 0.157
## 127 127 G1601221027 S3 76.378 2.287
## 128 128 G1601221028 S3 68.223 0.104
## 129 129 G1601221029 S3 68.662 3.364
## 130 130 G1601221030 S3 75.196 0.936
## 131 131 G1601221031 S3 75.255 0.490
## 132 132 G1601221032 S3 69.877 0.187
## 133 133 G1601221033 S3 77.252 0.442
## 134 134 G1601221034 S3 73.632 0.394
## 135 135 G1601221035 S3 77.946 0.450
## 136 136 G1601221036 S3 74.489 0.162
## 137 137 G1601221037 S3 77.325 1.039
## 138 138 G1601221038 S3 76.738 1.414
## 139 139 G1601221039 S3 73.120 2.624
## 140 140 G1601221040 S3 75.192 0.864
## 141 141 G1601221041 S3 74.334 0.686
## 142 142 G1601221042 S3 75.779 0.051
## 143 143 G1601221043 S3 78.092 2.502
## 144 144 G1601221044 S3 77.428 0.122
## 145 145 G1601221045 S3 75.451 0.116
## 146 146 G1601221046 S3 73.870 0.333
## 147 147 G1601221047 S3 74.947 2.237
## 148 148 G1601221048 S3 77.109 0.204
## 149 149 G1601221049 S3 75.124 0.334
## 150 150 G1601221050 S3 72.340 0.671Nomor 2
- Susun program R untuk membangkitkan bilang acak dari sebaran di bawah ini sebanyak 1000 buah dan buktikan secara empirik dengan program R.
data.soal <- data.frame('x'=1:10,'p(x)'=dbinom(1:10,size = 10,0.6), check.names = F)
data.soal## x p(x)
## 1 1 0.001572864
## 2 2 0.010616832
## 3 3 0.042467328
## 4 4 0.111476736
## 5 5 0.200658125
## 6 6 0.250822656
## 7 7 0.214990848
## 8 8 0.120932352
## 9 9 0.040310784
## 10 10 0.006046618Jawab :
- Berdasarkan data pdf di atas dibuat plot untuk melihat sebaran distribusinya
plot(data.soal)
- Dari plot di atas dapat dilihat bahwa data pdf membentuk distribusi normal
- Membuat vektor yang berisi CDF dengan metode perulangan
data.soal$CDF <- data.soal$`p(x)`[1]
data.soal$CDF## [1] 0.001572864 0.001572864 0.001572864 0.001572864 0.001572864 0.001572864
## [7] 0.001572864 0.001572864 0.001572864 0.001572864# Melakukan perulangan untuk mendapatkan cdf dari data soal
for (i in seq(2, dim(data.soal)[1])){
data.soal$CDF[i] <- data.soal$CDF[i-1] + data.soal$`p(x)`[i]
}- Dataframe setelah ditambahkan nilai fungsi kumulatifnya:
data.soal## x p(x) CDF
## 1 1 0.001572864 0.001572864
## 2 2 0.010616832 0.012189696
## 3 3 0.042467328 0.054657024
## 4 4 0.111476736 0.166133760
## 5 5 0.200658125 0.366791885
## 6 6 0.250822656 0.617614541
## 7 7 0.214990848 0.832605389
## 8 8 0.120932352 0.953537741
## 9 9 0.040310784 0.993848525
## 10 10 0.006046618 0.999895142- Dikarenakan data berbentuk diskret, maka dilakukan simulasi untuk mengelompokkan data sebagai berikut:
#Mengatur seed 3 angka nim terakhir
set.seed(029)
#Membangkitkan bilangan uniform 1000 amatan
bil.unif <- runif(1000)
#Mengelompokkan data berdasarkan jumlah data
sample.data <- ifelse(bil.unif<=data.soal$CDF[1],1,+ifelse(bil.unif<=data.soal$CDF[2],2,+ifelse(bil.unif<=data.soal$CDF[3],3,+ifelse(bil.unif<=data.soal$CDF[4],4,+ifelse(bil.unif<=data.soal$CDF[5],5,+ifelse(bil.unif<=data.soal$CDF[6],6,+ifelse(bil.unif<=data.soal$CDF[7],7,+ifelse(bil.unif<=data.soal$CDF[8],8,+ifelse(bil.unif<=data.soal$CDF[9],9,10)))))))));
sample.data## [1] 4 5 4 5 6 4 7 8 4 5 9 6 5 7 5 7 7 5 8 5 7 7 9 9
## [25] 7 5 6 8 7 4 5 4 4 7 6 4 8 5 5 4 6 2 9 7 4 8 9 7
## [49] 6 7 6 7 5 7 6 6 6 7 6 4 6 4 6 5 6 7 6 7 6 5 4 8
## [73] 5 4 3 5 8 4 2 5 7 3 7 5 5 6 9 7 4 6 7 6 6 6 5 4
## [97] 6 6 7 6 4 5 5 4 8 8 6 7 6 4 6 6 6 9 4 5 7 8 6 6
## [121] 6 4 8 9 5 2 6 6 4 7 8 8 6 6 6 4 3 6 5 5 8 4 4 7
## [145] 7 6 3 9 5 6 2 4 4 5 4 6 5 6 2 7 4 8 4 7 7 5 6 7
## [169] 4 4 5 6 6 8 6 5 7 7 6 6 6 7 6 7 4 7 6 8 8 7 7 7
## [193] 8 3 8 7 4 3 6 8 6 8 7 6 4 5 4 5 7 7 9 6 8 8 6 6
## [217] 4 4 8 4 3 4 9 4 7 7 6 6 8 2 6 6 7 5 3 6 6 9 4 6
## [241] 6 6 7 7 7 5 5 5 8 7 8 8 7 7 2 8 2 7 6 6 6 7 3 7
## [265] 7 8 5 8 8 8 6 2 7 8 7 6 5 8 6 5 6 7 6 5 8 3 7 6
## [289] 6 6 5 7 6 6 7 7 6 6 4 4 8 5 7 7 5 5 7 7 9 7 4 6
## [313] 10 7 6 7 3 4 3 7 6 5 5 6 10 4 5 5 8 6 6 8 6 7 2 4
## [337] 6 7 5 5 7 4 7 8 7 6 6 5 5 9 6 5 5 3 6 3 6 10 7 4
## [361] 6 5 8 7 4 5 4 5 8 8 4 6 4 5 6 6 7 8 4 5 7 8 5 6
## [385] 10 5 8 6 8 6 4 5 3 8 7 5 6 2 6 5 5 5 8 5 7 5 4 6
## [409] 3 6 6 7 6 6 5 5 8 9 5 9 8 7 5 8 4 6 6 6 7 6 6 6
## [433] 9 5 5 2 2 3 9 5 7 8 6 4 6 6 8 3 6 6 5 7 6 7 7 7
## [457] 5 5 6 6 4 5 8 5 7 7 3 5 7 4 6 6 6 9 5 7 6 6 7 8
## [481] 2 7 4 9 2 8 7 7 10 7 7 3 7 3 7 5 5 7 7 6 8 7 5 5
## [505] 6 5 6 3 8 8 7 8 5 7 6 9 2 4 7 4 2 6 8 5 6 6 9 6
## [529] 5 9 4 6 3 5 7 8 9 5 7 7 8 7 8 6 6 6 6 4 4 6 5 5
## [553] 8 6 4 6 8 5 7 7 4 6 9 7 8 6 8 8 6 5 6 7 5 6 6 5
## [577] 7 6 6 8 8 4 8 7 5 5 5 8 6 4 5 4 4 6 6 4 3 6 4 3
## [601] 6 5 5 6 6 8 6 8 8 9 7 5 5 7 7 7 4 6 5 7 3 6 4 5
## [625] 3 8 1 4 7 7 5 5 6 7 7 5 6 4 6 7 5 7 5 8 8 5 7 4
## [649] 4 5 4 4 6 5 8 8 4 6 7 7 4 5 5 5 9 5 6 4 6 6 5 6
## [673] 3 7 7 7 5 3 5 8 5 5 4 5 6 4 5 5 4 3 6 8 6 6 7 3
## [697] 3 8 6 7 6 3 8 6 6 7 8 8 5 7 6 8 6 5 7 5 5 5 7 9
## [721] 6 3 5 6 8 7 7 3 6 6 9 8 7 6 7 7 9 5 7 5 5 4 5 7
## [745] 7 7 7 5 7 8 6 6 7 7 6 3 5 3 4 6 2 8 6 6 6 5 5 8
## [769] 3 6 9 7 7 4 5 7 5 7 4 7 7 5 5 6 6 5 9 6 6 7 8 7
## [793] 6 5 3 8 7 8 5 5 8 3 4 3 4 5 7 7 7 3 6 8 6 8 7 8
## [817] 7 5 5 5 7 4 7 7 5 8 8 6 6 4 6 4 7 7 5 8 7 8 5 7
## [841] 2 6 6 3 8 6 6 7 5 7 3 9 9 8 4 7 4 5 4 8 4 5 8 4
## [865] 8 9 3 7 5 6 8 9 5 6 8 5 8 5 8 9 8 7 4 6 3 6 4 6
## [889] 4 4 7 4 4 5 6 7 5 8 2 8 6 6 5 6 4 8 3 4 7 7 7 5
## [913] 6 9 7 6 5 8 6 8 8 6 4 7 6 6 6 7 7 5 7 5 8 8 6 7
## [937] 6 7 7 5 4 4 3 2 7 4 7 9 7 2 9 7 6 7 7 2 8 7 9 6
## [961] 3 7 8 7 5 5 7 6 7 8 7 7 6 6 4 4 6 7 8 7 7 6 8 7
## [985] 8 3 7 5 5 4 6 6 8 7 4 5 9 4 9 9- Berdasarkan hasil data simulasi yang diperoleh, dilakukan pengecekan distribusinya dengan barplot dan histogram sebagai berikut:
barplot(table(sample.data), col="blue")
hist(sample.data, prob=T, col='red')
- Dari barplot dan histogram di atas, dapat dilihat bahwa data yang dibangkitkan menyebar normal, kemudian dicari nilai mean dan standar deviasinya menggunakan library MASS sebagai berikut:
library(MASS)
fitting.data<-fitdistr(sample.data,"normal")
parameter <- fitting.data$estimate
parameter## mean sd
## 5.958000 1.648101- Nilai mean yang diperoleh sebesar 5.968 dan sd nya 1.6481
#Mengatur seed 3 angka nim terakhir
set.seed(029)
#Membangkitkan bil acak normal sebanyak 1000 amatan dengan nilai tengah dan sd yang sudah diperoleh
y <- rnorm(1000, mean = 5.958000, sd = 1.648101)
#Histogram
hist(y, prob = TRUE, col = "green", main = "Normal Distribution")
- Dari histogram di atas dapat dilihat secara empirik bahwa data menyebar seperti pdf dari data soal yaitu menyebar normal.
Nomor 3
Diketahui fungsi kepekatan peluang sebaran dari suatu peubah acak X adalah sebagai berikut:
f(x)=5β(x^4)(1−x^5)^β−1, 0<x<a- Berapa nilai a?
- Susun program R untuk membangkitkan bilangan acak dari sebaran ini sebanyak 1000 buah dengan seed empat angka terakhir NIM masing-masing
- Buktikan secara empirik dengan program R
Jawab:
Nilai a dicari dengan mengintegralkan f(x) sama dengan = 1, nilai a yang diperoleh sebesar 1 dengan dimisalkan nilai beta=2
Seperti gambar berikut:
Pembangkitan bilangan acak menggunakan metode acceptance rejection method.
Fungsi untuk membangkitkan bilangan acak dengan metode ARM, input:
f(t) : suatu fungsi dimana bilangan akan dibangkitkan
g(t) : fungsi peluang dari sebaran uniform(0,1), karena memiliki domain yang sama dengan f(t)
c : nilai maksimum dari f(t)/g(t)
n : banyaknya bilangan yang akan dibangkitkan
u : sebaran uniform(0,1)
KRITERIA : Sebuah nilai y dari g(t) akan diterima sebagai x jika c.g(t).u < f(t)
Mencari nilai maksimum = c dengan fungsi optimize()
f <- function(x) 10*x^4*(1-x^5)
nilai.maks <- optimize(f,c(0,1),maximum = T)
nilai.maks## $maximum
## [1] 0.8502957
##
## $objective
## [1] 2.903899- Melakukan perulangan untuk mencari nilai x yang memenuhi kriteria
n <- 1000
j <- k <- 0
y <- numeric(n)
c <- nilai.maks$objective
set.seed(1029)
while (k < n) {
u <- runif(1)
j <- j+1
x <- runif(1)
if(10*x^4*(1-x^5)/c > u) {
k <- k+1 #terimax
y[k] <- x
}
}- Membuat histogram dan pembuktian secara empirik
hist(y,prob=T)
sbx <- seq(0,1,.01)
lines(sbx,10*sbx^4*(1-sbx^5))
- Dari histogram di atas dapat dilihat bahwa garis fungsi f(t) mengikuti sebaran data yang sudah dibangkitkan menggunakan metode ARM
Nomor 4
- Buatlah Class System S3 dengan nama Optimisasi yang berisi atribut metode_optimisasi dan fungsi_matematika. Kemudian buatlah method execute.optimisasi sebagai method yang digunakan untuk mengeksekusi suatu persamaan ke dalam fungsi optimasi tersebut.
Jawab :
- Membuat fungsi konstuktor dengan untuk class yang bernama Optimisasi dengan atribut metode_optimisasi dan fungsi_matematika.
opt <- function(metode_optimasi, fungsi_matematika){
list.opt <- list(metode_optimasi=metode_optimasi,fungsi_matematika=fungsi_matematika)
class(list.opt) <- "Optimisasi"
list.opt
}
objek <- opt("SANN",function(x) (2*x^2+4*x-2)^2)
objek## $metode_optimasi
## [1] "SANN"
##
## $fungsi_matematika
## function(x) (2*x^2+4*x-2)^2
##
## attr(,"class")
## [1] "Optimisasi"- Membuat fungsi aksesor untuk mengakses data dalam class Optimisasi
method.opt <- function(obj) obj$metode_optimasi
func.mat <- function(obj) obj$fungsi_matematika
method.opt(objek)## [1] "SANN"func.mat(objek)## function(x) (2*x^2+4*x-2)^2- Membuat fungsi generik baru dengan nama execute.optimasi untuk mengeksekusi class Optimisasi dengan fungsi generik optim()
execute.optimasi <- function(obj,par) {
a<-method.opt(obj)
b<-func.mat(obj)
optim(par,b,method = a)
}- Mengeksekusi objek dengan fungsi generik yang sudah dibuat untuk mencari nilai optimum dari sebuah fungsi matematika 2x^2 + 4x - 2 dengan metode SANN dan nilai awal 5
objek <- opt("SANN",function(x) (2*x^2+4*x-2))
objek## $metode_optimasi
## [1] "SANN"
##
## $fungsi_matematika
## function(x) (2*x^2+4*x-2)
##
## attr(,"class")
## [1] "Optimisasi"execute.optimasi(objek,5)## $par
## [1] -1.000049
##
## $value
## [1] -4
##
## $counts
## function gradient
## 10000 NA
##
## $convergence
## [1] 0
##
## $message
## NULL