library(dplyr)
## 
## Attaching package: 'dplyr'
## The following objects are masked from 'package:stats':
## 
##     filter, lag
## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, setequal, union

ex1

median_x <- function(x){
  calx <- x %>% sort()
  n <- length(x)
  if(n/2==0)
    (calx[n/2]+calx[n/2+1])/2
  else
    calx[(n+1)/2]
}
median_x(women$height)
## [1] 65

ex2

riffle <- function(x, y) {
  dl <- length(x) - length(y)
  y[(length(y)+1):(length(y)+dl)] <- rep(NA, dl)
  c(na.omit(as.numeric(t(cbind(x,y)))))
}

riffle(1:10, 50:55)
##  [1]  1 50  2 51  3 52  4 53  5 54  6 55  7  8  9 10

ex3

newcombo <- function(x){
  ll <- list()
  for(i in 1:length(x)){
    new <- as.list(data.frame(combn(x, i), stringsAsFactors = FALSE))
    ll <- c(ll, new)
  }
  return(ll)
}

newcombo(c("V1", "V2", "V3", "V4"))
## $X1
## [1] "V1"
## 
## $X2
## [1] "V2"
## 
## $X3
## [1] "V3"
## 
## $X4
## [1] "V4"
## 
## $X1
## [1] "V1" "V2"
## 
## $X2
## [1] "V1" "V3"
## 
## $X3
## [1] "V1" "V4"
## 
## $X4
## [1] "V2" "V3"
## 
## $X5
## [1] "V2" "V4"
## 
## $X6
## [1] "V3" "V4"
## 
## $X1
## [1] "V1" "V2" "V3"
## 
## $X2
## [1] "V1" "V2" "V4"
## 
## $X3
## [1] "V1" "V3" "V4"
## 
## $X4
## [1] "V2" "V3" "V4"
## 
## $combn.x..i.
## [1] "V1" "V2" "V3" "V4"

ex4

c <- matrix(,nrow=6,ncol=6)

for(j in 1:6){
  for(i in 1:6){
    if(j==1){
      c[i,j]=i
    }
    else{
      c[i,j]=(c[i,j-1]-1)
      if(c[i,j]<1) c[i,j]=c[i,j]+7
    }
  }
}
head(c)
##      [,1] [,2] [,3] [,4] [,5] [,6]
## [1,]    1    7    6    5    4    3
## [2,]    2    1    7    6    5    4
## [3,]    3    2    1    7    6    5
## [4,]    4    3    2    1    7    6
## [5,]    5    4    3    2    1    7
## [6,]    6    5    4    3    2    1
plot.new()
plot.window(xlim = c(0, 6), ylim = c(0, 6), asp = 1)
my_cl <- c("indianred", "orange", "yellow", "forestgreen", "dodgerblue", "violet", "purple")
for(i in 1:6) {
  for(j in 1:6) {
    cc<-c[i,j]
    rect(i-1,j-1 ,i, j, col = my_cl[cc])
  }
}

ex5

set.seed(9999) #亂數種子

coin <- sample(c("H", "T"), 100, replace = TRUE) # 硬幣投一百次

coin.rle <- rle(coin)

plot(prop.table(table(coin.rle$lengths)), 
     xlab = "run length",
     ylab = "probability")

ex7

dta1 <- data.table::fread("plasma.txt", fill = TRUE, data.table = T)[,1:7]
dta2 <- data.table::fread("plasma.txt", fill = TRUE, data.table = T) [, 8:14] %>% na.omit

names(dta1) <- c(paste0("week","_",c(1, 2, 6, 10, 14, 15, 16)))
names(dta2) <- c(paste0("week","_",c(1, 2, 6, 10, 14, 15, 16)))

library(tidyr)
dta1 <- dta1 %>% mutate(patient = rep(paste0("S",c(101:112)), each = 5),
                        variable = rep(c("plasma_ascorbic_acid","whole_blood_ascorbic_acid","grip_strength","reaction_time","folate_red_cell"), 12)) %>%
            gather("week", value, 1:7) %>% 
            separate(week, c("pre", "week"))
dta2 <- dta2 %>% mutate(patient = rep(paste0("S",c(101:112)), each = 4),
                        variable = rep(c("leucocyte_ascorbic_acid","thiamin_status","red_cell_transketolase","folate_serum"), 12)) %>%
            gather("week", value, 1:7) %>% 
            separate(week, c("pre", "week"))

data <- rbind(dta1, dta2) %>% 
          spread(variable, value) %>%
          select(-pre) %>%
          mutate(week = factor(week,level = c(1, 2, 6, 10, 14, 15, 16)),
                 patient = factor(patient)) %>%
          arrange(patient, week)

data <- data[c(1,2,7,6,11,10,5,9,8,4,3)]   
data[data == -9] <- NA                   
  
knitr::kable(head(data,10))
patient week plasma_ascorbic_acid leucocyte_ascorbic_acid whole_blood_ascorbic_acid thiamin_status grip_strength red_cell_transketolase reaction_time folate_serum folate_red_cell
S101 1 22 46 76 35 6 984 38 104 NA
S101 2 0 16 27 28 4 1595 29 67 NA
S101 6 103 37 114 0 5 1984 39 24 375
S101 10 67 45 100 0 5 1098 110 66 536
S101 14 75 29 112 11 4 1727 59 50 542
S101 15 65 35 96 0 2 1300 66 91 260
S101 16 59 36 81 36 4 1224 54 48 440
S102 1 18 34 47 48 14 1029 NA 75 NA
S102 2 0 13 41 32 11 1562 NA 61 NA
S102 6 96 39 103 0 18 1380 70 59 232