### -----------------------------------------------------------------------
### Programmieren mit statistischer Software (SoSe 2017)
### -----------------------------------------------------------------------


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

## ----if2-----------------------------------------------------------------
# gibt fuer x<0 den Wert -1 zurueck,
# gibt fuer x>0 den Wert +1 zurueck
# sollte fuer x=0 den Wert 0 zurueckgeben
sign <- function(x) {
  if ( x > 0 ) {  # condition1
    y <- +1       # statement1
  } else {        # !condition1
    y <- -1       # statement2
  }
  y
}

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

sign(0)   # die Funktion funktioniert fuer x=0 noch nicht korrekt

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

## ----if5-----------------------------------------------------------------
sign(c(-1.2, exp(1), 13.873))

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

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

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

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

## ----for2----------------------------------------------------------------
adder <- function(x) {
  y <- 0
  for ( e in x ) {  # var in seq
    #    print(y)   # zur Veranschaulichung eingefuegt
    #    print(e)
    y <- y + e      # statement1
  }
  y
}

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

## ----for4----------------------------------------------------------------
# mit seq_along(x)
adder2 <- function(x) {
  y <- 0
  for ( i in seq_along(x) ) {  # var in seq
    #      print(y)            # zur Veranschaulichung eingefuegt
    #      print(x[i])     
    y <- y + x[i]      # statement1
  }
  y
}

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

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

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

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

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

## ----while1--------------------------------------------------------------
# while ( condition ) {
#   statement1
# }

## ----while2--------------------------------------------------------------
radder <- function(x) {
  y <- 0    # Initialisierung von y
  i <- 0    # Initialisierung der Zaehlvariable i
  while ( y <= x ) {         # condition
    y <- y + sample(100, 1)  # statement1
    i <- i + 1    # Erhoehung der Zaehlvariable i um 1           
  }
  c(x = x, i = i, y = y)
}

## ----while3--------------------------------------------------------------
set.seed(1234)
radder(20)
radder(831)

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

## ----return1-------------------------------------------------------------
# return(value)

## ----return2-------------------------------------------------------------
# radder(Inf)

## ----return3-------------------------------------------------------------
# Abfangen von ungewuenschten 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)

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

## ----except1-------------------------------------------------------------
# tryCatch(expr, ...)

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

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

## ----except4-------------------------------------------------------------
set.seed(1222)
g(10, 10)

## ----except5-------------------------------------------------------------
g(10, 10)