Pemograman Statistika
Rangkuman
BAB 1
Instalasi linux on windows, ada beberapa tahapan dalam penginstalan linux di Windows.
Find ‘’Turn windows features on or off’’ di type here to search and click. Seperti yang ditunjukan pada gambar berikut.
Lalu akan muncul dan click centang pada ‘’windows subsystem for linux’’ dan click ok. seperti gambar berikut
Tunggu saja sampai ada tulisan restart now lalu klik restart now. Seperti gambar berikut
Find and click Microsoft store then type ubuntu on search engine at Microsoft store then click Ubunti 18.04 LTS. Seperti gambar berikut
Click get then proses download akan berlangsung tunggu saja.
After finish download then launch ubuntu, maka akan menampilkan seperti gambar berikut.
Bikin account dengan mengisi username, password, lalu enter. Seperti pada gambar berikut.
After finish installation then bisa belajar tutorial melalui link berikut https://www.youtube.com/watch?v=V1y-mbWM3B8
BAB 2
2.1 Dasar - Dasar R
2.1.1 Assignment
Assignment adalah suatu cara untuk memberikan value kepada suatu object. Ada beberapa cara untuk memberikan assign:
- A <- b artinya object A akan diisi dengan nilai b
A <- 5
paste('cara assign 1 = ', A)[1] "cara assign 1 = 5"- b -> A sama seperti di no 1 yaitu memberikan nilai kepada si A dengan nilai b meskipun tandanya beda
A = 5
paste('cara assign 2 = ', A)[1] "cara assign 2 = 5"- A = b cara lain untuk memberikan assign bisa dengan pake tanda ‘=’ sama aja seperti ‘<-’
5 -> A
paste('cara assign 3 = ', A)[1] "cara assign 3 = 5"A = 5
paste('cara assign 2 = ', A)[1] "cara assign 2 = 5"2.1.2 case-sensitive
sebagai tambahan informasi di R ini sangat sensitive misalkan ingin memberikan nilai 5 kepada object A. maka ketika menuliskan A <- 5 tidak automatis bahwa a kecil akan bernilai 5. Artinya sangat sensitive terhadap penamaan. penamaan object diawali dengan huruf (A-z atau a-z) tidak bisa pake spasi misal jawa Barat <- 10, harus digabung jadi jawa_barat <-10 terdapat operator yang sudah digunakan misal TRUE, FALSE, NULL, dll tidak bisa dijadikan penamaan object
A <- 5
paste('Nilai A = ', A)[1] "Nilai A = 5"a <- 10
paste('Nilai a = ', a)[1] "Nilai a = 10"2.2 Objek di R
terdapat beberapa objeck di R yaitu Vector, Matrix, Array, Factor, List, and DataFrame.
2.2.1 vector
Membuat Vector
#cara 1 membuat vector a1 a1 <- c(2,4,7,3) a1[1] 2 4 7 3#cara 2 membuat vector a2 tidak perlu di define seperti cara 1 assign("a2",c("2","4","7","3")) a2[1] "2" "4" "7" "3"baris bilangan
#cara 3 membuat vector a3 dengan selisih 0.5 dimulai dari 1 a3 <- seq(1,10,by=0.5) a3[1] 1.0 1.5 2.0 2.5 3.0 3.5 4.0 4.5 5.0 5.5 6.0 6.5 7.0 7.5 8.0 [16] 8.5 9.0 9.5 10.0#cara 4 membuat vector a4 dengan jumlah data point sebanyak 12 a4 <- seq(1,10,length.out=12) a4[1] 1.000000 1.818182 2.636364 3.454545 4.272727 5.090909 5.909091 [8] 6.727273 7.545455 8.363636 9.181818 10.000000bilangan berulang
#cara 5 membuat vector a5 dengan nilai 1 sebanyak 3 kali a5 <- rep(1,3) a5[1] 1 1 1#cara 6 membuat vector a6 dengan nilai 1-3 diulangi sebanyak 3 kali a6 <- rep(1:3,3) a6[1] 1 2 3 1 2 3 1 2 3#cara 7 membuat vector a7 perulangan nilai sesuai dengan posisinya a7 <- rep(1:3,1:3) a7[1] 1 2 2 3 3 3#cara 8 membuat vector a8 a8 <- rep(1:3,rep(2,3)) a8[1] 1 1 2 2 3 3#cara 9 membuat vector a9 sama seperti a8 dengan setiap nilai diulang 2 kali a9 <- rep(1:3,each=2) a9[1] 1 1 2 2 3 3karakter berpola
#cara 10 membuat vector a10 a10 <- paste("A", 1:10, sep="") a10[1] "A1" "A2" "A3" "A4" "A5" "A6" "A7" "A8" "A9" "A10"#cara 11 membuat vector a11 seperti cara 10 a11 <- paste("A", rep(1:10), sep="") a11[1] "A1" "A2" "A3" "A4" "A5" "A6" "A7" "A8" "A9" "A10"#cara 12 membuat vector a12 a12 <- paste0("A",1:10) a12[1] "A1" "A2" "A3" "A4" "A5" "A6" "A7" "A8" "A9" "A10"#cara 13 membuat vector a13 a13 <- paste("A",1:10,sep='-') a13[1] "A-1" "A-2" "A-3" "A-4" "A-5" "A-6" "A-7" "A-8" "A-9" "A-10"#cara 14 membuat vector a14 a8 <- rep(1:3,rep(2,3)) a14 <- paste0("A",a8) a14[1] "A1" "A1" "A2" "A2" "A3" "A3"akses vector
#mengambil value di index ke 3 pada vector a2 assign("a2",c("2","4","7","3")) a2[3][1] "7"#mengambil value di index ke 10 s/d 15 pada vector a3 a3 <- seq(1,10,by=0.5) a3[10:15][1] 5.5 6.0 6.5 7.0 7.5 8.0#mengambil value di index ke 4, 7 dan 9 vector a10 a10 <- paste("A", 1:10, sep="") a10[c(4,7,9)][1] "A4" "A7" "A9"#membuang value di index ke 1 dan 2 pada vector a13 a13 <- paste("A",1:10,sep='-') a13[-c(1:2)][1] "A-3" "A-4" "A-5" "A-6" "A-7" "A-8" "A-9" "A-10"#jumlah index pada vector a4 a4 <- seq(1,10,length.out=12) length(a4)[1] 12
2.2.2 Matrix
#membuat matriks baris 1 s/d 12
a14 <- 1:12
a14 [1] 1 2 3 4 5 6 7 8 9 10 11 12#membentuk matrix 3 x 4 pake data a14
b1 <- matrix(a14,3,4)
b1 [,1] [,2] [,3] [,4]
[1,] 1 4 7 10
[2,] 2 5 8 11
[3,] 3 6 9 12#sama seperti b1 bedanya diisi baris pertama
b2 <- matrix(a14,3,4,byrow=TRUE)
b2 [,1] [,2] [,3] [,4]
[1,] 1 2 3 4
[2,] 5 6 7 8
[3,] 9 10 11 12#membentuk matrix 4 x 4 dengan value 1 s/d 10 dimulai dari kolom 1 - kolom ke 4
b3 <- matrix(1:10,4,4)
b3 [,1] [,2] [,3] [,4]
[1,] 1 5 9 3
[2,] 2 6 10 4
[3,] 3 7 1 5
[4,] 4 8 2 6#membentuk matrix 4 x 5 dengan value 1 s/d 10 dimulai dari kolom 1 - kolom ke 5
b4 <- matrix(1:10,4,5)
b4 [,1] [,2] [,3] [,4] [,5]
[1,] 1 5 9 3 7
[2,] 2 6 10 4 8
[3,] 3 7 1 5 9
[4,] 4 8 2 6 10#assign matrix baris a14 ke b5
b5 <- a14
b5 [1] 1 2 3 4 5 6 7 8 9 10 11 12#merubah objek vector ke matrix
dim(b5)<-c(6,2)
dim(b5)[1] 6 2#membentuk matrix 2 x 2, jika tidak dimasukan nilai satunya
b6 <- matrix(1:4,2)
b6 [,1] [,2]
[1,] 1 3
[2,] 2 4#membentuk matrix 2 x 2, jika tidak dimasukan nilai satunya
b7 <- matrix(6:9,2)
b7 [,1] [,2]
[1,] 6 8
[2,] 7 9#gabung baris
b8 <- rbind(b6,b7)
b8 [,1] [,2]
[1,] 1 3
[2,] 2 4
[3,] 6 8
[4,] 7 9#gabung kolom
b9 <- cbind(b7,b6)
b9 [,1] [,2] [,3] [,4]
[1,] 6 8 1 3
[2,] 7 9 2 4#dimensi row and col pada matrix b8
dim(b8) [1] 4 2#dimensi row and col pada matrix b9
dim(b9) [1] 2 4#dimensi row and col pada matrix a14
dim(a14) NULL#total data pada matrix b3
length(b3) [1] 16#akses matrix
b2 [,1] [,2] [,3] [,4]
[1,] 1 2 3 4
[2,] 5 6 7 8
[3,] 9 10 11 12#ambil value di indeks row = 2, col = 3
b2[2,3] [1] 7#ambil value di indeks row = 2, col = 2,3,4
b2[2,2:4][1] 6 7 8#ambil value di indeks row = 1,2, col = semua kolom
b2[1:2,] [,1] [,2] [,3] [,4]
[1,] 1 2 3 4
[2,] 5 6 7 8#ambil value di indeks row = 1 dan 3, col = exclude kolom 2
b2[c(1,3),-2] [,1] [,2] [,3]
[1,] 1 3 4
[2,] 9 11 12#ambil value di row=1, col = 4
b2[10] [1] 42.2.3 Array
#akses array
c1 <- array(a14,dim=c(2,2,3))
c1, , 1
[,1] [,2]
[1,] 1 3
[2,] 2 4
, , 2
[,1] [,2]
[1,] 5 7
[2,] 6 8
, , 3
[,1] [,2]
[1,] 9 11
[2,] 10 12c2 <- array(a14,dim=c(2,1,2,3))
c2, , 1, 1
[,1]
[1,] 1
[2,] 2
, , 2, 1
[,1]
[1,] 3
[2,] 4
, , 1, 2
[,1]
[1,] 5
[2,] 6
, , 2, 2
[,1]
[1,] 7
[2,] 8
, , 1, 3
[,1]
[1,] 9
[2,] 10
, , 2, 3
[,1]
[1,] 11
[2,] 12c3 <- array(a14,dim=c(1,2,4,2))
c3, , 1, 1
[,1] [,2]
[1,] 1 2
, , 2, 1
[,1] [,2]
[1,] 3 4
, , 3, 1
[,1] [,2]
[1,] 5 6
, , 4, 1
[,1] [,2]
[1,] 7 8
, , 1, 2
[,1] [,2]
[1,] 9 10
, , 2, 2
[,1] [,2]
[1,] 11 12
, , 3, 2
[,1] [,2]
[1,] 1 2
, , 4, 2
[,1] [,2]
[1,] 3 4c4 <- array(a14,dim=c(3,4))
c4 [,1] [,2] [,3] [,4]
[1,] 1 4 7 10
[2,] 2 5 8 11
[3,] 3 6 9 12#lembar 1 dari c2
c2[,,1,] [,1] [,2] [,3]
[1,] 1 5 9
[2,] 2 6 10#buku ke 2 dari c2
c2[,,,2] [,1] [,2]
[1,] 5 7
[2,] 6 8#lembar ke 1 buku ke 3 dari c2
c2[,,1,3] [1] 9 102.2.4 Factor
#membuat vector
a15 <- c("A","B","AB","O")
a15[1] "A" "B" "AB" "O" #transform tipe data ke skala pengukuran nominal
d1 <- factor(a15)
d1[1] A B AB O
Levels: A AB B O#mengubah posisi level
d2 <- factor(a15,levels=c("O","A","B","AB"))
d2[1] A B AB O
Levels: O A B AB#melihat unique kategorik
levels(d2) [1] "O" "A" "B" "AB"#membuat vector
a16 <- c("SD","SMP","SMA")
a16[1] "SD" "SMP" "SMA"#transform tipe data ke skala pengukuran ordinal
d3 <- ordered(a16)
d3[1] SD SMP SMA
Levels: SD < SMA < SMPd4 <- ordered(a16, levels=a16)
d4[1] SD SMP SMA
Levels: SD < SMP < SMAd5 <- factor(a16, levels=a16, ordered=TRUE)
d5 [1] SD SMP SMA
Levels: SD < SMP < SMAlevels(d4)[1] "SD" "SMP" "SMA"#akses factor
#mengambil indeks ke 2 pada vector d1
d1[2] [1] B
Levels: A AB B O#mengambil indeks ke 2 dan 3 pada vector d4
d4[2:3] [1] SMP SMA
Levels: SD < SMP < SMA2.2.5 List
#bisa dikasih tanda ; kalo untuk menampilkan, tidak perlu dibuat per line
a1; b2; c1; d2 [1] 2 4 7 3 [,1] [,2] [,3] [,4]
[1,] 1 2 3 4
[2,] 5 6 7 8
[3,] 9 10 11 12, , 1
[,1] [,2]
[1,] 1 3
[2,] 2 4
, , 2
[,1] [,2]
[1,] 5 7
[2,] 6 8
, , 3
[,1] [,2]
[1,] 9 11
[2,] 10 12[1] A B AB O
Levels: O A B AB#membuat sekumpulan assignment menjadi list
e1 <- list(a1,b2,c1,d2)
e1[[1]]
[1] 2 4 7 3
[[2]]
[,1] [,2] [,3] [,4]
[1,] 1 2 3 4
[2,] 5 6 7 8
[3,] 9 10 11 12
[[3]]
, , 1
[,1] [,2]
[1,] 1 3
[2,] 2 4
, , 2
[,1] [,2]
[1,] 5 7
[2,] 6 8
, , 3
[,1] [,2]
[1,] 9 11
[2,] 10 12
[[4]]
[1] A B AB O
Levels: O A B ABe2 <- list(vect=a1,mat=b2,array=c1,fac=d2)
e2$vect
[1] 2 4 7 3
$mat
[,1] [,2] [,3] [,4]
[1,] 1 2 3 4
[2,] 5 6 7 8
[3,] 9 10 11 12
$array
, , 1
[,1] [,2]
[1,] 1 3
[2,] 2 4
, , 2
[,1] [,2]
[1,] 5 7
[2,] 6 8
, , 3
[,1] [,2]
[1,] 9 11
[2,] 10 12
$fac
[1] A B AB O
Levels: O A B AB#akses list
e1[[1]][1] 2 4 7 3e2$fac[1] A B AB O
Levels: O A B ABe2[2]$mat
[,1] [,2] [,3] [,4]
[1,] 1 2 3 4
[2,] 5 6 7 8
[3,] 9 10 11 12e1[c(2,4)][[1]]
[,1] [,2] [,3] [,4]
[1,] 1 2 3 4
[2,] 5 6 7 8
[3,] 9 10 11 12
[[2]]
[1] A B AB O
Levels: O A B ABdim(e2)NULLlength(e2)[1] 4names(e2)[1] "vect" "mat" "array" "fac" 2.2.6 DataFrame
a17 <- 11:15
a17[1] 11 12 13 14 15d5 <- factor(LETTERS[6:10])
d5[1] F G H I J
Levels: F G H I Jf1 <- data.frame(d5,a17)
f1 d5 a17
1 F 11
2 G 12
3 H 13
4 I 14
5 J 15#akses data frame
f1[1,2][1] 11f1[3,] d5 a17
3 H 13f1$d5[1] F G H I J
Levels: F G H I Jf1[,"a17"][1] 11 12 13 14 15colnames(f1)[1] "d5" "a17"str(f1)'data.frame': 5 obs. of 2 variables:
$ d5 : Factor w/ 5 levels "F","G","H","I",..: 1 2 3 4 5
$ a17: int 11 12 13 14 15summary(f1) d5 a17
F:1 Min. :11
G:1 1st Qu.:12
H:1 Median :13
I:1 Mean :13
J:1 3rd Qu.:14
Max. :15 #latihan 1
#Pada data1, buatlah peubah ‘baru1’ yang berisi nilai dari 12 sampai 1 secara berurutan
data1$baru1 <- 12:1
data1
2.2.7 Latihan
Latihan 1
c("la","ye")[rep(c(1,2,2,1),times=4)][1] "la" "ye" "ye" "la" "la" "ye" "ye" "la" "la" "ye" "ye" "la" "la" "ye" "ye" [16] "la"c("la","ye")[rep(rep(1:2,each=3),2)][1] "la" "la" "la" "ye" "ye" "ye" "la" "la" "la" "ye" "ye" "ye"Latihan 2
paste(c("x","y"),1:10,sep='')[1] "x1" "y2" "x3" "y4" "x5" "y6" "x7" "y8" "x9" "y10"seq(1,28,by=3)[1] 1 4 7 10 13 16 19 22 25 28Latihan 3
Seorang peneliti merancang sebuah perancangan percobaan RAKL dengan 4 perlakuan dan 3 kelompok (anggaplah respon percobaan berupa baris bilangan). Bantulah peneliti tersebut untuk membuat raw data seperti output sebagai berikut!
perl <- paste("P",rep(c(1:4),each=3),sep="") kel <- rep(c(1:3),times=4) resp <- seq(1,23,by=2) data1 <- data.frame(perl,kel,resp) data1perl kel resp 1 P1 1 1 2 P1 2 3 3 P1 3 5 4 P2 1 7 5 P2 2 9 6 P2 3 11 7 P3 1 13 8 P3 2 15 9 P3 3 17 10 P4 1 19 11 P4 2 21 12 P4 3 23
2.2.8 operator-operator lain
is.vector() -> apakah objec bentuk vector?
is.matrix() -> apakah objec bentuk matrix?
is.array() -> apakah objec bentuk array?
is.factor() -> apakah objec tipe factor?
is.list() -> apakah objec list?
is.data.frame() -> apakah objec dataframe?
as.vector() -> operator membuat vector
as.matrix() -> operator membuat matrix
as.array() -> operator membentuk tipe array
as.factor() -> operator mengubah tipe data menjadi factor
as.list() -> operator membentuk list
as.data.frame() -> operator membentuk dataframe
BAB 3
3.1 Manejemen DataFrame
3.1.1 Membuat dan peubah dataframe
Membuat DataFrame
id_mhw = paste("id", rep(1:10), sep="") id_mhw[1] "id1" "id2" "id3" "id4" "id5" "id6" "id7" "id8" "id9" "id10"stat = c(86,87,90,91,92,78,98,77,89,80) stat[1] 86 87 90 91 92 78 98 77 89 80math = c(79,92,87,87,90,79,92,80,85,82) math[1] 79 92 87 87 90 79 92 80 85 82data = data.frame(id_mhw, stat, math) dataid_mhw stat math 1 id1 86 79 2 id2 87 92 3 id3 90 87 4 id4 91 87 5 id5 92 90 6 id6 78 79 7 id7 98 92 8 id8 77 80 9 id9 89 85 10 id10 80 82membuat variabel/kolom baru-Dilakukan seperti membuat vektor (dengan indeks atau operasi seleksi
#import library library(dplyr) #dataframe id_mhw = paste("id", rep(1:10), sep="") stat = c(86,87,90,91,92,78,98,77,89,80) math = c(79,92,87,87,90,79,92,80,85,82) data = data.frame(id_mhw, stat, math) #cara 1 data$paralel = factor(rep(1:2,5)) dataid_mhw stat math paralel 1 id1 86 79 1 2 id2 87 92 2 3 id3 90 87 1 4 id4 91 87 2 5 id5 92 90 1 6 id6 78 79 2 7 id7 98 92 1 8 id8 77 80 2 9 id9 89 85 1 10 id10 80 82 2#cara 2 cara_2 = data cara_2[,'pararel1'] <- factor(rep(1:2,5)) cara_2id_mhw stat math paralel pararel1 1 id1 86 79 1 1 2 id2 87 92 2 2 3 id3 90 87 1 1 4 id4 91 87 2 2 5 id5 92 90 1 1 6 id6 78 79 2 2 7 id7 98 92 1 1 8 id8 77 80 2 2 9 id9 89 85 1 1 10 id10 80 82 2 2#cara 3 cara_3 <- data %>% mutate('pararel3' = factor(rep(1:2,5))) cara_3id_mhw stat math paralel pararel3 1 id1 86 79 1 1 2 id2 87 92 2 2 3 id3 90 87 1 1 4 id4 91 87 2 2 5 id5 92 90 1 1 6 id6 78 79 2 2 7 id7 98 92 1 1 8 id8 77 80 2 2 9 id9 89 85 1 1 10 id10 80 82 2 2menambah baris baru
#dataframe id_mhw = paste("id", rep(1:10), sep="") stat = c(86,87,90,91,92,78,98,77,89,80) math = c(79,92,87,87,90,79,92,80,85,82) data = data.frame(id_mhw, stat, math) data$paralel = factor(rep(1:2,5)) #cara 1 data[nrow(data) + 1,] = c("id11","78", "89", "2") data[nrow(data) + 1,] = c("id12","80", "89", "2") dataid_mhw stat math paralel 1 id1 86 79 1 2 id2 87 92 2 3 id3 90 87 1 4 id4 91 87 2 5 id5 92 90 1 6 id6 78 79 2 7 id7 98 92 1 8 id8 77 80 2 9 id9 89 85 1 10 id10 80 82 2 11 id11 78 89 2 12 id12 80 89 2
3.1.2 Subsetting Data
Subsetting Data (fungsi operator ==, !=, >, >=, <, <=, %in%, duplicated, is,na())
dilakukan untuk akses sebagian data membuat ide logic untuk diterapkan dalam vektor logic yang diinginkan.
#dataframe id_mhw = paste("id", rep(1:10), sep="") stat = c(86,87,90,91,92,78,98,77,89,80) math = c(79,92,87,87,90,79,92,80,85,82) data = data.frame(id_mhw, stat, math) data$paralel = factor(rep(1:2,5)) #cara 1 data[nrow(data) + 1,] = c("id11","78", "89", "2") data[nrow(data) + 1,] = c("id12","80", "89", "2") #op == datas1 <- data$paralel==1 data[datas1,]id_mhw stat math paralel 1 id1 86 79 1 3 id3 90 87 1 5 id5 92 90 1 7 id7 98 92 1 9 id9 89 85 1#op == | datas2 <- data$stat == 90 | data$math == 90 data[datas2,]id_mhw stat math paralel 3 id3 90 87 1 5 id5 92 90 1#op != datas3 <- data$paralel != 2 data[datas3,]id_mhw stat math paralel 1 id1 86 79 1 3 id3 90 87 1 5 id5 92 90 1 7 id7 98 92 1 9 id9 89 85 1#op >=, <= datas4 <- data$stat >=80 & data$math <=90 data[datas4,]id_mhw stat math paralel 1 id1 86 79 1 3 id3 90 87 1 4 id4 91 87 2 5 id5 92 90 1 9 id9 89 85 1 10 id10 80 82 2 12 id12 80 89 2#op %in% datas5 <- data$stat %in% c(80,85,90,95) data[datas5,]id_mhw stat math paralel 3 id3 90 87 1 10 id10 80 82 2 12 id12 80 89 2#op duplicated datas6 <- duplicated(data$id_mhw) data[datas6,][1] id_mhw stat math paralel <0 rows> (or 0-length row.names)#op is,na() #cek data kosong di paralel indeks7 = is.na(data$paralel) datas7 = data[indeks7,] datas7[1] id_mhw stat math paralel <0 rows> (or 0-length row.names)#op is,null() #cek dataframe ada yang null atau tidak is.null(data)[1] FALSE# contoh data[nrow(data) + 1,] = c("id12","80", "89", "") data <- data[-13,] dataid_mhw stat math paralel 1 id1 86 79 1 2 id2 87 92 2 3 id3 90 87 1 4 id4 91 87 2 5 id5 92 90 1 6 id6 78 79 2 7 id7 98 92 1 8 id8 77 80 2 9 id9 89 85 1 10 id10 80 82 2 11 id11 78 89 2 12 id12 80 89 2
3.1.3 Mengurutkan Data (order(), sort(), which(), rev(), unique())
dilakukan untuk mengurutkan data berdasarkan beberapa peubah tertentu dilakukan dengan membuat vektork logika untuk melakukan pengurutan data
#dataframe id_mhw = paste("id", rep(1:10), sep="") stat = c(86,87,90,91,92,78,98,77,89,80) math = c(79,92,87,87,90,79,92,80,85,82) data = data.frame(id_mhw, stat, math) data$paralel = factor(rep(1:2,5)) #cara 1 data[nrow(data) + 1,] = c("id11","78", "89", "2") data[nrow(data) + 1,] = c("id12","80", "89", "2") #temp table datas2 <- data datas2$segment <- c('high','low','low','high','med','med','low','high','med','low','high','low') datas2$gender <- c('M','M','M','F','F','M','F','F','F','M','F','F') datas2id_mhw stat math paralel segment gender 1 id1 86 79 1 high M 2 id2 87 92 2 low M 3 id3 90 87 1 low M 4 id4 91 87 2 high F 5 id5 92 90 1 med F 6 id6 78 79 2 med M 7 id7 98 92 1 low F 8 id8 77 80 2 high F 9 id9 89 85 1 med F 10 id10 80 82 2 low M 11 id11 78 89 2 high F 12 id12 80 89 2 low F# order() # Simple datas2[order(datas2$stat),]id_mhw stat math paralel segment gender 8 id8 77 80 2 high F 6 id6 78 79 2 med M 11 id11 78 89 2 high F 10 id10 80 82 2 low M 12 id12 80 89 2 low F 1 id1 86 79 1 high M 2 id2 87 92 2 low M 9 id9 89 85 1 med F 3 id3 90 87 1 low M 4 id4 91 87 2 high F 5 id5 92 90 1 med F 7 id7 98 92 1 low F# rumit datas2[ order(datas2$segment, (datas2$gender=='M')*as.numeric(datas2$stat), (datas2$gender=='F')*as.numeric(datas2$math) ), ] %>% select(segment, gender, stat, math)segment gender stat math 8 high F 77 80 4 high F 91 87 11 high F 78 89 1 high M 86 79 12 low F 80 89 7 low F 98 92 10 low M 80 82 2 low M 87 92 3 low M 90 87 9 med F 89 85 5 med F 92 90 6 med M 78 79#rank datas2$rank = rank(datas2$stat) datas2[order(datas2$rank),]id_mhw stat math paralel segment gender rank 8 id8 77 80 2 high F 1.0 6 id6 78 79 2 med M 2.5 11 id11 78 89 2 high F 2.5 10 id10 80 82 2 low M 4.5 12 id12 80 89 2 low F 4.5 1 id1 86 79 1 high M 6.0 2 id2 87 92 2 low M 7.0 9 id9 89 85 1 med F 8.0 3 id3 90 87 1 low M 9.0 4 id4 91 87 2 high F 10.0 [ reached 'max' / getOption("max.print") -- omitted 2 rows ]#sort - mengurutkan # untuk vektor berlaku x3 <- c(2,4,3,2,7,8) sort(x3)[1] 2 2 3 4 7 8# untuk data frame tidak berlaku datas2[sort(datas2$stat),]id_mhw stat math paralel segment gender rank NA <NA> <NA> <NA> <NA> <NA> <NA> NA NA.1 <NA> <NA> <NA> <NA> <NA> <NA> NA NA.2 <NA> <NA> <NA> <NA> <NA> <NA> NA NA.3 <NA> <NA> <NA> <NA> <NA> <NA> NA NA.4 <NA> <NA> <NA> <NA> <NA> <NA> NA NA.5 <NA> <NA> <NA> <NA> <NA> <NA> NA NA.6 <NA> <NA> <NA> <NA> <NA> <NA> NA NA.7 <NA> <NA> <NA> <NA> <NA> <NA> NA NA.8 <NA> <NA> <NA> <NA> <NA> <NA> NA NA.9 <NA> <NA> <NA> <NA> <NA> <NA> NA [ reached 'max' / getOption("max.print") -- omitted 2 rows ]#which - mengurutkan indek bernilai true datas2[which(datas2$stat==80),]id_mhw stat math paralel segment gender rank 10 id10 80 82 2 low M 4.5 12 id12 80 89 2 low F 4.5#rev - mengurutkan kebalikan #vector datas2$id_mhw[1] "id1" "id2" "id3" "id4" "id5" "id6" "id7" "id8" "id9" "id10" [11] "id11" "id12"rev(datas2$id_mhw)[1] "id12" "id11" "id10" "id9" "id8" "id7" "id6" "id5" "id4" "id3" [11] "id2" "id1"#mengurutkan data berdasarkan kolom secara terbalik df datas2id_mhw stat math paralel segment gender rank 1 id1 86 79 1 high M 6.0 2 id2 87 92 2 low M 7.0 3 id3 90 87 1 low M 9.0 4 id4 91 87 2 high F 10.0 5 id5 92 90 1 med F 11.0 6 id6 78 79 2 med M 2.5 7 id7 98 92 1 low F 12.0 8 id8 77 80 2 high F 1.0 9 id9 89 85 1 med F 8.0 10 id10 80 82 2 low M 4.5 [ reached 'max' / getOption("max.print") -- omitted 2 rows ]rev(datas2)rank gender segment paralel math stat id_mhw 1 6.0 M high 1 79 86 id1 2 7.0 M low 2 92 87 id2 3 9.0 M low 1 87 90 id3 4 10.0 F high 2 87 91 id4 5 11.0 F med 1 90 92 id5 6 2.5 M med 2 79 78 id6 7 12.0 F low 1 92 98 id7 8 1.0 F high 2 80 77 id8 9 8.0 F med 1 85 89 id9 10 4.5 M low 2 82 80 id10 [ reached 'max' / getOption("max.print") -- omitted 2 rows ]#mengurutkan data berdasarkan row datas2id_mhw stat math paralel segment gender rank 1 id1 86 79 1 high M 6.0 2 id2 87 92 2 low M 7.0 3 id3 90 87 1 low M 9.0 4 id4 91 87 2 high F 10.0 5 id5 92 90 1 med F 11.0 6 id6 78 79 2 med M 2.5 7 id7 98 92 1 low F 12.0 8 id8 77 80 2 high F 1.0 9 id9 89 85 1 med F 8.0 10 id10 80 82 2 low M 4.5 [ reached 'max' / getOption("max.print") -- omitted 2 rows ]datas2[rev(rownames(datas2)),]id_mhw stat math paralel segment gender rank 12 id12 80 89 2 low F 4.5 11 id11 78 89 2 high F 2.5 10 id10 80 82 2 low M 4.5 9 id9 89 85 1 med F 8.0 8 id8 77 80 2 high F 1.0 7 id7 98 92 1 low F 12.0 6 id6 78 79 2 med M 2.5 5 id5 92 90 1 med F 11.0 4 id4 91 87 2 high F 10.0 3 id3 90 87 1 low M 9.0 [ reached 'max' / getOption("max.print") -- omitted 2 rows ]#unique cari lagi x <- unique(data$id_mhw) x[1] "id1" "id2" "id3" "id4" "id5" "id6" "id7" "id8" "id9" "id10" [11] "id11" "id12"
3.1.4 Recording Data
digunakan untuk membuat nilai baru dari nilai peubah yang sudah ada dapat dilakukan secara logical, fungi ifelse(), recode(), dan fungsi lainnya.
#dataframe id_mhw = paste("id", rep(1:10), sep="") stat = c(86,87,90,91,92,78,98,77,89,80) math = c(79,92,87,87,90,79,92,80,85,82) data = data.frame(id_mhw, stat, math) data$paralel = factor(rep(1:2,5)) data$segment <- c('high','low','low','high','med','med','low','high','med','low') data$gender <- c('M','M','M','F','F','M','F','F','F','M') dataid_mhw stat math paralel segment gender 1 id1 86 79 1 high M 2 id2 87 92 2 low M 3 id3 90 87 1 low M 4 id4 91 87 2 high F 5 id5 92 90 1 med F 6 id6 78 79 2 med M 7 id7 98 92 1 low F 8 id8 77 80 2 high F 9 id9 89 85 1 med F 10 id10 80 82 2 low M#logical data$code1 = 1*(data$stat>=85) + 0*(data$stat<85) dataid_mhw stat math paralel segment gender code1 1 id1 86 79 1 high M 1 2 id2 87 92 2 low M 1 3 id3 90 87 1 low M 1 4 id4 91 87 2 high F 1 5 id5 92 90 1 med F 1 6 id6 78 79 2 med M 0 7 id7 98 92 1 low F 1 8 id8 77 80 2 high F 0 9 id9 89 85 1 med F 1 10 id10 80 82 2 low M 0#if new_segment <- matrix(nrow=length(data$segment),ncol=1) for (i in 1:nrow(data)){ x <- data[i,'segment'] if (x=='high'){new_segment[i] = 'h'} else if (x=='med'){new_segment[i]='m'}else{new_segment[i]='l'} } data$if_segment <- new_segment dataid_mhw stat math paralel segment gender code1 if_segment 1 id1 86 79 1 high M 1 h 2 id2 87 92 2 low M 1 l 3 id3 90 87 1 low M 1 l 4 id4 91 87 2 high F 1 h 5 id5 92 90 1 med F 1 m 6 id6 78 79 2 med M 0 m 7 id7 98 92 1 low F 1 l 8 id8 77 80 2 high F 0 h 9 id9 89 85 1 med F 1 m [ reached 'max' / getOption("max.print") -- omitted 1 rows ]#switch new_gender <- matrix(nrow=length(data$gender),ncol=1) for (i in 1:nrow(data)){ x <- data[i,'gender'] new_gender[i] <- switch(x,"M" = "Male","F" = "Female") } data$switch_gender <- new_gender dataid_mhw stat math paralel segment gender code1 if_segment switch_gender 1 id1 86 79 1 high M 1 h Male 2 id2 87 92 2 low M 1 l Male 3 id3 90 87 1 low M 1 l Male 4 id4 91 87 2 high F 1 h Female 5 id5 92 90 1 med F 1 m Female 6 id6 78 79 2 med M 0 m Male 7 id7 98 92 1 low F 1 l Female 8 id8 77 80 2 high F 0 h Female [ reached 'max' / getOption("max.print") -- omitted 2 rows ]#ifelse data$code2 = ifelse(data$stat>85,"GOOD","NOT BAD") dataid_mhw stat math paralel segment gender code1 if_segment switch_gender 1 id1 86 79 1 high M 1 h Male 2 id2 87 92 2 low M 1 l Male 3 id3 90 87 1 low M 1 l Male 4 id4 91 87 2 high F 1 h Female 5 id5 92 90 1 med F 1 m Female 6 id6 78 79 2 med M 0 m Male 7 id7 98 92 1 low F 1 l Female code2 1 GOOD 2 GOOD 3 GOOD 4 GOOD 5 GOOD 6 NOT BAD 7 GOOD [ reached 'max' / getOption("max.print") -- omitted 3 rows ]#recode library(tidyverse) #recode_factor data$code4 <- recode_factor(data$code2, 'GOOD' = 1, 'NOT BAD' = 0) #case_when() data$case_when <- case_when((data$stat > 78) ~ "high",TRUE ~ "unknown") dataid_mhw stat math paralel segment gender code1 if_segment switch_gender 1 id1 86 79 1 high M 1 h Male 2 id2 87 92 2 low M 1 l Male 3 id3 90 87 1 low M 1 l Male 4 id4 91 87 2 high F 1 h Female 5 id5 92 90 1 med F 1 m Female 6 id6 78 79 2 med M 0 m Male code2 code4 case_when 1 GOOD 1 high 2 GOOD 1 high 3 GOOD 1 high 4 GOOD 1 high 5 GOOD 1 high 6 NOT BAD 0 unknown [ reached 'max' / getOption("max.print") -- omitted 4 rows ]
3.1.5 Merging Data
bisa dilakukan denga rbind atau cbind lebih mudah dengan fungsi merge
#data sampel datas1 = c(1,2,3) datas1[1] 1 2 3datas2 = c(4,5,6) datas2[1] 4 5 6#digunakan untuk menggabungkan kolomOutput cbind(datas1,datas2)datas1 datas2 [1,] 1 4 [2,] 2 5 [3,] 3 6#digunakan untuk menggabungkan barisOutput rbind(datas1,datas2)[,1] [,2] [,3] datas1 1 2 3 datas2 4 5 6#tabel product id_cust = paste("ID", rep(120:129), sep="") product = paste("barang",11:20,sep=" ") tabel_product = data.frame(id_cust, product) tabel_productid_cust product 1 ID120 barang 11 2 ID121 barang 12 3 ID122 barang 13 4 ID123 barang 14 5 ID124 barang 15 6 ID125 barang 16 7 ID126 barang 17 8 ID127 barang 18 9 ID128 barang 19 10 ID129 barang 20#tabel daerah id_cust = c("ID122", "ID126", "ID128", "ID129", "ID130", "ID133", "ID135") asal = paste("Kota",1:7,sep="-") tabel_daerah = data.frame(id_cust, asal) tabel_daerahid_cust asal 1 ID122 Kota-1 2 ID126 Kota-2 3 ID128 Kota-3 4 ID129 Kota-4 5 ID130 Kota-5 6 ID133 Kota-6 7 ID135 Kota-7#LEFT JOIN datas8 = merge(x=tabel_product,y=tabel_daerah,by="id_cust",all.x=TRUE) datas8id_cust product asal 1 ID120 barang 11 <NA> 2 ID121 barang 12 <NA> 3 ID122 barang 13 Kota-1 4 ID123 barang 14 <NA> 5 ID124 barang 15 <NA> 6 ID125 barang 16 <NA> 7 ID126 barang 17 Kota-2 8 ID127 barang 18 <NA> 9 ID128 barang 19 Kota-3 10 ID129 barang 20 Kota-4#INNER JOIN datas9 = merge(x=tabel_product,y=tabel_daerah,by="id_cust", all=FALSE) datas9id_cust product asal 1 ID122 barang 13 Kota-1 2 ID126 barang 17 Kota-2 3 ID128 barang 19 Kota-3 4 ID129 barang 20 Kota-4#RIGHT JOIN datas11 = merge(x=tabel_product,y=tabel_daerah,by="id_cust",all.y=TRUE) datas11id_cust product asal 1 ID122 barang 13 Kota-1 2 ID126 barang 17 Kota-2 3 ID128 barang 19 Kota-3 4 ID129 barang 20 Kota-4 5 ID130 <NA> Kota-5 6 ID133 <NA> Kota-6 7 ID135 <NA> Kota-7#OUTER JOIN datas12 = merge(x=tabel_product,y=tabel_daerah,by="id_cust",all=TRUE) datas12id_cust product asal 1 ID120 barang 11 <NA> 2 ID121 barang 12 <NA> 3 ID122 barang 13 Kota-1 4 ID123 barang 14 <NA> 5 ID124 barang 15 <NA> 6 ID125 barang 16 <NA> 7 ID126 barang 17 Kota-2 8 ID127 barang 18 <NA> 9 ID128 barang 19 Kota-3 10 ID129 barang 20 Kota-4 11 ID130 <NA> Kota-5 12 ID133 <NA> Kota-6 13 ID135 <NA> Kota-7
3.1.7 Re-shaping
Membentuk data baru dengan cara:1) long to wide, 2) wide to long Menggunakan fungsi reshape()
#create dataframe kota = c("Manado", "Jakarta", "Bandung") bekerja = c("23400","56700","34500") tidak_kerja = c("10000","30000","12000") tabel = data.frame(kota, bekerja, tidak_kerja) colnames(tabel)<- c("Nama Kota","Bekerja","Tidak Bekerja") tabelNama Kota Bekerja Tidak Bekerja 1 Manado 23400 10000 2 Jakarta 56700 30000 3 Bandung 34500 12000#wide to long -> data frame diurutkan by varying (harus gunakan varying dan v.names) widetolong<- reshape(tabel,idvar="Nama Kota", varying = c("Bekerja","Tidak Bekerja"), v.name=c("value"), times=c("Bekerja","Tidak Bekerja"), new.row.names = 1:100, direction="long") widetolongNama Kota time value 1 Manado Bekerja 23400 2 Jakarta Bekerja 56700 3 Bandung Bekerja 34500 4 Manado Tidak Bekerja 10000 5 Jakarta Tidak Bekerja 30000 6 Bandung Tidak Bekerja 12000# long to wide -> harus ada nama kolom buat idvar dan v.names longtowide <- reshape(widetolong, idvar="Nama Kota", v.names = "value", timevar = "time", direction="wide") longtowideNama Kota value.Bekerja value.Tidak Bekerja 1 Manado 23400 10000 2 Jakarta 56700 30000 3 Bandung 34500 12000
3.1.8 latihan
Latihan 1
#create dataframe perl <- paste('P',rep(1:4,3),sep = '') kel <- rep(1:3,4) resp <- seq(1,23,by=2) data1 <- data.frame(perl,kel,resp) #Pada data1, buatlah peubah 'baru1' yang berisi nilai dari 12 sampai 1 secara berurutan data1$baru1 <- 12:1 data1perl kel resp baru1 1 P1 1 1 12 2 P2 2 3 11 3 P3 3 5 10 4 P4 1 7 9 5 P1 2 9 8 6 P2 3 11 7 7 P3 1 13 6 8 P4 2 15 5 9 P1 3 17 4 10 P2 1 19 3 11 P3 2 21 2 12 P4 3 23 1Latihan 2
#create dataframe perl <- paste('P',rep(1:4,3),sep = '') kel <- rep(1:3,4) resp <- seq(1,23,by=2) data1 <- data.frame(perl,kel,resp) #dari data1 tersebut ambillah yang termasuk kelompok 1 data2 <- data1[data1$kel == 1,] data2perl kel resp 1 P1 1 1 4 P4 1 7 7 P3 1 13 10 P2 1 19Latihan 3
#create dataframe perl <- paste('P',rep(1:4,3),sep = '') kel <- rep(1:3,4) resp <- seq(1,23,by=2) data1 <- data.frame(perl,kel,resp) #dari data1 tersebut ambillah yang termasuk kelompok 1 atau perlakuan p2 data3 <- data1[data1$kel == 1 | data1$perl=='P2',] data3perl kel resp 1 P1 1 1 2 P2 2 3 4 P4 1 7 6 P2 3 11 7 P3 1 13 10 P2 1 19Latihan 4
#create dataframe perl <- paste('P',rep(1:4,3),sep = '') kel <- rep(1:3,4) resp <- seq(1,23,by=2) data1 <- data.frame(perl,kel,resp) #dari data1 tersebut ambillah amatan yang respon bilangan prima data4 <- data1[data1$resp %in% c(2,3,5,7,11,13,17,19,23),] data4perl kel resp 2 P2 2 3 3 P3 3 5 4 P4 1 7 6 P2 3 11 7 P3 1 13 9 P1 3 17 10 P2 1 19 12 P4 3 23Latihan 5
#create dataframe perl <- paste('P',rep(1:4,3),sep = '') kel <- rep(1:3,4) resp <- seq(1,23,by=2) data1 <- data.frame(perl,kel,resp) #urutkan data1 tersebut berdasarkan kelompok secara ascending data5 <- data1[order(data1$kel,decreasing = F),] data5perl kel resp 1 P1 1 1 4 P4 1 7 7 P3 1 13 10 P2 1 19 2 P2 2 3 5 P1 2 9 8 P4 2 15 11 P3 2 21 3 P3 3 5 6 P2 3 11 9 P1 3 17 12 P4 3 23Latihan 6
#create dataframe perl <- paste('P',rep(1:4,3),sep = '') kel <- rep(1:3,4) resp <- seq(1,23,by=2) data1 <- data.frame(perl,kel,resp) #urutkan data1 tersebut berdasarkan kelompok secara descending data6 <- data1[order(data1$kel,decreasing = T),] data6perl kel resp 3 P3 3 5 6 P2 3 11 9 P1 3 17 12 P4 3 23 2 P2 2 3 5 P1 2 9 8 P4 2 15 11 P3 2 21 1 P1 1 1 4 P4 1 7 7 P3 1 13 10 P2 1 19Latihan 7
#create dataframe perl <- paste('P',rep(1:4,3),sep = '') kel <- rep(1:3,4) resp <- seq(1,23,by=2) data1 <- data.frame(perl,kel,resp) #urutkan data1 tersebut berdasarkan kelompok secara ascending dan respon secara descending data7 <- data1[order(data1$resp,decreasing = T),] data7perl kel resp 12 P4 3 23 11 P3 2 21 10 P2 1 19 9 P1 3 17 8 P4 2 15 7 P3 1 13 6 P2 3 11 5 P1 2 9 4 P4 1 7 3 P3 3 5 2 P2 2 3 1 P1 1 1data8 <- data7[order(data7$kel,decreasing = F),] #order by kelompok data8perl kel resp 10 P2 1 19 7 P3 1 13 4 P4 1 7 1 P1 1 1 11 P3 2 21 8 P4 2 15 5 P1 2 9 2 P2 2 3 12 P4 3 23 9 P1 3 17 6 P2 3 11 3 P3 3 5Latihan 8
#create dataframe perl <- paste('P',rep(1:4,3),sep = '') kel <- rep(1:3,4) resp <- seq(1,23,by=2) data1 <- data.frame(perl,kel,resp) #lakukanlah recoding pada data8 untuk variable respon dengan kondisi jika respon<15, maka #code=1,selainnya code = 0 library(car) data8$code3 <- recode(data8$resp,'1:14=1; else=0') data8perl kel resp code3 10 P2 1 19 0 7 P3 1 13 1 4 P4 1 7 1 1 P1 1 1 1 11 P3 2 21 0 8 P4 2 15 0 5 P1 2 9 1 2 P2 2 3 1 12 P4 3 23 0 9 P1 3 17 0 6 P2 3 11 1 3 P3 3 5 1Latihan 9
#create dataframe perl <- paste('P',rep(1:4,3),sep = '') kel <- rep(1:3,4) resp <- seq(1,23,by=2) data1 <- data.frame(perl,kel,resp) #gunakanlah data1 dengan tabel1 berdasarkan peubah pertamanya tabel1 <- data.frame(tr=c("p4","p2","p5"),k1=c(50,100,200)) data9 <- merge(data1,tabel1, by.x = 1, by.y = 1, all = F) data9[1] perl kel resp k1 <0 rows> (or 0-length row.names)data10 <- merge(data1,tabel1, by.x = 'perl', by.y = 'tr', all = T) data10perl kel resp k1 1 P1 1 1 NA 2 P1 2 9 NA 3 P1 3 17 NA 4 p2 NA NA 100 5 P2 2 3 NA 6 P2 3 11 NA 7 P2 1 19 NA 8 P3 3 5 NA 9 P3 1 13 NA 10 P3 2 21 NA 11 p4 NA NA 50 12 P4 1 7 NA 13 P4 2 15 NA 14 P4 3 23 NA 15 p5 NA NA 200Latihan 10
#create dataframe perl <- paste('P',rep(1:4,3),sep = '') kel <- rep(1:3,4) resp <- seq(1,23,by=2) data1 <- data.frame(perl,kel,resp) #ubahlah data1 menjadi data dengan setiap barisnya merupakan masing-masing perlakuan #long to wide data11 <- reshape(data1[,-4],idvar = 'perl',timevar = 'kel', direction = "wide") data11perl resp.1 resp.2 resp.3 1 P1 1 9 17 2 P2 19 3 11 3 P3 13 21 5 4 P4 7 15 23#long to wide data12 <- reshape(data11,idvar = 'perl',timevar = 'kel', direction = "long") data12perl kel resp.1 P1.1 P1 1 1 P2.1 P2 1 19 P3.1 P3 1 13 P4.1 P4 1 7 P1.2 P1 2 9 P2.2 P2 2 3 P3.2 P3 2 21 P4.2 P4 2 15 P1.3 P1 3 17 P2.3 P2 3 11 P3.3 P3 3 5 P4.3 P4 3 23
BAB 4
BAB 5
BAB 6
6.1.1 Menciptakan Fungsi Sendiri
nama fungsi <- function(argumen) isifungsi. Jika isifungsi memerlukan beberapa baris, maka dibutuhkan {}, sehingga persamaan fungsi akan menjadi nama fungsi <- function(argumen) {isifungsi}. argumen pada fungsi bisa didefinisikan default misal function(x=10){isifungsi}. argumen fungsi dapat berulang/tidak didefinisikan secara pasti(menggunakan “…”) contoh: function(x=10,....). Argumen fungsi dapat menerima nama fungsi r lain untuk dijalankan misalnya apply(x,1,mean) atau apply(x,1,sum).
output luaran dari funsi adalah object, bisa dituliskan objeknya menggunakan return.
Nama argumen tidak perlu dituliskan, kecuali urutan diabaikan contoh : fungsi1(10,20) vs fungsi(arg2=10, arg1=10).
std.dev <- function(x=rnorm(10,5,23)) sqrt(var(x))
std.devs <- function(x){return(sqrt(var(x)))}
x <- rnorm(10,5,23)
std.dev()[1] 10.28777std.devs(x)[1] 20.53704Untuk menangani kesalahan dalam fungsi disediakan fungsi-fungsi:
try: pembungkus untuk menjalankan ekspresi yang mungkin gagal dan memungkinkan kode pengguna untuk menangani pemulihan kesalahan. contoh ; try(log(’a"))try(log("a"))Error in log("a") : non-numeric argument to mathematical functiontryCatchmenyediakan mekanisme untuk menangani kondisi yang tidak biasa, termasuk kesalahan dan peringatan. contoh : tryCatch(log(10),finally=print(‘hello’))tryCatch(log(-10),finally=print('hello'))[1] "hello"[1] NaNwarning: menghasilkan pesan peringatan yang sesuai dengan argumanenyastop: menghentikan eksekusi ekspresi saat ini
6.1.2 Pemrograman berorientasi objek (PBO)
Pemrograman berorientasi objek atau PBO merupakan sebuah paradigma dalam pembuatan sebuah program. OOP menitikberatkan pada identifikasi objek-objek yang terlibat dalam sebuah program dan bagaimana objek-objek tersebut berinteraksi. Pada PBO, program yang dibangun akan dibagi-bagi menjadi objek-objek. OOP menyediakan class dan object sebagai alat dasar untuk meminimalisir dan mengatur kompleksitas dari program.
Beberapa prinsip dari PBO adalah:
1. Abstraksi: suatu cara melihat suatu objek dalam bentuk yang sederhana. Selalu berkaitan dengan class 2. Enkapsulasi: konsep tentang pengikatan data atau metode yang berbeda yang disatukan atau “dikapsulkan” menjadi satu unit data.
3. Inheritance: konsep PBO dimana kita dapat membentuk class baru yang “mewarisi” atau memiliki bagian-bagian dari class yang sudah ada sebelumnya.
4. Polymorphism: konsep dimana suatu objek yang berbeda-beda dapat diakses melalui interface yang sama.
Kelas Merupakan definisi statik (kerangka dasar) dari objek yang akan diciptakan. Suatu class dibagi menjadi:
- Property: data atau state yang dimiliki oleh class. Contoh pada class Mobil, memiliki property: warna, model, produsen.
- Method: behavior (perilaku) sebuah class. Bisa dikatakan sebagai aksi atau tindakan yang bisa dilakukan oleh suatu class. Contoh pada class Mobil, memiliki method: Start, Stop, Change Gear, Turn.
Object adalah komponen yang diciptakan dari class (instance of class). Satu class bisa menghasilkan banyak objek. Setiap objek memiliki karakteristik dan fitur masing masing.
6.1.3 Objek: Class System S3
Suatu class dalam system S3 tidak didefinisikan dengan ketat. Fungsi class digunakan untuk menjadikan sebuah objek menjadi class yang diinginkan. class coords : untuk menyimpan data koordinat titik pada 2 buah vektor X dan y. Metode class terdiri dari metode print, lenght, bbox, dan plot. turunan dari class coords adalah vcoords karena ada tambahan property
Contoh 1: class pts
# objek "pts" dari list vektor x dan y
pts <- list(x = round(rnorm(5),2),
y = round(rnorm(5),2))
class(pts)[1] "list"pts$x
[1] 1.35 -1.42 -0.32 0.43 0.43
$y
[1] 0.32 -1.54 1.42 0.28 0.12length(pts)[1] 2Menjadikan class pts sebagai class baru yaitu class coords**
class(pts) <- "coords"
class(pts)[1] "coords"pts$x
[1] 1.35 -1.42 -0.32 0.43 0.43
$y
[1] 0.32 -1.54 1.42 0.28 0.12
attr(,"class")
[1] "coords"Langkah sederhana dalam membuat objek dari suatu class seperti ini sangat tidak dianjurkan karena nilai-nilai instannya mungkin tidak tepat.
Konstruktor merupakan Sebuah fungsi konstruktor dibutuhkan untuk mengecek instan sesuai dengan objek. Misalkan pada kasus class coords:
Memeriksa x dan y harus berupa numerik
vektor x dan y tidak boleh NA, NaN atau Infinite
vektor harus memiliki panjang yang sama, dsb
Fungsi Konstruktor untuk Membuat Class coords
coords <- function(x,y){
if (!is.numeric(x) || !is.numeric(y) ||
!all(is.finite(x)) || !all(is.finite(y)))
stop("Titik koordinat tidak tepat!")
if(length(x) != length(y))
stop("Panjang koordinat berbeda")
pts <- list(x=x, y=y)
class(pts) = "coords"
pts
}
# Menyusun class pts dengan `coords`
pts <- coords (x= round ( rnorm (5),2),
y= round ( rnorm (5),2))
pts$x
[1] -0.49 -0.13 0.58 -2.21 -0.62
$y
[1] -1.02 0.53 1.37 0.65 -1.68
attr(,"class")
[1] "coords"Aksesor Untuk mengakses data dalam class coords, dapat menggunakan akses objek awalnya (list).
# mengakses x secara langsung
pts$x[1] -0.49 -0.13 0.58 -2.21 -0.62pts$y[1] -1.02 0.53 1.37 0.65 -1.68pts$x
[1] -0.49 -0.13 0.58 -2.21 -0.62
$y
[1] -1.02 0.53 1.37 0.65 -1.68
attr(,"class")
[1] "coords"Namun secara formal tidak dianjurkan mengakses data secara langsung. Diperlukan suatu fungsi aksesor untuk mengakses data pada class coords
Ilustrasi akses pada class coords dengan menggunakan 2 fungsi
# mendefinisi Fungi Aksesor
xcoords <- function(obj)obj$x
ycoords <- function(obj)obj$y
# mengakses x dan y dengan Fungsi Aksesor
xcoords(pts)[1] -0.49 -0.13 0.58 -2.21 -0.62ycoords(pts)[1] -1.02 0.53 1.37 0.65 -1.68Fungsi Generik * Fungsi generik merupakan suatu method dari suatu class objek dalam R. * Fungsi generik bertindak untuk beralih memilih fungsi tertentu atau metode tertentu yang dijalankan sesuai dengan class-nya.
Terdapat beberapa fungsi generik yang sudah ada:
print,plot,length, dll.Untuk mendefinisi ulang suatu fungsi generik digunakan syntax: method.class <-function() ekspresibaru
Method Print merupakan cara menampilkan data pada suatu objek Class System S3.
Contoh menampilkan data class coords
print.coords <- function(obj){
print (paste("(",
format(xcoords(obj)),
",",
format(ycoords(obj)),
")", sep =""),
quote = FALSE )
}
print.coords(pts)[1] (-0.49,-1.02) (-0.13, 0.53) ( 0.58, 1.37) (-2.21, 0.65) (-0.62,-1.68)pts[1] (-0.49,-1.02) (-0.13, 0.53) ( 0.58, 1.37) (-2.21, 0.65) (-0.62,-1.68)class(pts)[1] "coords"Method Length digunakan untuk menghitung banyaknya anggota dari objek. Pada ilustrasi classs pts, fungsi length akan menghitung banyaknya anggota list pada coords sebelumnya, sehingga kurang tepat.
length(pts)[1] 2Mendefinisikan ulang method length untuk class coords
# mendefinisikan ulang method length
length.coords <- function(obj)length(xcoords(obj))
length.coords(pts)[1] 5length(pts)[1] 5Membuat Fungsi Generik Baru Untuk membuat suatu method yang dapat diwariskan, maka method tersebut harus dijadikan fungsi generik.
Method bbox Misal akan dibuat method bbox yang merupakan sebuah boundary box.
# menjadikan bbox sebagai fungsi generik
bbox <- function(obj)UseMethod("bbox")
# mendefinisikan method bbox untuk class coords
bbox.coords <- function(obj){
matrix(c(range(xcoords(obj)), range(ycoords(obj))),
nc=2, dimnames = list (c("min", "max"),c("x:", "y:")))
}
# penerapan bbox pada pts
bbox.coords(pts) x: y:
min -2.21 -1.68
max 0.58 1.37bbox(pts) x: y:
min -2.21 -1.68
max 0.58 1.37Method Plot Misalkan akan dibuat method plot khusus untuk class coords
# mendefinisikan method plot
plot.coords <- function(obj,bbox=FALSE,...){
if (bbox){
plot (xcoords(obj),ycoords(obj),...);
x <- c(bbox(obj)[1],bbox(obj)[2],bbox(obj)[2],bbox(obj)[1]);
y <- c(bbox(obj)[3],bbox(obj)[3],bbox(obj)[4],bbox(obj)[4]);
polygon(x,y)
}
else {
plot (xcoords(obj),ycoords(obj),...)
}
}
# membuat plot pts
plot.coords(pts)
plot.coords(pts, bbox=T, pch=16, col="orange", main="Plot (x,y)")
Pewariasan class Sebagai ilustrasi, bila diinginkan sebuah objek yang berisi lokasi (coords) dan terdapat nilai (value) pada lokasi tersebut. Perlu menciptakan class baru vcoords sebagai turunan dari coords.
Fungsi Konstruktor dari class vcoords
vcoords <- function (x,y,v){
if (!is.numeric (x)|| !is.numeric (y) || !is.numeric (v)|| !all(is.finite(x))|| !all(is.finite(y)))
stop ("Titik koordinat tidak tepat !")
if (length (x) != length (y)||
length (x) != length (v))
stop ("Panjang koordinat berbeda")
pts <- list (x=x,y=y,v=v)
class (pts)= c("vcoords", "coords")
pts
}
nilai <- function(obj)obj$vFungsi xcoords, ycoords dan method bbox dari class coords masih sama sehingga tidak perlu didefinisi ulang.
vpts <- vcoords(x = round(rnorm(5),2),
y = round(rnorm(5),2),
v = round(runif(5,0,100)))
vpts[1] (-0.57,-1.44) (-0.38,-1.21) ( 0.47,-1.90) (-0.62, 1.22) (-0.16, 0.54)xcoords(vpts)[1] -0.57 -0.38 0.47 -0.62 -0.16ycoords(vpts)[1] -1.44 -1.21 -1.90 1.22 0.54bbox(vpts) x: y:
min -0.62 -1.90
max 0.47 1.22Mendefinisikan ulang method print untuk class vcoords
# Mendifinisikan ulang
print.vcoords <- function (obj){
print (paste ("(",
format (xcoords(obj)),
", ",
format (ycoords(obj)),
"; ", format (nilai(obj)),
")",sep=""),
quote =FALSE)
}
vpts[1] (-0.57, -1.44; 44) (-0.38, -1.21; 43) ( 0.47, -1.90; 47) (-0.62, 1.22; 42)
[5] (-0.16, 0.54; 15)Mendefinisikan ulang method plot untuk class vcoords
# Mendifinisikan ulang
plot.vcoords <- function(obj,txt=FALSE,bbox=FALSE,...){
if (bbox){
if (!txt){
plot (xcoords(obj), ycoords(obj),...);
}
else {
plot (xcoords(obj), ycoords(obj),type="n",...);
text (xcoords(obj), ycoords(obj),nilai(obj),...);
}
x <- c(bbox(pts)[1], bbox(pts)[2], bbox(pts)[2], bbox(pts)[1]);
y <- c(bbox(pts)[3], bbox(pts)[3], bbox(pts)[4], bbox(pts)[4]);
polygon (x,y)
}
else {
if (!txt){
plot (xcoords(obj), ycoords(obj),...);
}
else {
plot (xcoords(obj), ycoords(obj),type="n",...);
text (xcoords(obj), ycoords(obj),nilai(obj) ,...);
}
}
}
plot.vcoords(vpts)
plot.vcoords(vpts, txt=T, bbox=T, col="red")
Method Subset Diinginkan untuk memiliki akses terhadap metode subset. Misal diiginkan ekspresi berikut: vpts[ xcoords(vpts) < 0 & ycoords(vpts) < 0 ]. Hal di atas dapat ditangani dengan mendefinisikan metode untuk [
# Mendefinisikan operator [
`[.vcoords` <- function(x,i){
vcoords(xcoords(x)[i], ycoords(x)[i], nilai(x)[i])
}
# Mengakses anggota class vcoords 1:3
vpts[1:3][1] (-0.57, -1.44; 44) (-0.38, -1.21; 43) ( 0.47, -1.90; 47)Pemeriksaan Cuatu Class Objek Untuk mengecek apakah suatu objek merupakan suatu class digunakan fungsi inherits
inherits(pts, "coords")[1] TRUEinherits(pts, "vcoords")[1] FALSEinherits(vpts, "coords")[1] TRUEinherits(vpts, "vcoords")[1] TRUERingkasan Class System S3 : Class System S3 memberikan fasilitas object-oriented, tetapi terlalu longgar Contoh ekspresi berikut diperbolehkan dalam R, padahal class "lm" merupakan class untuk pemodelan linier
model <- 1:10
class(model) <- "lm"
class(model)[1] "lm"6.1.4 Objek: Class System S4
Class System S4: Mengatasi masalah dalam class System S3 dengan sistem objek lebih formal. Salah satu keuntungannya adalah sistem penurunan dari class/objek. Dalam sistem objek formal, setiap objek didefinisikan secara formal dalam suatu class. Sebuah class terdiri dari slot dengan tipe atau class spesifik. Class dideklarasikan dengan fungsi setClass.
Contoh, mendefinisikan ulang class coords sebelumnya ke class system S4
setClass("coords", representation(x = "numeric",y = "numeric"))Contoh, membuat objek car
setClass("car", representation(Nama = "character",
Panjang = "numeric",
Lebar = "numeric",
Kecepatan = "numeric"))
car1 <- new("car", Nama = "Toyota", Panjang = 3.5, Lebar = 2, Kecepatan = 180)
car1An object of class "car"
Slot "Nama":
[1] "Toyota"
Slot "Panjang":
[1] 3.5
Slot "Lebar":
[1] 2
Slot "Kecepatan":
[1] 180Konstruktor Membuat objek coords
coords <- function(x, y){
if (length(x) != length(y))
stop("length x dan y harus bernilai sama")
if (!is.numeric(x) || !is.numeric(y))
stop("x dan y harus vector numeric")
setClass("coords", representation(x = "numeric",y = "numeric"))
new("coords", x = as.vector(x), y = as.vector(y))
}
pts <- coords(round(rnorm(5), 2),round(rnorm(5), 2))
ptsAn object of class "coords"
Slot "x":
[1] 0.30 1.24 -0.05 -0.50 1.97
Slot "y":
[1] -0.64 -1.61 0.19 -0.94 0.08Membuat object car menggunakan fungsi konstruktor
car <- function(Nama, Panjang, Lebar, Kecepatan){
if (Panjang < 2 || Lebar < 1.5 || Kecepatan < 80)
stop("atribut tidak sesuai")
setClass("car", representation(Nama = "character",
Panjang = "numeric",
Lebar = "numeric",
Kecepatan = "numeric"))
new("car", Nama = Nama, Panjang = Panjang, Lebar = Lebar, Kecepatan = Kecepatan)
}
car2 <- car("BMW", 3, 2, 300)
class(car2)[1] "car"
attr(,"package")
[1] ".GlobalEnv"class(car1)[1] "car"
attr(,"package")
[1] ".GlobalEnv"Aksesor Akses terhadap slot menggunakan fungsi slot atau operator @
slot(pts, "x")[1] 0.30 1.24 -0.05 -0.50 1.97slot(pts, "y")[1] -0.64 -1.61 0.19 -0.94 0.08Tetapi disarankan 2 fungsi seperti sebelumnya:
xcoords <- function(obj) obj@x
ycoords <- function(obj) obj@y
xcoords(pts)[1] 0.30 1.24 -0.05 -0.50 1.97ycoords(pts)[1] -0.64 -1.61 0.19 -0.94 0.08Akses terhadap slot pada objek car
car1@Nama[1] "Toyota"car2@Kecepatan[1] 300Akses terhadap slot pada objeck car dengan fungsi aksesor
nama <- function(objek) objek@Nama
kecepatan <-function(objek) objek@Kecepatan
nama(car1)[1] "Toyota"kecepatan(car2)[1] 300Fungsi generik show setara dengan fungsi generik print pada class System S3. Penciptaan fungsi generik menggunakan fungsi setMethod. Argumen didefinisikan dengan signature.
setMethod(show, signature(object = "coords"),
function(object)
print(paste("(",
format(xcoords(object)),
", ",
format(ycoords(object)),
")", sep = ""),
quote = FALSE))
pts[1] ( 0.30, -0.64) ( 1.24, -1.61) (-0.05, 0.19) (-0.50, -0.94) ( 1.97, 0.08)setMethod(show, "car",
function(object) {
print(cat("Nama : ", nama(object), "\n",
"Kecepatan : ", kecepatan(object),
sep = "")
)
})
car2Nama : BMW
Kecepatan : 300NULLFungsi Generik Baru Mendefinisikan fungsi baru sebagai fungsi generik menggunakan:
setGeneric("bbox",
function(obj)
standardGeneric("bbox"))[1] "bbox"setMethod("bbox", signature(obj = "coords"),
function(obj)
matrix(c(range(xcoords(obj)),
range(ycoords(obj))),
nc = 2,
dimnames = list(
c("min", "max"),
c("x:", "y:")
)))
bbox(pts) x: y:
min -0.50 -1.61
max 1.97 0.19setMethod("plot", signature(x="coords"),
function(x, bbox=FALSE, ...){
if (bbox) {
plot(xcoords(x), ycoords(x), ...);
x.1 <- c(bbox(x)[1],bbox(x)[2],bbox(x)[2],bbox(x)[1]);
y.1 <- c(bbox(x)[3],bbox(x)[3],bbox(x)[4],bbox(x)[4]);
polygon(x.1,y.1)
} else {
plot(xcoords(x),ycoords(x), ...)
}
})
plot(pts)
plot(pts, bbox = T, pch = 19, col =" red", xlab = "x", ylab = "y")
Pewarisan Class Terdapat class baru yang diturunkan dari coords dengan menambahkan slot nilai
setClass("vcoords",
representation(nilai = "numeric"),
contains = "coords")
vcoords <- function(x, y, nilai){
if ((length(x) != length(y)) ||
(length(x) != length(nilai)))
stop("length x, y, dan nilai harus bernilai sama")
if (!is.numeric(x) || !is.numeric(y)
|| !is.numeric(nilai))
stop("x, y, dan nilai harus vektor numeric")
new("vcoords", x = as.vector(x),
y = as.vector(y),
nilai = as.vector(nilai))
}
nilai <- function(obj) obj@nilai
vpts <- vcoords(xcoords(pts), ycoords(pts), round(100*runif(5)))
vptsAn object of class "vcoords"
Slot "nilai":
[1] 57 20 80 21 54
Slot "x":
[1] 0.30 1.24 -0.05 -0.50 1.97
Slot "y":
[1] -0.64 -1.61 0.19 -0.94 0.08Method show yang diwariskan perlu didefinisi ulang
setMethod(show, signature(object = "vcoords"),
function(object)
print(paste("(",
format(xcoords(object)),
", ",
format(ycoords(object)),
": ",
format(nilai(object)),
")", sep = ""),
quote=FALSE))
vpts[1] ( 0.30, -0.64: 57) ( 1.24, -1.61: 20) (-0.05, 0.19: 80) (-0.50, -0.94: 21)
[5] ( 1.97, 0.08: 54)Demikian juga method plot perlu didefinisikan ulang
setMethod("plot", signature(x = "vcoords"),
function(x, txt=FALSE, bbox=FALSE, ...){
if (bbox) {
if (!txt) {
plot(xcoords(x),ycoords(x), type="n", ...);
} else {
plot(xcoords(x),ycoords(x), type="n", ...);
text(xcoords(x),ycoords(x), nilai(x), ...);
}
x.1 <- c(bbox(x)[1],bbox(x)[2],bbox(x)[2],bbox(x)[1]);
y.1 <- c(bbox(x)[3],bbox(x)[3],bbox(x)[4],bbox(x)[4]);
polygon(x.1,y.1)
} else {
if (!txt) {
plot(xcoords(x),ycoords(x), ...);
} else {
plot(xcoords(x),ycoords(x), type="n", ...);
text(xcoords(x),ycoords(x), nilai(x), ...);
}
}
}
)
plot(vpts)
plot(vpts, txt=T, bbox=T, pch=19, col="red")
Pemeriksaan Suatu Class Objek Untuk mengecek apakah objek merupakan suatu class digunakan fungsi is.
is(pts, "coords")[1] TRUEis(pts, "vcoords")[1] FALSEis(vpts, "coords")[1] TRUEis(vpts, "vcoords")[1] TRUEUntuk men-coerce objek ke objek lain dari suatu class digunakan fungsi as().
as(vpts, "coords")[1] ( 0.30, -0.64) ( 1.24, -1.61) (-0.05, 0.19) (-0.50, -0.94) ( 1.97, 0.08)as(pts, "vcoords")[1] ( 0.30, -0.64: ) ( 1.24, -1.61: ) (-0.05, 0.19: ) (-0.50, -0.94: )
[5] ( 1.97, 0.08: )6.1.5 Praktikum
Fungsi untuk membuat sekumpulan mekaninsme dasar yang dijalankan secara simultan
angka_acak1 <- function(n,pw){ x=runif(n) y=runif(n) z=(x+y)^pw return(z) } angka_acak1(10,2)[1] 1.3217816 0.6544703 0.1434508 3.3300370 1.3901733 0.3479363 0.5071806 [8] 0.2479425 0.2579185 0.8595055angka_acak2 <- function(n,pw){ x=runif(n) y=runif(n) z=(x+y)^pw return(list(x=x,y=y,zs=z)) } angka_acak2(10,2)$x [1] 0.8165168 0.1000090 0.6577915 0.1573602 0.1195495 0.8578098 0.9795290 [8] 0.5488279 0.5943235 0.9117579 $y [1] 0.10640146 0.11014193 0.08182406 0.32289814 0.92905267 0.52630015 [7] 0.59972311 0.77944287 0.93446744 0.03117578 $zs [1] 0.85177815 0.04416343 0.54703111 0.23064809 1.09956660 1.91576027 [7] 2.49403721 1.76430329 2.33720175 0.88912400angka_acak3 <- function(n=10,pw=2){ x=runif(n) y=runif(n) z=(x+y)^pw return(z) } angka_acak3()[1] 0.06001303 1.90669079 0.17814082 0.83720800 1.17014568 0.17445789 [7] 1.33882506 0.62871885 1.78122634 2.46937038angka_acak4 <- function(){ x=runif(n) y=runif(n) z=(x+y)^pw return(z) } n=10;pw=2 angka_acak4()[1] 1.92591579 0.03326192 0.24507297 2.60782807 1.51547869 0.05609764 [7] 1.73246876 0.86652776 0.04187257 0.09589723Latihan 1
med <- function(vect){ n <-length(vect) vects <- sort(vect) if(n%%2==1){m<-vects[(n+1)/2]} else {m <- (vects[n/2]+vects[(n/2)+1])/2} return(m) } x1 <- c(1,5,3,7,3,4,2,7) med(x1)[1] 3.5Latihan 2
modus <- function(vect){ v <- unique(vect) f <- NULL for(i in v) { byk <- sum(vect==i) f <- c(f,byk) } fmax <- max(f) vf <- cbind(v,f) mode <- vf[f==fmax,] return(mode) } x1 <- c(1,5,3,7,3,4,2,7) modus(x1)v f [1,] 3 2 [2,] 7 2Latihan 3
p.est<-function(A){ if(!is.matrix(A)) stop("input must be on matrix") x1<-A[,-1] y <-A[,1] one<-rep(1,nrow(A)) x <-cbind(one,x1) colnames(x)<-paste("x",1:ncol(x),sep="") b.est<-as.vector(solve(t(x) %*% x) %*% (t(x) %*% y)) names(b.est)<-paste("b",0:(length(b.est)-1),sep="") fitted.value<-as.vector(x%*%b.est) error<-as.vector(y-fitted.value) names(fitted.value)<-names(error)<-1:nrow(A) list(beta.est=b.est,fit.val=fitted.value,error=error) } Pendapatan<-c(3.5,3.2,3.0,2.9,4.0,2.5,2.3) Biaya.Iklan<-c(3.1,3.4,3.0,3.2,3.9,2.8,2.2) Jumlah.Warung<-c(30,25,20,30,40,25,30) X<-cbind(Pendapatan,Biaya.Iklan,Jumlah.Warung) p.est(X)$beta.est b0 b1 b2 -0.21381852 0.89843390 0.01745279 $fit.val 1 2 3 4 5 6 7 3.094910 3.277176 2.830539 3.184754 3.988185 2.738116 2.286320 $error 1 2 3 4 5 6 0.40508982 -0.07717642 0.16946108 -0.28475357 0.01181483 -0.23811608 7 0.01368033model<-lm(Pendapatan~Biaya.Iklan+Jumlah.Warung) model$coefficients(Intercept) Biaya.Iklan Jumlah.Warung -0.21381852 0.89843390 0.01745279model$fitted.values1 2 3 4 5 6 7 3.094910 3.277176 2.830539 3.184754 3.988185 2.738116 2.286320model$residuals1 2 3 4 5 6 0.40508982 -0.07717642 0.16946108 -0.28475357 0.01181483 -0.23811608 7 0.01368033Latihan 4
three.m <- function(vect){ v <- unique(vect) f <- NULL for(i in v) { byk <- sum(vect==i) f <- c(f,byk) } fmax <- max(f) vf <- cbind(v,f) mode <- vf[f==fmax,] return(mode) } x1 <- rbinom(100,10,0.5) three.m(x1)v f 5 29Object-S3
A1 <- c(1:10) class(A1)[1] "integer"A2 <- matrix(A1,2,5) class(A2)[1] "matrix" "array"A3 <- 1:12 A4 <- letters[1:12] B1 <- data.frame(A3,A4) class(B1)[1] "data.frame"B1$A4[1] "a" "b" "c" "d" "e" "f" "g" "h" "i" "j" "k" "l"A5 <- 10+A3+rnorm(12) B2 <- lm(A5~A3) #membuat model linear class(B2)[1] "lm"methods(class=class(B2))[1] add1 alias anova [4] Anova avPlot Boot [7] bootCase boxCox brief [10] case.names ceresPlot coerce [13] confidenceEllipse confint Confint [16] cooks.distance crPlot deltaMethod [19] deviance dfbeta dfbetaPlots [22] dfbetas dfbetasPlots drop1 [25] dummy.coef durbinWatsonTest effects [28] extractAIC family formula [31] fortify hatvalues hccm [34] infIndexPlot influence influencePlot [37] initialize inverseResponsePlot kappa [40] labels leveneTest leveragePlot [43] linearHypothesis logLik mcPlot [46] mmp model.frame model.matrix [49] ncvTest nextBoot nobs [52] outlierTest plot powerTransform [55] predict Predict print [58] proj qqPlot qr [61] residualPlot residualPlots residuals [64] rstandard rstudent S [67] show sigmaHat simulate [70] slotsFromS3 spreadLevelPlot summary [73] symbox variable.names vcov see '?methods' for accessing help and source codesummary(B2)Call: lm(formula = A5 ~ A3) Residuals: Min 1Q Median 3Q Max -1.10310 -0.44265 -0.04456 0.62248 1.07293 Coefficients: Estimate Std. Error t value Pr(>|t|) (Intercept) 10.09301 0.46506 21.70 9.64e-10 *** A3 0.97474 0.06319 15.43 2.67e-08 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Residual standard error: 0.7556 on 10 degrees of freedom Multiple R-squared: 0.9597, Adjusted R-squared: 0.9556 F-statistic: 238 on 1 and 10 DF, p-value: 2.671e-08names(B2)[1] "coefficients" "residuals" "effects" "rank" [5] "fitted.values" "assign" "qr" "df.residual" [9] "xlevels" "call" "terms" "model"B2$coefficients(Intercept) A3 10.0930145 0.9747377Mengubah menjadi class : class(obj) <- “class.name”
Mobil1 <- list(Nama="Toyota", Panjang=3.5,Lebar=2, Kecepatan=180) class(Mobil1)[1] "list"class(Mobil1) <- "mobil" Mobil2 <- list(Nama="Suzuki", Panjang=1,Lebar=1.8, Kecepatan=150) class(Mobil2) <- "mobil"Mengubah menjadi class menggunakan fungsi konstruktor. Fungsi konstruktor menambahkan screening sebelum menambahkan class
Mobil <- function(Nama,Panjang,Lebar,Kecepatan){ if(Panjang<2 || Lebar<1.5 || Kecepatan<80) stop("atribut tidak sesuai") Mobil <- list(Nama=Nama, Panjang=Panjang,Lebar=Lebar, Kecepatan=Kecepatan) class(Mobil) <- "mobil" Mobil } Mobil3 <- Mobil("Daihatsu", 2.1, 1.9, 120) Mobil4 <- Mobil("Proton", 2, 1.8, 80) Mobil3$Nama [1] "Daihatsu" $Panjang [1] 2.1 $Lebar [1] 1.9 $Kecepatan [1] 120 attr(,"class") [1] "mobil"Mobil4$Nama [1] "Proton" $Panjang [1] 2 $Lebar [1] 1.8 $Kecepatan [1] 80 attr(,"class") [1] "mobil"Fungsi Aksesor
#Cara langsung (tidak direkomendasikan) Mobil2$Nama[1] "Suzuki"Mobil3$Panjang[1] 2.1#Dengan fungsi aksesor nama <- function(objek) objek$Nama kecepatan <- function(objek) objek$Kecepatan nama(Mobil1)[1] "Toyota"kecepatan(Mobil3)[1] 120Fungsi Generik : function(…){…}
print.mobil <- function(objek) { print(cat("Nama : ", nama(objek), "\n", "Kecepatan : ", kecepatan(objek), sep="") ) } Mobil1Nama : Toyota Kecepatan : 180NULLmemciptakan fungsi generik. method hanya dapat didefinisikan untuk fungsi yang generik. Membuat nama method baru dengan menciptakan fungsi generik
fungsibaru <- function (objek) UseMethod("fungsibaru")Object-S4 : mengatasi masalah dalam sistem objek S3 dengan sistem objek lebih formal.
setClass("car", representation(Nama="character",Panjang="numeric", Lebar="numeric",Kecepatan="numeric")) Car1 <- new("car", Nama="Toyota",Panjang=3.5, Lebar=2,Kecepatan=180) Car1An object of class "car" Slot "Nama": [1] "Toyota" Slot "Panjang": [1] 3.5 Slot "Lebar": [1] 2 Slot "Kecepatan": [1] 180Membuat Object S4 dengan menggunakan fungsi konstruktor
Car <- function(Nama,Panjang,Lebar,Kecepatan){ if(Panjang<2 || Lebar<1.5 || Kecepatan<80) stop("atribut tidak sesuai") new("car", Nama=Nama, Panjang=Panjang,Lebar=Lebar, Kecepatan=Kecepatan) } Car2 <- Car("Suzuki", 2.4, 1.8, 150) class(Car2)[1] "car" attr(,"package") [1] ".GlobalEnv"class(Mobil1)[1] "mobil"Fungsi Aksesor
#Cara langsung (tidak direkomendasikan) Car1@Nama[1] "Toyota"Car2@Kecepatan[1] 150#Dengan fungsi aksesor nama1 <- function(objek) objek@Nama kecepatan1 <- function(objek) objek@Kecepatan nama1(Car1)[1] "Toyota"kecepatan1(Car2)[1] 150Class Method
setMethod(show, "car", function(object) { print(cat("Nama : ", nama1(object), "\n", "Kecepatan : ", kecepatan1(object), sep="") )} ) Car2Nama : Suzuki Kecepatan : 150NULLMenciptakan fungsi genetik S4
setGeneric("fungsibaru", function(objek) standardGeneric("fungsibaru"))[1] "fungsibaru"
BAB 7
7.1 Optimasi
7.1.1 Representasi Bilangan
Perbedaan perhitungan di matematika dan komputer, seperti nilai 0.2=0.0011 di komputer, maka untuk membuat hal itu sama bisa menggunakan fungsi all.equal(0.2, 0.3-0.1).
#before
paste('before = ',(0.3-0.1) == 0.2)[1] "before = FALSE"#after
paste('after = ',isTRUE(all.equal(0.2,0.3-0.1)))[1] "after = TRUE"7.1.2 Differensial
Dapat melakukan diferentiasi dari suatu fungsi, bisa berupa hasil turunannya, maupun angka dari penurunan tersebut.
#fungsi
xfs <- expression(exp(x^2))
xturunan <- deriv(~x^2 ,"x")
#turunan dari suatu fungsi
D(xfs,'x')exp(x^2) * (2 * x)#value dari turunan fungsi
x <- 2
eval(xturunan)[1] 4
attr(,"gradient")
x
[1,] 47.1.2 Integral
Dapat melakukan integral dari suatu fungsi, untuk mendapatkan batas dari fungsi integralan tersebut.
#fungsi
fs <- function(x){x^2}
#mendapatkan integral dari suatu fungsi
library(Ryacas)
yac_str("Integrate(x) x^2")[1] "x^3/3"#value dari integral fungsi
lower = 0
upper = 1
integrate(fs,lower,upper)0.3333333 with absolute error < 3.7e-157.1.3 Operasi Numerik
Beberapa metode untuk mendapatkan nilai optimum dari suatu fungsi, baik mengoptimukan nilai maksimum maupun minimum.
Golden Section Search
Pada umumnya, algoritma Golden Section digunakan untuk menyelesaikan NLP (Non-Linier Programming). mecari nilai optimum maksimum or minimum dari fungsi peubah tunggal dari suatu selang. misal : ingin dicari nilai minimum dari f(x) = |x-3.5| + (x-2)^2.
nilai a<b. set tol sebagai batas maksimum selisih antara a dan b.
x <- seq(1,5, by=0.01) f <- abs(x-3.5)+(x-2)^2 plot(x,f, type = "l", main = "Grafik fungsi f(x) = |x-3.5| + (x-2)^2", xlab = "Nilai x", ylab = "Nilai f(x)", xlim = c(0,6), ylim = c(0,12))
golden <- function(f,a,b,tol,optval){ ratio <- 2/(sqrt(5)+1) x1 <- b - ratio * (b-a) x2 <- a + ratio * (b-a) f1 <- f(x1) f2 <- f(x2) if(optval=='maksimum'){ while(abs(b-a) > tol) { if (f1 > f2){ b <- x2 x2 <- x1 f2 <- f1 x1 <- b - ratio * (b-a) f1 <- f(x1) } else{ a <- x1 x1 <- x2 f1 <- f2 x2 <- a + ratio * (b-a) f2 <- f(x2) } } } else{ while(abs(b-a) > tol){ if (f2 > f1){ b <- x2 x2 <- x1 f2 <- f1 x1 <- b - ratio * (b-a) f1 <- f(x1) } else{ a <- x1 x1 <- x2 f1 <- f2 x2 <- a + ratio * (b-a) f2 <- f(x2) } } } return((a+b)/2) } tol = 0.0000001 a = 1 b = 10 optval = 'maksimum' #f <- function(x){abs(x-3.5)+(x-2)^2} f <- function(x){18*x - 2*x^2 + 10} golden(f,a,b,tol,optval)[1] 4.5Newton-Raphson
Suatu fungsi memiliki turunan pertama dan kedua, maka nilai minimum dapat menggunakan metode newton raphosn. Metode ini lebih cepat ketimbang golden section search. Tahapan interasi pada metode newton-raphson akan tersu berjalan sampai f′(xn−1) mendekati 0 atau lebih kecil dari nilai toleransi.
#fungsi newtonr <- function(fx, x0=1){ fx1 <- deriv(fx, "x") #turunan pertama fx2 <- deriv(D(fx,"x"), "x") #turunan kedua e <- 1000 while (e > 1e-6) { x <- x0 f1 <- attr(eval(fx1), "gradient")[1] f2 <- attr(eval(fx2), "gradient")[1] e <- abs(f1) #bisa juga e <- abs(x1-x0) x1 <- x0-f1/f2 x0 <- x1 } return(x1) } fs <- expression(4*(x^2) - 3*x - 7) f <- function(x){4*(x^2) - 3*x - 7} newtonr(fs)[1] 0.375curve(f, ylab='fx') abline(v=0.375, lty=3, lwd=4, col="gray60")
Fungsi Optimasi Built-in
Algoritma Nelder-Mead adalah salah satu metode optimasi untuk fungsi yang memiliki lebih dari satu peubah. Pada R algoritma Nelder-Mead diterapkan pada fungsi:
Fungsi
optimize( )digunakan untuk mendapatkan nilai minimum/maksimum dari suatu fungsi dengan satu peubah. Fungsioptim( )digunakan untuk mendapatkan nilai minimum/maksimum dari suatu fungsi dengan peubah lebih dari satu.#nilai minimum fs <- function(x){(x-(1/3))^2} curve(fs, from=0,to=1) abline(v=0.3333333, lty=3, lwd=1, col="red")
optimize(fs, interval = c(0,1), tol = 0.0001, maximum = FALSE)$minimum [1] 0.3333333 $objective [1] 0#nilai maksimum fs <- function(x){(x-(1/3))^2} curve(fs, from=0,to=1) abline(v=0.9999339, lty=3, lwd=1, col="red")
optimize(fs, interval = c(0,1), tol = 0.0001, maximum = TRUE)$maximum [1] 0.9999339 $objective [1] 0.4443563f <- function(para,y,x){ X <- cbind(1,x) yhat <- X %*% as.matrix(para) sisa2 <- sum((y-yhat)^2) return(sisa2) } x1 <- runif(10,1,10) x2 <- runif(10,1,10) galat <- rnorm(10,0,0.5) y <- 1 + 2*x1 + 3*x2 + galat hasil <- optim(par = c(1,1,1),f,y=y,x=cbind(x1,x2)) hasil$par[1] 0.9455883 2.0221542 3.0101779#bandingkan hasilnya dengan fungsi lm() untuk membuat model regresi lm(y~x1+x2)Call: lm(formula = y ~ x1 + x2) Coefficients: (Intercept) x1 x2 0.949 2.022 3.010MLE : Maximum Likelihood Estimator
Maximum Likelihood Estimator (MLE) merupakan metode yang paling sering digunakan untuk menduga parameter sebaran
library(bbmle) lnorm <- function (para ,xd){ nilai <- -1*sum(dnorm(xd, mean = para[1], sd = para[2], log = TRUE)) return (nilai) } set.seed(2) x <- rnorm(10,2,5) hasil <- optim(c(1,1), lnorm, xd = x) hasil$par [1] 3.056350 4.671425 $value [1] 29.6057 $counts function gradient 63 NA $convergence [1] 0 $message NULLlibrary(bbmle) lnorm <- function (mean, sd){ nilai <- -1*sum(dnorm(x, mean = mean, sd = sd, log = TRUE)) return (nilai) } suppressWarnings( estnorm <- mle2(minuslogl = lnorm, start=list(mean = 1, sd = 3)) ) summary(estnorm)Maximum likelihood estimation Call: mle2(minuslogl = lnorm, start = list(mean = 1, sd = 3)) Coefficients: Estimate Std. Error z value Pr(z) mean 3.0557 1.4775 2.0682 0.03862 * sd 4.6722 1.0448 4.4721 7.746e-06 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 -2 log L: 59.2114
7.1.5 Latihan
Latihan 1
#fungsi fs <- function(x){x^2+4} #mendapatkan integral dari suatu fungsi library(Ryacas) yac_str("Integrate(x) x^2+4")[1] "x^3/3+4*x"#value dari integral fungsi lower = -10 upper = 10 integrate(fs,lower,upper)746.6667 with absolute error < 8.3e-12Latihan 2
#fungsi fs <- function(t){t^4*exp(-t)} #mendapatkan integral dari suatu fungsi library(Ryacas) yac_str("Integrate(t) t^4*exp(-t)")[1] "AntiDeriv(t,t^4*exp(-t))"#value dari integral fungsi lower = 0 upper = Inf integrate(fs,lower,upper)24 with absolute error < 2.2e-05Latihan 3
Mencari titik maksimum dan minimum dari fungsi: f(x) = sin(x) + sin(2x) + cos(3x)
#fungsi fs <- function(x){sin(x)+sin(2*x)+cos(3*x)} curve(fs, from = 0, to = 2*pi)
#minimum lokal optimize(fs, interval = c(0, 2*pi))$minimum [1] 3.033129 $objective [1] -1.054505#minimum global optimize(fs, interval = c(4, 2*pi))$minimum [1] 5.273383 $objective [1] -2.741405#maksimum lokal optimize(fs, interval = c(0, 2*pi), maximum = T)$maximum [1] 4.0598 $objective [1] 1.096473#maksimum global optimize(fs, interval = c(0,1.5), maximum = T)$maximum [1] 0.3323289 $objective [1] 1.485871golden <- function(f,a,b,tol,optval){ ratio <- 2/(sqrt(5)+1) x1 <- b - ratio * (b-a) x2 <- a + ratio * (b-a) f1 <- f(x1) f2 <- f(x2) if(optval=='maksimum'){ while(abs(b-a) > tol) { if (f1 > f2){ b <- x2 x2 <- x1 f2 <- f1 x1 <- b - ratio * (b-a) f1 <- f(x1) } else{ a <- x1 x1 <- x2 f1 <- f2 x2 <- a + ratio * (b-a) f2 <- f(x2) } } } else{ while(abs(b-a) > tol){ if (f2 > f1){ b <- x2 x2 <- x1 f2 <- f1 x1 <- b - ratio * (b-a) f1 <- f(x1) } else{ a <- x1 x1 <- x2 f1 <- f2 x2 <- a + ratio * (b-a) f2 <- f(x2) } } } return((a+b)/2) } tol = 0.0000001 fs <- function(x){sin(x)+sin(2*x)+cos(3*x)} #minimum lokal golden(fs,0,2*pi,tol,'minimum')[1] 3.033133#minimum global golden(fs,4,2*pi,tol,'minimum')[1] 5.273376#maksimum lokal golden(fs,0,2*pi,tol,'maksimum')[1] 4.059791#maksimum global golden(fs,0,1.5,tol,'maksimum')[1] 0.332332Latihan 4
Mencari titik minimum dari fungsi: f(x) = 4*(x4) - 2*(x^3) - 3*(x)
#fungsi fs <- function(x){4*(x^4)-2*(x^3)-3*x} curve(fs, from = -1, to = 20)
#minimum optim(par=c(-0.5),fn=fs)$par [1] 0.728418 $value [1] -1.832126 $counts function gradient 36 NA $convergence [1] 0 $message NULLLatihan 5
Mencari minimum dari residual sum of square persamaan regresi
#data data5 = data.frame(x=c(1,2,3,4,5,6), y=c(1,3,5,6,8,12)) jkg <- function(data,b){with(data,sum((b[1]+b[2]*x-y)))} hasil1 <- optim(par = c(1,1), fn=jkg, data=data5) hasil2 <- lm(y~x, data = data5) plot(data5) abline(hasil1$par,col=4)
hasil1$par[1] 4.996335e+54 -3.183805e+55hasil2$coefficients(Intercept) x -1.266667 2.028571hasil1$value[1] -6.386211e+56sum(hasil2$residuals^2)[1] 2.819048