#Pemrograman Fungsi dan OOP

FUngsi
Objek S3
Objek S4

Membuat sekumpulan mekanisme dasar yang dijalankan secara simultan

function( arglist ) #arglist merupakan suatu argumen 
{ expr
return(value)         #Fungsi-fungsi ini memberikan mekanisme dasar untuk mendefinisikan fungsi baru dalam bahasa R.
}

## function( arglist ) #arglist merupakan suatu argumen 
## { expr
## return(value)         #Fungsi-fungsi ini memberikan mekanisme dasar untuk mendefinisikan fungsi baru dalam bahasa R.
## }

Berikut merupakan suatu fungsi yang diberi nama "angka_acak1"

angka_acak1=function(n,pw) #n dan pw merupakan argumen list  (Bahan ajar praktikum)
{ x=runif(n)  #x dan y serta Z adalah expresi
y=runif(n)  #x dan y merupakan bangkitan bilangan acak masing-masing n
z=(x+y)^pw
return(z) #z pada return adalah value
}
angka_acak1(10,2) #n=10 dan pw=2

##  [1] 0.85615858 0.47288466 1.64290768 1.41651229 0.08537276 0.07263810
##  [7] 1.44859562 1.46925264 0.43606676 0.30441487

angka_acak2=function(n,pw)  #n dan pw merupakan argumen list
{ x=runif(n)        #variabel X dan Y merupakan peubah acak yang memiliki sebaran seragam
y=runif(n)
z=(x+y)^pw        # Z merupakan hasil jumlahan dari X dan Y kemudian dipangkatkan pw
return(list(x,y,z)) 
}
angka_acak2(10,2) #10 merupakan nilai dari n dan 2 merupakan nilai dari pw

## [[1]]
##  [1] 0.008202396 0.352199879 0.124670677 0.889928131 0.425603093 0.709019175
##  [7] 0.720902323 0.294624299 0.036897030 0.550961811
## 
## [[2]]
##  [1] 0.6233923 0.2525408 0.1546510 0.7622339 0.1774598 0.6903368 0.9300024
##  [8] 0.1075407 0.1357753 0.5335901
## 
## [[3]]
##  [1] 0.39891191 0.36571128 0.07802062 2.72963940 0.36368482 1.95819723
##  [7] 2.72548627 0.16173669 0.02981573 1.17625278

fungsi "angka_acak2" dapat ditulis seperti berikut

angka_acak3=function(n=10,pw=2) #dengan mendefinisikan nilai n dan pw terlebih dahulu pada function(argumen)
{ x=runif(n)
y=runif(n)
z=(x+y)^pw
return(z)
}
angka_acak3()

##  [1] 0.87002239 1.76175826 0.03905758 0.95576373 2.01385749 1.97904973
##  [7] 1.06485823 1.54161188 0.35831673 0.01949598

dapat pula dituliskan seperti berikut

angka_acak4=function()
{ x=runif(n)
y=runif(n)
z=(x+y)^pw
return(z)
}
n <- 5; pw <- 3 # nilai n dan pw didefinisikan setelah pembuatan fungsi 
angka_acak4()

## [1] 0.008245065 3.401156398 0.093378931 1.978211272 0.203997613

Latihan 1

berikut merupakan fungsi menghitung median dari suatu vektor

med <- function(vect) {      #argumen yang digunakan berupa vektor
n <- length(vect)        #kemudian dihitung panjang vektor
vects <- sort(vect)    #lalu elemen2 dalam vektor tersebut diurutkan
if(n%%2 == 1) {m <- vects[(n+1)/2]}  # dengan menggunakan if dan else diperoleh 2 kondisi jika m genap 
                                       #maka menghitung median menggunakan vects[(n+1)/2, jika m ganjil maka  vects[n/2]+vects[(n/2)+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

Menghitung 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

Menduga parameter pada regresi berganda.Berikut dibuat fungsi dengan nama objek "p.est"

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)) #rumus penduga beta
names(b.est)<-paste("b",0:(length(b.est)-1),sep="")
fitted.value<-as.vector(x%*%b.est)
error<-as.vector(y-fitted.value)           #rumus untuk menghitung eror
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

Berdasarkan output di atas diperoleh persamaan regresi pendapatan= -0.21381852 + 0.89843390Biaya.Iklan + 0.01745279Jumlah.Warung Sehingga ketika biaya.iklan meningkat sebesar 1 satuan maka pendapatan akan meningkat sebesar 0.89843390. Ketika jumlah warung meningkat sebesar 1 satuan maka pendapatan meningkat sebesar 0.01745279.

Latihan 4

Buat function dengan nama objek three.M

three.M<-function(mean1, median1, modus1){
  n<-length(X)
  mean1<-sum(X)/n
  
    urutan<-sort(X)
    if(n%%2==1){median1<-urutan[(n+1)/2]}
    else{median1<-(urutan[n/2]+urutan[(n/2)+1])/2}
   
  v<-unique(X)
    f<-NULL
    for (i in v)
    byk<-sum(X==i)
    f<-c(f,byk)
    
    fmax<-max(f)
    vf<-cbind(v,f)
    modus1<-vf[f==fmax,]
   return(list(mean1=mean1, median1=median1, modus1=modus1))
}

set.seed(123)
X<-rbinom(100, 10, 0.5)
three.M(X)

## $mean1
## [1] 4.99
## 
## $median1
## [1] 5
## 
## $modus1
##       v f
##  [1,] 4 1
##  [2,] 6 1
##  [3,] 5 1
##  [4,] 7 1
##  [5,] 2 1
##  [6,] 8 1
##  [7,] 3 1
##  [8,] 9 1
##  [9,] 0 1

Pemrograman Berorientasi Objek

Object S3 Suatu Class dalam System S3 tidak didefinisikan dengan ketat (Bahan ajar perkuliahan)

A1 <- c(1:10)
class(A1)                                   #class dari A1 merupakan integer

## [1] "integer"

A2 <- matrix(A1,2,5)                       #class dari A2 merupakan matrix
class(A2)

## [1] "matrix" "array"

A3 <- 1:12                                #class dari A3 merupakan integer
class(A3)

## [1] "integer"

A4 <- letters[1:12]
class(A4)                                 #class dari A4 merupakan character

## [1] "character"

B1 <- data.frame(A3,A4)
class(B1)                               #class dari B1 merupakan data frame

## [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 dengan peubah respon A5 dan peubah prediktor A3
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

Mengubah menjadi class

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"
class(Mobil2)                     #nama class berubah dari list menjadi mobil

## [1] "mobil"

mengubah menjadi class menggunakan fungsi konstruktor

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)  #Mobil3 sesuai dengan atribut
Mobil3

## $Nama
## [1] "Daihatsu"
## 
## $Panjang
## [1] 2.1
## 
## $Lebar
## [1] 1.9
## 
## $Kecepatan
## [1] 120
## 
## attr(,"class")
## [1] "mobil"

Mobil4 <- Mobil("Proton", 2, 1.8, 90) #Mobil 4 sesuai dengan atribut
Mobil4

## $Nama
## [1] "Proton"
## 
## $Panjang
## [1] 2
## 
## $Lebar
## [1] 1.8
## 
## $Kecepatan
## [1] 90
## 
## attr(,"class")
## [1] "mobil"

Fungsi aksesor

nama <- function(objek) objek$Nama
kecepatan <- function(objek) objek$Kecepatan
nama(Mobil1)

## [1] "Toyota"

kecepatan(Mobil3)

## [1] 120

Fungsi generik print method

function(...){...}

## function(...){...}

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

## Nama : Toyota
## Kecepatan : 180NULL

Menciptakan fungsi generik

x <- structure(1, class = letters)
bar <- function(x) UseMethod("bar", x)
bar.z <- function(x) "z"
bar(x)

## [1] "z"

Membuat objek 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)
Car1

## An object of class "car"
## Slot "Nama":
## [1] "Toyota"
## 
## Slot "Panjang":
## [1] 3.5
## 
## Slot "Lebar":
## [1] 2
## 
## Slot "Kecepatan":
## [1] 180

Membuat objek S4 daftar buah dan harga

setClass("buah",
         representation(Nama="character",
                        Satuan="character",
                        unit="numeric",
                        harga="numeric"))
buah1<- new("buah", Nama="Alpukat",
            Satuan="kilogram",
            unit=5, harga=50000)
buah1

## An object of class "buah"
## Slot "Nama":
## [1] "Alpukat"
## 
## Slot "Satuan":
## [1] "kilogram"
## 
## Slot "unit":
## [1] 5
## 
## Slot "harga":
## [1] 50000

membuat objek S4 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)           #atribut panjang, lebar, dan kecepatan telah sesuai dengan syarat
class(Car2)

## [1] "car"
## attr(,"package")
## [1] ".GlobalEnv"

class(Mobil1)

## [1] "mobil"

Car3 <- Car("Wuling", 2.4, 2.1, 150)           #atribut panjang, lebar, dan kecepatan telah sesuai dengan syarat 
class(Car3)

## [1] "car"
## attr(,"package")
## [1] ".GlobalEnv"

class(Mobil1)

## [1] "mobil"

akses terhadap slot dengan fungsi aksesor

nama1 <- function(objek) objek@Nama         #fungsi yang digunakan untuk mengakses slot Nama dengan diberikan nama objek nama1
lebar1<- function (objek) objek@Lebar        # fungsi ini digunakan untuk mengakses atribut Lebar pada objek car sebelumnya
kecepatan1 <- function(objek) objek@Kecepatan  #fungsi ini digunakan untuk mengakses atribut kecepatan pada objek car sebelumnya
nama1(Car1)

## [1] "Toyota"

lebar1(Car1)

## [1] 2

kecepatan1(Car2)

## [1] 150

Class method

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

## Nama : Suzuki
## Kecepatan : 150NULL

menciptakan fungsi generik S4

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

## [1] "bbox"

setGeneric("authorNames",
    function(text) {
      value <- standardGeneric("authorNames")
      if(!(is(value, "character") && any(nchar(value)>0)))
        stop("authorNames methods must return non-empty strings")
      value
      })

## [1] "authorNames"

setGeneric("sides", function(object) {
  standardGeneric("sides")
})

## [1] "sides"

Latihan mandiri membuat fungsi

#membuat fungsi konversi fahrenheit to celcius
fahrenheit_to_celcius<-function(temp_F) {  #fahrenheit_to_celcius adalah nama fungsi #temp_F adalah argumen
  temp_C<-(temp_F - 32)*5/9                #temp_C<-(temp_F - 32)*5/9 adalah ekspresi
  return(temp_C)
}
fahrenheit_to_celcius(212)

## [1] 100

#membuat fungsi konversi celcius to kelvin
celcius_to_kelvin<-function(temp_C) {
  temp_K<-(temp_C + 273.15)
  return(temp_K)
}
celcius_to_kelvin(20)

## [1] 293.15

#membuat fungsi konversi fahrenheit to kelvin
fahrenheit_to_kelvin<-function(temp_F) {
  temp_C<-fahrenheit_to_celcius(temp_F)
  temp_K<-celcius_to_kelvin(temp_C)
  return(temp_K)
}
fahrenheit_to_kelvin(80)

## [1] 299.8167

Optimasi secara Numerik

Representasi bilangan

x<-(0.3-0.1)
x

## [1] 0.2

x1<-(0.3-0.1) == 2
x1

## [1] FALSE

x2<-0.2-(0.3-.1)
x2

## [1] 2.775558e-17

x3<-0.2-0.3-0.1
x3

## [1] -0.2

x4<-isTRUE(all.equal(.2, .3-.1))
x4

## [1] TRUE

x5<-all.equal(.2,.3)
x5

## [1] "Mean relative difference: 0.5"

x6<-isTRUE(all.equal(.2,.3))
x6

## [1] FALSE

library(Ryacas)

## 
## 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

Latihan 1:

integral dari x^2 + 4*x

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

Fungsi kalkulus: Diferensial (bahan ajar Dosen)

xfs<-expression(exp(x^2))
D(xfs,"x")

## exp(x^2) * (2 * x)

xturunan<-deriv(~x^2, "x")
x<-2
eval(xturunan)

## [1] 4
## attr(,"gradient")
##      x
## [1,] 4

attr(x , "gradient")

## NULL

## [1] 2

integrand <- function(x) {1/((x+1)*sqrt(x))}
integrate(integrand, lower = 0, upper = Inf)

## 3.141593 with absolute error < 2.7e-05

Latihan 3

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

Menghitung nilai optimum dari fungsi 4x^4-2x^3-3*x

f3 <- function(x) 4*x^4-2*x^3-3*x
x3 <- seq(-1,1.5,by=.1)
plot(x3,f3(x3),type="l")

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

## Warning in optim(par = c(-0.5), fn = f3): 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

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

Optimasi numerik menggunakan golden section search

golden <- function (f , a , b ,
tol = 0.0000001) {
ratio <- 2 / ( sqrt (5) +1)
x1 <- b - ratio * ( b - a )
x2 <- a + ratio * ( b - a )
f1 <- f ( x1 )
f2 <- f ( x2 )
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)
}
 f <- function (x ) {
 abs (x -3.5) + (x -2) ^2
 }
golden(f,1,2)

## [1] 2

golden(f,1,5)

## [1] 2.5

golden(f,3,5)

## [1] 3

golden(f,2,5)

## [1] 2.5

golden(f,4,5)

## [1] 4

Sumber:

https://swcarpentry.github.io/r-novice-inflammation/02-func-R/ https://astrostatistics.psu.edu/su07/R/library/methods/html/setGeneric.html http://adv-r.had.co.nz/S4.html

```

Laporan 3 Pemrograman Fungsi dan OOP & Optimasi Secara Numerik

Sitti Nurhaliza G1501201038

October 16, 2020

#Pemrograman Fungsi dan OOP

Latihan 1

Latihan 2

Latihan 3

Latihan 4

Pemrograman Berorientasi Objek

Latihan mandiri membuat fungsi

Optimasi secara Numerik

Latihan 1:

Latihan 2

Latihan 3

Latihan 5

Sumber: