¿Qué es una función?

Ejemplos de funciones en R

Multiplicación: Ejemplo de una función básica que multiplica un número por si mismo.

fun1 <- function(n) {
  n * n
}

fun1(10)
## [1] 100

Cuota de préstamo: Se pretende conocer la cuota mensual de un préstamo cuyo valor depende de el monto m, tasa de interés Ti y número de cuotas n; puede ser expresado de la siguiente manera: \[m*Ti/(1-(1-Ti)^{-n}\]

cuota <- function(tasa.interes, n, monto) {
  pago <- monto * tasa.interes/(1-(1+tasa.interes)^(-n))
  return(pago)
}

cuota(0.03, 12, 10000000)
## [1] 1004621
cuota(0.02, 12, 1500000)
## [1] 141839.4
tasa <- 0.05
cuotas <- 36
dinero <- 10000000

cuota(tasa.interes = tasa, n = cuotas, monto = dinero)
## [1] 604344.6

Área de un triángulo rectángulo: Función que devuelve el área de un triángulo rectángulo cuando se ingresa la base b y la altura h. \[b*h/2\]

area.tri <- function(base, altura) {
  return((base * altura)/2)  
}
area.tri(5, 15)
## [1] 37.5

Grados Fahrenheit: Función para convertir grados Centigrados a Fahrenheit, ingresando únicamente el número que corresponde a los grados centígrados a transformar.

farenheit <- function(n) {
  return(32 + 1.8 * n)
}

farenheit(29)
## [1] 84.2

Estructura de una función en R

body(fun1)
## {
##     n * n
## }
formals(fun1)
## $n
environment(fun1)
## <environment: R_GlobalEnv>
environment(mean)
## <environment: namespace:base>

Métodos (methods) en R

Ejemplo con función mean

structure(mean)
## function (x, ...) 
## UseMethod("mean")
## <bytecode: 0x412c8d0>
## <environment: namespace:base>
methods(mean)
## [1] mean.Date     mean.default  mean.difftime mean.POSIXct  mean.POSIXlt 
## see '?methods' for accessing help and source code
getAnywhere("mean.default")
## A single object matching 'mean.default' was found
## It was found in the following places
##   package:base
##   registered S3 method for mean from namespace base
##   namespace:base
## with value
## 
## function (x, trim = 0, na.rm = FALSE, ...) 
## {
##     if (!is.numeric(x) && !is.complex(x) && !is.logical(x)) {
##         warning("argument is not numeric or logical: returning NA")
##         return(NA_real_)
##     }
##     if (na.rm) 
##         x <- x[!is.na(x)]
##     if (!is.numeric(trim) || length(trim) != 1L) 
##         stop("'trim' must be numeric of length one")
##     n <- length(x)
##     if (trim > 0 && n) {
##         if (is.complex(x)) 
##             stop("trimmed means are not defined for complex data")
##         if (anyNA(x)) 
##             return(NA_real_)
##         if (trim >= 0.5) 
##             return(stats::median(x, na.rm = FALSE))
##         lo <- floor(n * trim) + 1
##         hi <- n + 1 - lo
##         x <- sort.int(x, partial = unique(c(lo, hi)))[lo:hi]
##     }
##     .Internal(mean(x))
## }
## <bytecode: 0x43cea28>
## <environment: namespace:base>

Ejemplo con función anova

structure(anova)
## function (object, ...) 
## UseMethod("anova")
## <bytecode: 0x1db02d8>
## <environment: namespace:stats>
methods(anova)
## [1] anova.glm*     anova.glmlist* anova.lm*      anova.lmlist* 
## [5] anova.loess*   anova.mlm*     anova.nls*    
## see '?methods' for accessing help and source code
getAnywhere("anova.lm")
## A single object matching 'anova.lm' was found
## It was found in the following places
##   registered S3 method for anova from namespace stats
##   namespace:stats
## with value
## 
## function (object, ...) 
## {
##     if (length(list(object, ...)) > 1L) 
##         return(anova.lmlist(object, ...))
##     if (!inherits(object, "lm")) 
##         warning("calling anova.lm(<fake-lm-object>) ...")
##     w <- object$weights
##     ssr <- sum(if (is.null(w)) object$residuals^2 else w * object$residuals^2)
##     mss <- sum(if (is.null(w)) object$fitted.values^2 else w * 
##         object$fitted.values^2)
##     if (ssr < 1e-10 * mss) 
##         warning("ANOVA F-tests on an essentially perfect fit are unreliable")
##     dfr <- df.residual(object)
##     p <- object$rank
##     if (p > 0L) {
##         p1 <- 1L:p
##         comp <- object$effects[p1]
##         asgn <- object$assign[qr.lm(object)$pivot][p1]
##         nmeffects <- c("(Intercept)", attr(object$terms, "term.labels"))
##         tlabels <- nmeffects[1 + unique(asgn)]
##         ss <- c(unlist(lapply(split(comp^2, asgn), sum)), ssr)
##         df <- c(lengths(split(asgn, asgn)), dfr)
##     }
##     else {
##         ss <- ssr
##         df <- dfr
##         tlabels <- character()
##     }
##     ms <- ss/df
##     f <- ms/(ssr/dfr)
##     P <- pf(f, df, dfr, lower.tail = FALSE)
##     table <- data.frame(df, ss, ms, f, P)
##     table[length(P), 4:5] <- NA
##     dimnames(table) <- list(c(tlabels, "Residuals"), c("Df", 
##         "Sum Sq", "Mean Sq", "F value", "Pr(>F)"))
##     if (attr(object$terms, "intercept")) 
##         table <- table[-1, ]
##     structure(table, heading = c("Analysis of Variance Table\n", 
##         paste("Response:", deparse(formula(object)[[2L]]))), 
##         class = c("anova", "data.frame"))
## }
## <bytecode: 0x3e0cb40>
## <environment: namespace:stats>

Estructuras de control

Estructuras de decisión

Ejemplos de sentencias if y else

Valor absoluto: Función que calcula el valor absoluto de un valor n de ingreso.

absoluto <- function(n) {
  if (n > 0) {
    abs1 <- n 
    return(abs1)
  }
  else {
    abs2 <- n * -1
    return(abs2)
  }
}

absoluto(-5)
## [1] 5
absoluto2 <- function(n) {
  if (n > 0) {
    abs1 <- n 
  }
  else {
    abs1 <- n * -1
  }
  return(abs1)
}

absoluto2(-10)
## [1] 10

Número mayor: Función que dice cuál es el número más grande entre a y b.

mayorNum <- function(a, b) {
  if (a > b) {
    return(a)
  }
  else {
    return(b)
  }
}

mayorNum(4, 10)
## [1] 10

Número mayor (3): La función retorna el número mayor entre los valores dados de A, B y C.

mayorNum2 <- function(A, B, C) {
  if ((A > B) && (A > C)) {
    return(A)
  } else {
    if ((B > A) && (B > C)) {
      return(B)
    } else {
      return(C)
    }
  }
}

mayorNum2(100, 101, 102)
## [1] 102

Estructuras de repetición

  • Sentencia while:

Construcción de un vector: Función que construye un vector v tal que en la entrada i esté el \(i^2 - 4\), es decir, \(v[i] = i^2 - 4\)

cvector <- function(n) {
  v <- c() 
  k <- 1 
  while(k <= n) {
    v[k] = k^2 - 4
    k <- k + 1
  }
  return(v)
}

cvector(5)
## [1] -3  0  5 12 21

Suma de elementos del vector: La función devuelve o genera la suma de todos los elementos de un vector, pero en valor absoluto, es decir, suma todos los elementos como positivos.

suma.v <- function(v) {
  suma <- 0 #acumulador
  i <- 1    
  while(i <= length(v)) {
    suma <- suma + abs(v[i])
    i <- i + 1
  }
  return(suma)
}

vectoPrueba <- c(1, 2, 5, 2)
suma.v(vectoPrueba)
## [1] 10

Encontrar el cero: La función encuentra la primera posición en un vector en la que se encuentra el cero “0”.

cero <- function(v) {
  i <- 1
  while(v[i] != 0 && i <= length(v)) {
    i <- i + 1
  }
  if (i <= length(v)) {
    return(i) 
  } else {
    return("!El vector no tiene ningún cero")
  }
}

vec3 <- c(10, 4, 0)
cero(vec3)
## [1] 3
  • Sentencia for:

Los ejemplos son los mismos propuestos para la sentencia while; con la finalidad de mostrar que con ambos loops se pueden obtener resultados muy interesantes.

Construcción de un vector: Función que construye un vector v tal que en la entrada i esté el \(i^2 - 4\), es decir, \(v[i] = i^2 - 4\)

cvector.f <- function(n) {
  v <- c()
  k <- 1
  for (k in 1:n) {
    v[k] <- k^2 -4
  }
  return(v)
}

cvector.f(9)
## [1] -3  0  5 12 21 32 45 60 77

Suma de elementos del vector: La función devuelve o genera la suma de todos los elementos de un vector, pero en valor absoluto, es decir, suma todos los elementos como positivos.

suma.a <- function(v) {
  suma <- 0
  i <- 1 
  for (i in 1:length(v)) {
    suma <- suma + abs(v[i])
  }
  return(suma)
}

suma.a(c(1, 2, 3, -5, -10))
## [1] 21

Encontrar el cero: La función encuentra la primera posición en un vector en la que se encuentra el cero “0”.

cero.f <- function(v) {
  i <- 1
  s <- -1
  for(i in 1:length(v)) {
    if ((v[i] == 0) && (s == -1)) {
      s <- i
    }
  }
  if (s != -1) {
    return(s)
  } else {
    return("¡El vector no tiene ningún cero!")
  }
}

a <- c(10, 4,  15, 1)
cero.f(a)
## [1] "¡El vector no tiene ningún cero!"

Otros ejemplos de funciones en R

Nota final: Diseñar una función que permita encontrar el promedio de notas de un estudiante (producto de 10 notas) y que nos diga si el estudiante ganó o perdió la asignatura.

nota <- function(nombre, nota1, nota2, nota3, nota4, nota5, nota6, nota7,
                 nota8, nota9, nota10) {
  n <- 10
  promedio <- (nota1 + nota2 + nota3 + nota4 + nota5 + nota6 + nota7 +
                 nota8 + nota9 + nota10) / n
  if (promedio > 3.0) {
    a <- paste("Señor(a)", nombre, "felicitaciones, la asignatura fue aprobada.", sep = " ")
  } else {
    a <- paste("Señor(a)", nombre, "lamentablemente la asignatura no fue aprobada.", sep = " ")
  }
  return(a)
}

nota("Pepito", 2, 3.3, 2.1, 4.5, 5.0, 4.2, 1.5, 2.7, 2.9, 4)
## [1] "Señor(a) Pepito felicitaciones, la asignatura fue aprobada."

Mi edad: Diseñar una función que devuelve su edad.

edad <- function(Nombre, Fecha_Actual, Fecha_Nac) {
  a <- as.integer(as.Date(Fecha_Actual)) - as.integer(as.Date(Fecha_Nac))
  b <-format(a / 365, nsmall = 2)
  c <- paste(Nombre, "su edad exacta es", b, "años.", sep = " ")
  return(c)
}

edad ("Pepito", Fecha_Actual = "2017-12-13", Fecha_Nac = "1985-03-19")
## [1] "Pepito su edad exacta es 32.7589 años."

Ejercicios de interés

Construir funciones para: