# --------- Writing your own functions  -------

rm(list = ls())

# ----------------------------------------
# 4.1 Function definition

# Eine Funktion 
# - hat einen Namen
# - benötigt Argumente (Input): arg_1, arg_2, ... -> formale Argumente
# - führt (mit den Argumenten) Berechnungen durch und
# - gibt ein Ergebnis zurück (Rückgabewert)

# name <- function(arg_1, arg_2, ...) {
#   statements
# }

# Funktionsaufruf
# name(expr_1, expr_2)


# Beispiel: Funktion, die den Index der Beobachtung zurückgibt, die am stärksten vom Median abweicht
# Name der Funktion: which_maxdev 
# Input: x
# Rückgabewert: standardmäßig die letzte Zeile der Funktion, ansonsten benötigt man return()
?which.max

which_maxdev <- function(x) {
  mdn <- median(x)
  devs <- abs(x - mdn)
  which.max(devs)
}

# Funktionsaufrufe
data("Forbes2000", package = "HSAUR2")

# summary(Forbes2000$sales)
which_maxdev(Forbes2000$sales)
# Forbes2000$sales[which_maxdev(Forbes2000$sales)]

# summary(Forbes2000$marketvalue)
which_maxdev(Forbes2000$marketvalue)
# Forbes2000$marketvalue[which_maxdev(Forbes2000$marketvalue)]


# Ausgabe der letzten Zeile
which_maxdev <- function(x) {
  mdn <- median(x)
  devs <- abs(x - mdn)
  which.max(devs)
  print("Hallo")
}

which_maxdev(Forbes2000$sales)

# Ausgabe dessen, was mit return() explizit zurückgegeben wird
# Der Rest der Funktion wird nicht mehr ausgeführt
which_maxdev <- function(x) {
  mdn <- median(x)
  devs <- abs(x - mdn)
  return(which.max(devs))
  print("Hallo")
}

which_maxdev(Forbes2000$sales)


# ----------------------------------------
# 4.2 The ... argument

which_maxdev <- function(x) {
  mdn <- median(x)
  devs <- abs(x - mdn)
  which.max(devs)
}

which_maxdev(Forbes2000$profits)
# Alle Funktionen innerhalb der selbst geschriebenen Funktion werden, 
# soweit nicht anders angegeben, 
# mit ihren Default-Argumenten verwendet.
median(Forbes2000$profits)
args(median)
# Argument na.rm

# Erweiterung der Funktion which_maxdev mit dem ... Argument
which_maxdev <- function(x, ...) {
  mdn <- median(x, ...)
  devs <- abs(x - mdn)
  which.max(devs)
}

which_maxdev(Forbes2000$profits, na.rm = TRUE)


# ----------------------------------------
# 4.3 Named arguments and defaults

# na.rm=TRUE als Default (Standardeinstellung)
which_maxdev <- function(x, na.rm = TRUE) {
  mdn <- median(x, na.rm = na.rm)
  devs <- abs(x - mdn)
  which.max(devs)
}

which_maxdev(Forbes2000$profits)

# Äquivalente Aufrufe der Funktion which_maxdev
# Bei Verwendung der Namen der Argumente kann die Reihenfolge beliebig variiert werden.
# Ohne Verwendung der Namen der Argumente muss die Reihenfolge aus der Definition der Funktion eingehalten werden.

# Ohne Namen der Argumente
which_maxdev(Forbes2000$sales)
which_maxdev(Forbes2000$sales, FALSE)
# which_maxdev(FALSE, Forbes2000$sales)   # funktioniert nicht

# Mit Namen der Argumente
which_maxdev(x = Forbes2000$sales, na.rm = FALSE)
which_maxdev(na.rm = FALSE, x = Forbes2000$sales)
which_maxdev(na.rm = FALSE, Forbes2000$sales)  # teilweise Benennung funktioniert auch


# ----------------------------------------
# 4.4 Argument matching

# 3-stufiger Prozess
# 1) Exaktes Matching basierend auf den exakten Namen der Argumente
which_maxdev(Forbes2000$sales, na.rm = FALSE)
# Jeder Argument-Name darf nur einmal verwendet werden
# which_maxdev(na.rm=Forbes2000$sales, na.rm = FALSE) # funktioniert nicht

# 2) Partielles Matching basierend auf den (Anfangsbuchstaben der) Namen der Argumente
# hier: n statt na.rm
which_maxdev(Forbes2000$sales, n = FALSE)
# which_maxdev(Forbes2000$sales, n = FALSE, na = FALSE) # funktioniert nicht

# 3) Matching basierend auf der Position der Argumente
which_maxdev(n = FALSE, Forbes2000$sales)

# Unmatched Arguments -> error
which_maxdev(Forbes2000$sales, foo = 1)


# ----------------------------------------
# 4.5 Argument checking

# Falsche Eingabe-Argumente müssen aufgefangen werden.
# Es sollte eine hilfreiche Fehlermeldung zurückgegebenwerden.

# Fehlerhafte Verwendung der Funktion which_maxdev
which_maxdev(Forbes2000$name)
which_maxdev(as.matrix(Forbes2000[, c("sales", "marketvalue")]))
which_maxdev(Forbes2000$sales, na.rm = "yes")

# Überprüfung der Eingabe mit stopifnot()
which_maxdev <- function(x, na.rm = TRUE) {
  stopifnot(is.numeric(x))
  stopifnot(is.vector(x))
  stopifnot(is.logical(na.rm))

  mdn <- median(x, na.rm = na.rm)
  devs <- abs(x - mdn)
  which.max(devs)
}

which_maxdev(Forbes2000$name)
which_maxdev(as.matrix(Forbes2000[, c("sales", "marketvalue")]))
which_maxdev(Forbes2000$sales, na.rm = "yes")


# Ausblick: Anwendung einer Funktion, die für einen Vektor definiert ist, auf eine Matix
# mit apply()
apply(as.matrix(Forbes2000[, c("sales", "marketvalue")]), 2,
      which_maxdev)


# ----------------------------------------
# 4.6 Return value

# Jegliches R-Objekt kann von einer Funktion zurückgegeben werden.
# Default: Wert des letzten Ausdrucks (der letzten Zeile)

# oder mit return() -> die Funktion wird dann verlassen
which_maxdev <- function(x, na.rm = TRUE) {
  stopifnot(is.numeric(x) & is.vector(x))
  stopifnot(is.logical(na.rm))
  
  mdn <- median(x, na.rm = na.rm)
  devs <- abs(x - mdn)
  return(which.max(devs))
}

# kann direkt ausgegeben werden
which_maxdev(Forbes2000$sales)
# und kann zugewiesen werden
res <- which_maxdev(Forbes2000$sales)
res


# oder mit invisible() -> Objekt nur nach Zuweisung sichtbar
which_maxdev <- function(x, na.rm = TRUE) {
  stopifnot(is.numeric(x) & is.vector(x))
  stopifnot(is.logical(na.rm))
  
  mdn <- median(x, na.rm = na.rm)
  devs <- abs(x - mdn)
  invisible(which.max(devs))
}

# Ergebnis wird nicht ausgegeben
which_maxdev(Forbes2000$sales)
# kann aber zugewiesen werden
res <- which_maxdev(Forbes2000$sales)
res


# ----------------------------------------
# 4.7 Function scope

# Regeln um den Wert eines Symbols zu finden

# 3 Klassen von Symbolen
# 1) Formale Parameter - Argumente der Funktion - hier x
# 2) Lokale Variablen - werden innerhalb der Funktion definiert - hier y
# 3) Freie Variablen - der Rest - hier z
#    - hierzu wird das Environment der Funktion durchsucht, dann der Umgebung, usw., bis zum Globalen Environment

# 1) und 2) werden auch gebundene Variablen genannt.
# Sie existieren nur innerhalb des Environments der Funktion und nicht außerhalb.

f <- function(x) {
  y <- 2 * x
  cat("x =", x, "\n")
  cat("y =", y, "\n")
  cat("z =", z, "\n")
}

# Fehlermeldung, da z nicht definiert ist
f(2)

# Definiton von z
z <- 42
f(2)
# Warnung: Die Verwendung freier Variablen in einer Funktion ist sehr fehleranfällig 
#          und sollte deshalb vermieden werden.