# --------- Control structures  -------

rm(list = ls())

# ----------------------------------------
# 5.1 Control flow
# Übersicht mit
?Control

# Grundlegende Kontroll-Fluss-Konstrukte
# um die Reihenfolge festzulegen, in welcher die einzelnen Befehle ausgeführt werden

# 1) Choices (Bedingungen) - if-else
# 2) Loops (Schleifen) - for bzw. while
# 3) Functions (Funktionen)
# 4) Ending (Beenden eines Programmes)
# 5) Exceptions (Ausnahmen)


# ----------------------------------------
# 5.2 Choices (Bedingungen)

#-----------------
# if-else Anweisung

# if ( condition ) {
#   statement1
# } else {
#   statement2
# }

# Beispiel: sign (Vorzeichen)-Funktion 
# gibt für x<0 den Wert -1 zurück,
# gibt für x>0 den Wert +1 zurück
# sollte für x=0 den Wert 0 zurückgeben
sign <- function(x) {
  if ( x > 0 ) {  # condition1
    y <- +1       # statement1
  } else {        # !condition1
    y <- -1       # statement2
  }
  y
}

# Funktionsaufrufe
c(sign(-10), sign(pi), sign(10))

sign(0)   # die Funktion funktioniert für x=0 noch nicht korrekt

# Verbesserte Funktion - verschachtelte if-else statements
sign <- function(x) {
  if ( x > 0 ) {         # condition1
    y <- +1              # statement1
  } else if ( x < 0 ) {  # condition2
    y <- -1              # statement2
  } else {               # !(condition1 | condition2)
    y <- 0               # statement3
  }
  y
}

# Funktionsaufruf
c(sign(-10), sign(0), sign(10))

# Falls die Bedingung in einer if-else Anweisung ein Vektor ist,
# wird nur das erste Element verwendet.
sign(c(-1.2, exp(1), 13.873))


#-----------------
# Funktion ifelse () - funktioniert auch für Vektoren
# Alternative zu: if (condition) {statement1} else {statement2}
?ifelse
# ifelse(test, yes, no)
# Arguments
# test   an object which can be coerced to logical mode.
# yes	   return values for true elements of test.
# no	   return values for false elements of test.

sign <- function(x) {
  ifelse(test=x>0, 
         yes=+1, 
         no=ifelse(test=x<0, 
                   yes=-1, 
                   no=0)
         )
}

# Funktionsaufrufe
c(sign(-10), sign(0), sign(10))
sign(c(-10, 0, 10))
sign(c(-1.2, exp(1), 13.873))



# ----------------------------------------
# 5.3 Loops (Schleifen)

#-----------------
# for-Schleife
# wenn die Anzahl an Iterationen im Vorhinein bekannt ist

# for ( var in seq ) {
#   statement1
# }

# Beispiel: Funktion, die die Elemente e eines Vektors x aufsummiert
adder <- function(x) {
  y <- 0
  for ( e in x ) {  # var in seq
#    print(y)                          # zur Veranschaulichung eingefügt
#    print(e)
    y <- y + e      # statement1
  }
  y
}

adder(x=1:10)
adder(x=c(1,2,4,8,16))
adder(x=NA)
adder(x=NULL)
adder(x=numeric(length=0))


# Alternative Programmierung - Schleife mit Zählvariable i
# mit seq_along(x)
adder2 <- function(x) {
  y <- 0
  for ( i in seq_along(x) ) {  # var in seq
#      print(y)                          # zur Veranschaulichung eingefügt
#      print(x[i])     
    y <- y + x[i]      # statement1
  }
  y
}

adder2(x=1:10)
adder2(x=c(1,2,4,8,16))
adder2(x=NA)
adder2(x=NULL)
adder2(x=numeric(length=0))

# mit 1:length(x) 
adder3 <- function(x) {
  y <- 0
  for ( i in 1:length(x) ) {  # var in seq
#      print(y)                          # zur Veranschaulichung eingefügt
#      print(x[i]) 
    y <- y + x[i]      # statement1
  }
  y
}

adder3(x=1:10)
adder3(x=c(1,2,4,8,16))
adder3(x=NA)
adder3(x=NULL)
adder3(x=numeric(length=0))  # kein sinnvolles Ergebnis

#--------------
x <- c(1,2,4,8,16)
x <- numeric(length=0)

1:length(x)
seq_along(x)
# ist dasselbe, solange x mindestens ein gültiges Element hat
# wenn x leer sein kann, ist seq_along(x) die sicherere Variante 


#-----------------
# while-Schleife
# wenn die benötigte Anzahl an Iterationen 
# von einer Berechnung innerhalb der Schleife abhängt

# while ( condition ) {
#   statement1
# }

# Beispiel: Funktion, die Zufallszahlen zwischen 1 und 100 aufsummiert,
# bis die Summe größer ist als ein vorgegebener Wert x
radder <- function(x) {
  y <- 0    # Initialisierung von y
  i <- 0    # Initialisierung der Zählvariable i
  while ( y <= x ) {         # condition
    y <- y + sample(100, 1)  # statement1
    i <- i + 1    # Erhöhung der Zählvariable i um 1           
  }
  c(x = x, i = i, y = y)
}

set.seed(1234)
radder(20)
radder(831)

# Vorsicht: Es sollten keine unendlichen Schleifen erzeugt werden!
# Abbruch mit ESC möglich (oder STOP-Button)

# x <- 1
# while ( x > 0 ) {
#   x <- x + 1
# }


# ----------------------------------------
# 5.4 Ending

# Die return-Anweisung beendet die aktuelle Funktion.
# return(value)

# Beispiel für unendliche Schleife
# radder(Inf)

# Erweiterung der Funktion radder
# Abfangen von ungewünschten Eingaben mit if-return
radder <- function(x) {
  if ( x == Inf ) {
    return(c(x = x, i = Inf, y = Inf))
  }

  y <- 0
  i <- 0
  while ( y <= x ) {
    y <- y + sample(100, 1)
    i <- i + 1
  }
  c(x = x, i = i, y = y)
}

radder(Inf)

# oder 
radder <- function(x) {
  if ( x == Inf ) {
    return("Fehler: x=Inf stellt keine sinnvolle Eingabe dar")
  }
  
  y <- 0
  i <- 0
  while ( y <= x ) {
    y <- y + sample(100, 1)
    i <- i + 1
  }
  c(x = x, i = i, y = y)
}

radder(Inf)

# if-return ermöglicht detaillierte Fehlerbeschreibungen
# Alternative zu stopifnot() bzw. stop() 
# - Fehlermeldung dabei vom Programmierer nicht beeinflussbar

# ----------------------------------------
# 5.5 Exceptions (Ausnahmen)
# Exception handling

# tryCatch(expr, ...)

# Beispiel: Funktion, die die Summe von n Zufallszahlen zwischen -0.5 und 1 berechnet
# Fehlermeldung, falls die Summe kleiner als 0 ist
f <- function(n) {
  x <- runif(n, min = -0.5, max = 1)
  if ( sum(x) < 0 ) {
    stop("Sorry, sum(x) < 0")
  }
  sum(x)
}

set.seed(1234)
f(10)
f(10)

# Verwendung dieser Funktion innerhalb einer anderen Funktion
# Simulation mit m Wiederholungen
# Die Funktion soll nicht stoppen, wenn ein Fehler auftritt.
# Stattdessen soll der Fehler ignoriert werden 
# und die restlichen Iterationen ausgeführt werden.
g <- function(n, m) {
  y <- numeric(length = m)

  for ( i in seq(length = m) ) {
    y[i] <- tryCatch(f(n),
                     error = function(e) {
                       warning("Error in f(); using NA instead.")
                       NA_real_
                     })
  }
  y
}

set.seed(1222)
g(10, 10)
g(10, 10)

# Besonders nützlich bei langen Simulationen.
# Ebenfalls in manchen Situationen lohnenswert ist try().