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


## ----vec1----------------------------------------------------------------
set.seed(1234)
x <- rnorm(5)
y <- runif(5)

## ----vec2----------------------------------------------------------------
x + y

## ----vec3----------------------------------------------------------------
z <- numeric(length(x))
for ( i in seq(along.with = x) ) {
  z[i] <- x[i] + y[i]
}
z

## ----vec4----------------------------------------------------------------
set.seed(1234)
x <- rnorm(10^6)
y <- runif(10^6)

## ----vec5----------------------------------------------------------------
system.time(x + y)

## ----vec6----------------------------------------------------------------
z <- numeric(length(x))
system.time(for ( i in seq(along.with = x) ) z[i] <- x[i] + y[i])

## ----vec7----------------------------------------------------------------
c(1, 2, 3) + 1:6

## ----vec8----------------------------------------------------------------
## c(1, 2, 3) + 1:5
## # Warning message:
## # In c(1, 2, 3) + 1:5 :
## #   longer object length is not a multiple of shorter object length

## ----imploop1------------------------------------------------------------
## ?Arithmetic
## ?Comparison

## ----imploop2------------------------------------------------------------
set.seed(1234)
x <- sample(100, 5)
((x %% 2) == 0)

## ----imploop3------------------------------------------------------------
mean(x)    # Summe als implizite Schleife, geteilt durch n
sum(x) / length(x)

## ----imploop4------------------------------------------------------------
z <- 0
for ( i in seq(along.with = x) ) {
  z <- z + x[i]
}
z <- z / length(x)
z

## ----imploop5------------------------------------------------------------
data("cars", package = "datasets")
# ?cars
str(cars)
colMeans(cars)  # implizite Schleife

## ----imploop6------------------------------------------------------------
## ?rowMeans
## ?rowSums
## ?colSums

## ----imploop7------------------------------------------------------------
set.seed(1234)
x <- letters[1:10]
ind <- sample(100, 10)

## ----imploop8------------------------------------------------------------
x[ind %% 2 == 0]
# bzw. mit which()
x[which(ind %% 2 == 0)]

## ----imploop9------------------------------------------------------------
z <- character()
for ( i in seq(along.with = x) ) {
  if ( ind[i] %% 2 == 0 ) {
    z <- c(z, x[i])
  }
}
z

## ----imploop10-----------------------------------------------------------
ifelse(test = ind %% 2 == 0, yes = x, no = NA)

## ----imploop11-----------------------------------------------------------
set.seed(1234)
A <- matrix(sample(10), ncol = 2)
A
t(A)

## ----imploop12-----------------------------------------------------------
n <- nrow(A)
m <- ncol(A)
At <- matrix(NA, nrow = m, ncol = n)
for ( i in seq(length.out = n) ) {
  for ( j in seq(length.out = m) ) {
    At[j, i] <- A[i, j]
  }
}
At

## ----bsp1----------------------------------------------------------------
ab <- function(x) {
  if ( x < 10 ) {
    "a"
  } else {
    "b"
  }
}

## ----bsp2----------------------------------------------------------------
ab(4)
ab(20)

## ----bsp3----------------------------------------------------------------
## ab(5:15)
## # Warning message:
## # In if (x < 10) { :
## #   the condition has length > 1 and only the first element will be used

## ----bsp4----------------------------------------------------------------
## # ?lapply
## # gibt immer eine Liste zurueck
## lapply(X=5:15, FUN=ab)

## ----bsp5----------------------------------------------------------------
## # ?sapply
## # versucht, das Ergebnis zu vereinfachen
## # (zu einem Vektor, einer Matrix, einem Array)
## sapply(X=5:15, FUN=ab)

## ----bsp6----------------------------------------------------------------
set.seed(1234)
l <- list(exp1 = rnorm(100),
          exp2 = rnorm(100),
          exp3 = rnorm(100))

## ----bsp7----------------------------------------------------------------
c(mean(l$exp1),
  mean(l$exp2),
  mean(l$exp3))

## ----bsp8----------------------------------------------------------------
ms <- numeric(length = length(l))
for ( i in seq(along.with = l) ) {
  ms[i] <- mean(l[[i]])
}
ms

## ----bsp9----------------------------------------------------------------
sapply(l, mean)

## ----bsp10---------------------------------------------------------------
## lapply(l, quantile)  # gibt Liste zurueck
## sapply(l, quantile)  # gibt Matrix zurueck

## ----bsp11---------------------------------------------------------------
## # ?mapply
## mapply(rep, 1:4, times=4:1)
## mapply(FUN=quantile, l, probs=list(c(0,0.5,0.75,1),
##         c(0.2,0.4), c(0.1,0.3,0.6)))

## ----bsp12---------------------------------------------------------------
## # ?replicate
## replicate(n=5, expr=rnorm(10,0,1))

## ----bsp13---------------------------------------------------------------
## data("cars", package = "datasets")
## 
## # ?apply
## # Maximum pro Zeile bzw. Spalte
## apply(X=cars, MARGIN=1, FUN=which.max)
## apply(X=cars, MARGIN=2, FUN=which.max)
## # MARGIN=1 fuer Zeilen
## # MARGIN=2 fuer Spalten
## # MARGIN=c(1,2) fuer Zellen

## ----anonym1-------------------------------------------------------------
function(x) {
  x + 1
}

## ----anonym2-------------------------------------------------------------
sapply(5:15,
       function(x) {
         if ( x < 10 ) {
           "a"
         } else {
           "b"
         }
       })

## ----gems1---------------------------------------------------------------
ds <- lapply(1:10, function(i) data.frame(
  a = runif(4), b = gl(2, 2), c=runif(4)))
# ds <- replicate(10, data.frame(
# a = runif(4), b = gl(2, 2), c=runif(4)), 
# simplify=FALSE) # alternativ
# str(ds, 1)

## ----gems2---------------------------------------------------------------
# do.call(, lapply())

## ----gems3---------------------------------------------------------------
# ?do.call
d <- do.call(what=rbind, args=ds)
str(d)

## ----gems4---------------------------------------------------------------
# lapply(, "[[", )

## ----gems5---------------------------------------------------------------
bs  <- lapply(ds, "[[", "b")
# lapply(ds, "[[", c("b","c")) # funktioniert nicht

## ----gems6---------------------------------------------------------------
bs2 <- lapply(1:10, function(j) ds[[j]][,c("b","c")])
bs3 <- lapply(1:10, function(j) ds[[j]][c("b","c")])

# Liste aus Data-frames
bs4 <- lapply(1:10, function(j) ds[[j]]["b"])    
# Liste aus Vektoren
bs5 <- lapply(1:10, function(j) ds[[j]][,"b"])         
# Liste aus Data-frames
bs6 <- lapply(1:10, function(j) ds[[j]][, "b", drop=FALSE])  

## ----gems7---------------------------------------------------------------
bs7 <- lapply(1:10, function(j) ds[[j]][2,"b"])

## ----highord1------------------------------------------------------------
## ?Map