Fungsi

Membuat sekumpulan mekanisme dasar yang dijalankan secara simultan

function( arglist )
{ expr
return(value)
} 

## function( arglist )
## { expr
## return(value)
## }

angka_acak1=function(n,pw)
{ x=runif(n)
y=runif(n)
z=(x+y)^pw
return(z)
}
angka_acak1(10,2)

##  [1] 1.1351564 1.5102992 0.2956951 0.7404378 1.2740963 2.0752971 0.7932976
##  [8] 3.5720576 1.0875139 0.3023186

angka_acak2=function(n,pw)
{ x=runif(n)
y=runif(n)
z=(x+y)^pw
return(list(x=x,y=y,z=z))
}
angka_acak2(10,2)

## $x
##  [1] 0.6119663 0.1829483 0.3221455 0.3271070 0.4243701 0.8579906 0.8342406
##  [8] 0.8831730 0.6117671 0.9221341
## 
## $y
##  [1] 0.48123041 0.93282109 0.06047649 0.09373245 0.91987472 0.94067988
##  [7] 0.78824529 0.25653554 0.38891745 0.28512661
## 
## $z
##  [1] 1.1950790 1.2449414 0.1463996 0.1771058 1.8069942 3.2352156 2.6324604
##  [8] 1.2989357 1.0013696 1.4574785

angka_acak3=function(n=10,pw=2)
{ x=runif(n)
y=runif(n)
z=(x+y)^pw
return(z)
}
angka_acak3()

##  [1] 0.60490554 1.81662205 0.01818308 0.71585216 0.98846658 0.02579453
##  [7] 1.55806573 0.90342162 0.44493924 1.06596594

angka_acak4=function()
{ x=runif(n)
y=runif(n)
z=(x+y)^pw
return(z)
}
n <- 5; pw <- 3
angka_acak4()

## [1] 3.6432223 2.6675496 4.0233758 0.7980623 2.5821831

Latihan 1

Buatlah fungsi untuk mencari median dari suatu vektor

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.5

Latihan 2

Buatlah fungsi untuk mencari modus dari suatu vektor

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)
}
modus(x1)

##      v f
## [1,] 3 2
## [2,] 7 2

Latihan 3

Buatlah fungsi untuk menduga parameter pada regresi berganda!

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.01368033

model<-lm(Pendapatan~Biaya.Iklan+Jumlah.Warung)
model$coefficients

##   (Intercept)   Biaya.Iklan Jumlah.Warung 
##   -0.21381852    0.89843390    0.01745279

model$fitted.values

##        1        2        3        4        5        6        7 
## 3.094910 3.277176 2.830539 3.184754 3.988185 2.738116 2.286320

model$residuals

##           1           2           3           4           5           6 
##  0.40508982 -0.07717642  0.16946108 -0.28475357  0.01181483 -0.23811608 
##           7 
##  0.01368033

Latihan 4

• Buat fungsi bernama three.M yang digunakan untuk menghitung mean, median, dan modus dari suatu vektor modus (tanpa menggunakan fungsi mean, quantile, ataupun fungsi “instan” lain yang sudah tersedia sebelumnya di R)! • Hitung mean, median, modus dari X dibawah ini dengan menggunakan fungsi three.M tersebut

three.M <- function(vect) {
n <- length(vect)

# menghitung rataan 
jumlah <- sum(vect)
rataan <- jumlah/n

# menghitung median
vects <- sort(vect) # urutkan
if(n%%2 == 1) {m <- vects[(n+1)/2]}
else {m <- (vects[n/2]+vects[(n/2)+1])/2} 

# menghitung modus
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,]

# output
my_list <- list("mean" = rataan, "median" = m, "modus" = mode)
return(my_list)
}

# hitung mean median modus distribusi binomial
set.seed(123)
datax <- rbinom(100,10,0.5)
three.M(datax)

## $mean
## [1] 4.99
## 
## $median
## [1] 5
## 
## $modus
##      v  f
## [1,] 6 24
## [2,] 5 24

Konsep OOP dalam R

Object- 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          case.names     coerce        
##  [6] confint        cooks.distance deviance       dfbeta         dfbetas       
## [11] drop1          dummy.coef     effects        extractAIC     family        
## [16] formula        hatvalues      influence      initialize     kappa         
## [21] labels         logLik         model.frame    model.matrix   nobs          
## [26] plot           predict        print          proj           qr            
## [31] residuals      rstandard      rstudent       show           simulate      
## [36] slotsFromS3    summary        variable.names vcov          
## see '?methods' for accessing help and source code

summary(B2
)

## 
## Call:
## lm(formula = A5 ~ A3)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -1.70634 -0.37935 -0.03672  0.38335  1.32502 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept) 10.39462    0.51345   20.25 1.91e-09 ***
## A3           0.96614    0.06976   13.85 7.51e-08 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.8343 on 10 degrees of freedom
## Multiple R-squared:  0.9504, Adjusted R-squared:  0.9455 
## F-statistic: 191.8 on 1 and 10 DF,  p-value: 7.514e-08

names(B2)

##  [1] "coefficients"  "residuals"     "effects"       "rank"         
##  [5] "fitted.values" "assign"        "qr"            "df.residual"  
##  [9] "xlevels"       "call"          "terms"         "model"

B2$coefficients

## (Intercept)          A3 
##  10.3946172   0.9661381

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"

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, 90)

#cara langsung
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] 120

print.mobil <- function(objek) {
print(cat("Nama : ", nama(objek), "\n",
"Kecepatan : ", kecepatan(objek),
sep="")
)
}
Mobil1

## Nama : Toyota
## Kecepatan : 180NULL

Object -S4

setClass("car",
representation(Nama="character",
Panjang="numeric",
Lebar="numeric",
Kecepatan="numeric"))
Car1 <- new("car", Nama="Toyota",
Panjang=3.5, Lebar=2,
Kecepatan=180)

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"

#Cara langsung
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] 150

setMethod(show, "car", function(object) {
print(cat("Nama : ", nama1(object), "\n",
"Kecepatan : ", kecepatan1(object),
sep="")
)}
)
Car2

## Nama : Suzuki
## Kecepatan : 150NULL

setGeneric("fungsibaru",
function(objek)
standardGeneric("fungsibaru"))

## [1] "fungsibaru"

Latihan 1

library(Ryacas)

## Error in get(genname, envir = envir) : object 'testthat_print' not found

## 
## Attaching package: 'Ryacas'

## The following object is masked from 'package:stats':
## 
##     integrate

## The following objects are masked from 'package:base':
## 
##     %*%, diag, diag<-, lower.tri, upper.tri

yac_str("Integrate(x) x^2 + 4*x")

## [1] "x^3/3+2*x^2"

f1 <- function(x) x^2 + 4*x
integrate(f1,lower = -10,upper = 10)

## 666.6667 with absolute error < 7.6e-12

Latihan 2

yac_str("Integrate(t) t^4 * Exp(-t)")

## [1] "4*(3*((-2)*(t+1)*Exp(-t)-t^2*Exp(-t))-t^3*Exp(-t))-t^4*Exp(-t)"

f2 <- function(t) t^(4) * exp(-t)
integrate(f2,lower = 0,upper = Inf)

## 24 with absolute error < 2.2e-05

gamma(5)

## [1] 24

Latihan 3 (Optimasi satu dimensi)

f3 <- function(x) sin(x) + sin(2*x) + cos(3*x)
curve(f3, from = 0, to = 2*pi)

optimize(f3, interval = c(0, 2*pi)) #minimum lokal

## $minimum
## [1] 3.033129
## 
## $objective
## [1] -1.054505

optimize(f3, interval = c(4, 2*pi)) #minimum global

## $minimum
## [1] 5.273383
## 
## $objective
## [1] -2.741405

optimize(f3, interval = c(0, 2*pi), maximum = T) #maksimum lokal

## $maximum
## [1] 4.0598
## 
## $objective
## [1] 1.096473

optimize(f3, interval = c(0, 1.5), maximum = T) #maksimum global

## $maximum
## [1] 0.3323289
## 
## $objective
## [1] 1.485871

Latihan 4 (Optimasi fungsi polinomial)

f4 <- function(x) 4*x^4-2*x^3-3*x
curve(f4, from = -1, to = 1.5)

optim(par = c(-0.5), fn = f4)

## Warning in optim(par = c(-0.5), fn = f4): one-dimensional optimization by Nelder-Mead is unreliable:
## use "Brent" or optimize() directly

## $par
## [1] 0.728418
## 
## $value
## [1] -1.832126
## 
## $counts
## function gradient 
##       36       NA 
## 
## $convergence
## [1] 0
## 
## $message
## NULL

Latihan 5 (Regresi linier)

Lakukan pendugaan parameter regresi dengan meminimumkan jumlah kuadrat galat (residual sum of square) dari data berikut! Kemudian bandingkan hasilnya dengan output dari fungsi lm!

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)^2))
}
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] -1.266302  2.028449

hasil2$coefficients

## (Intercept)           x 
##   -1.266667    2.028571

hasil1$value

## [1] 2.819048

sum(hasil2$residuals^2)

## [1] 2.819048