#Functions, Loops, Conditions etc...

myfun1 <- function(x,a) {
    r <- a*sin(x)
    return(r)
}
myfun1(pi/2, 2)
## [1] 2
#--------------------------
myfun2 <- function(x,a=1) {
        r <- a*sin(x)
        return(r)
    }
myfun2(pi/2)
## [1] 1
#--------------------------
myfun3 <- function(x, a){ a*sin(x) } #short version
myfun3(pi/2, 3)
## [1] 3
#-------------------------
    #optional parameter w/o default
myfun4 <- function(x, a=NULL) { 
    if (!is.null(a)) {
    a*sin(x) 
    }   else    {
        cos(x)  }
}
myfun4(pi/2, 4)
## [1] 4
myfun4(pi/2)
## [1] 6.123234e-17
#------------------------
#Multiple return values have to be returned as a single list.
myfun5 <- function(x, a=1){
    r1 <- a*sin(x)
    r2 <- a*cos(x)
   return(list(r1,r2)) # one list as result
} 
myfun5(pi/2)
## [[1]]
## [1] 1
## 
## [[2]]
## [1] 6.123234e-17
#---------------IF---------
# simple if
    x <- 1
    if (x==2) { print("x=2") } 
# if-else
    x <- 1
    if (x==2){
        print("x=2") 
    } else {
        print("x!=2") 
    }
## [1] "x!=2"
#---------------FOR---------

for (i in 1:4) { print(i) }
## [1] 1
## [1] 2
## [1] 3
## [1] 4
names <- c("Matt", "Alena", "Uwe") 
    for (name in names) { print(name) } 
## [1] "Matt"
## [1] "Alena"
## [1] "Uwe"
    for (name_idx in seq_along(names)) {
    print(paste(name_idx, name, sep=" : ")) }
## [1] "1 : Uwe"
## [1] "2 : Uwe"
## [1] "3 : Uwe"
data <- matrix(sample.int(10), ncol=5)
# prefer seq_len() rather than 1:ncol(data) 
    for (col_idx in seq_len(ncol(data))) {
        data[,col_idx] <- sort(data[,col_idx]) 
    }

x <- data.frame(matrix(runif(100 * 1e4), ncol=100)) 
head(x,1)
##          X1       X2        X3        X4       X5        X6        X7
## 1 0.3983871 0.246041 0.7256098 0.9039756 0.322418 0.8590888 0.8424277
##          X8        X9       X10       X11       X12       X13       X14
## 1 0.5369638 0.5254647 0.2482036 0.3952152 0.2684904 0.1407176 0.4876834
##         X15        X16       X17       X18       X19       X20       X21
## 1 0.3225502 0.06103186 0.4181286 0.1785062 0.1239032 0.1088899 0.8442812
##        X22       X23       X24       X25       X26       X27       X28
## 1 0.469632 0.7204274 0.6253934 0.9458841 0.3210789 0.6849424 0.9255498
##         X29       X30       X31       X32       X33       X34       X35
## 1 0.3922843 0.4861285 0.8220543 0.3021088 0.3856903 0.2482423 0.1207668
##         X36       X37       X38       X39       X40       X41       X42
## 1 0.5704113 0.5838493 0.4415714 0.6570305 0.1434126 0.5642096 0.3031644
##         X43      X44       X45       X46        X47       X48       X49
## 1 0.5135162 0.773124 0.5678358 0.2764739 0.04941168 0.4211345 0.6859444
##         X50       X51       X52       X53       X54       X55       X56
## 1 0.9975088 0.9072429 0.8281778 0.4903651 0.6206585 0.6586371 0.5915356
##         X57       X58        X59       X60       X61       X62        X63
## 1 0.8377016 0.3997406 0.09813442 0.2750057 0.4485609 0.9132014 0.05230602
##         X64        X65       X66       X67       X68        X69       X70
## 1 0.2625907 0.01662683 0.6197254 0.6726566 0.2653336 0.01412639 0.6622138
##         X71       X72       X73       X74       X75      X76       X77
## 1 0.8748166 0.6408881 0.7137882 0.1470305 0.2344044 0.672803 0.3108112
##          X78       X79       X80       X81       X82       X83       X84
## 1 0.04786078 0.5063644 0.2392516 0.2685584 0.2758208 0.7584384 0.4466158
##          X85       X86       X87       X88       X89       X90       X91
## 1 0.07944211 0.7119053 0.9000235 0.3554556 0.9051679 0.8674466 0.3549985
##          X92       X93       X94       X95       X96       X97       X98
## 1 0.01914867 0.4222839 0.0368231 0.5249349 0.6897125 0.5530965 0.6639017
##         X99      X100
## 1 0.1802978 0.2399958
medians <- vapply(x, median, numeric(1))

#subtract medians one element at a time in a loop # takes 5.5 seconds
for(i in seq_along(medians)) {
    x[, i] <- x[, i] - medians[i] 
}

#subtract a list of values
# takes 0.3 seconds
x <- x - as.list(medians)

#-----WHILE------------------
i <- 0
while(i < 4) {
    i <- i+1
    print(i) 
}
## [1] 1
## [1] 2
## [1] 3
## [1] 4
# if no break is given, loops runs forever
i <- 0 
repeat {
    i <- i+1
    print(i)
    if (i == 4) break
}
## [1] 1
## [1] 2
## [1] 3
## [1] 4
#these commands allow functions to be run on matrices.
#   apply()     Function used on matrix
#    tapply()    table grouped by factors
#    lapply()    on lists and vectors; returns a list
#    sapply()     like lapply(), returns vector/matrix
#    mapply()    multivariate sapply()
 
#-------apply----------
a <- matrix(1:10,nrow=2)
apply(a,1,mean) # 1 = by rows
## [1] 5 6
apply(a,2,mean) # 2 = by columns
## [1] 1.5 3.5 5.5 7.5 9.5
# the function can also be anonymous
apply(a,2,function(x) { x[[sample.int(length(x),1) ]] })
## [1]  2  4  5  7 10
#-------lapply----------
a <- matrix(2:11,nrow=2)
b <- matrix(1:10,nrow=2) 
c <- list(a,b)
lapply(c,mean)
## [[1]]
## [1] 6.5
## 
## [[2]]
## [1] 5.5
sapply(c,mean)
## [1] 6.5 5.5
#-------mapply----------
#Like sapply() but applies over the first elements of each argument
# mapply(FUNCTION, list, list, list...)
    mapply(rep, pi, 3:1)
## [[1]]
## [1] 3.141593 3.141593 3.141593
## 
## [[2]]
## [1] 3.141593 3.141593
## 
## [[3]]
## [1] 3.141593
# equivalent to: 
rep(pi, 3) 
## [1] 3.141593 3.141593 3.141593
rep(pi, 2) 
## [1] 3.141593 3.141593
rep(pi, 1)
## [1] 3.141593
#-------tapply---------
#Run a function on each group of values specified by a factor. 
#Requires a vector, factor and function.
data(iris)
    attach(iris)
    tapply(Sepal.Width , Species , mean)
##     setosa versicolor  virginica 
##      3.428      2.770      2.974
#------Errors and Debugging: debug()------
#debug(cat) # disable debug flag: undebug(cat)
#cat("hello")
#undebug(cat)

#Debugger commands:
#n advance to next step
#c continue to the end of current loop or function where print a stack trace
#Q exit the browser
#You can also use any R command! Check the value of variables,
#length/dimensions of matrices, etc.

#You can also start the debugger on a certain line of code, rather 
#than when a function is called:

#mydata <- read.csv("testfile.csv") 
#    browser () # starts the debugger 
#means <- rowMeans(mydata)

#Start the debugger automatically when there is an error:
# put this at the top of your file
options(error = recover)