EX02

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
# median minimizes sum of absolute deviation
cal_median <- function(x) {
 n <- length(x)
 newx <- sort(x)
 if(n/2==0)
   (newx[n/2]+newx[n/+1])/2
 else
   newx[(n%/%2)+1]
}

# test it
cal_median(women$height)
## [1] 65

EX03

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)))))
}
  
# test it
riffle(1:10, 50:55)
##  [1]  1 50  2 51  3 52  4 53  5 54  6 55  7  8  9 10

EX04

nameCombo <- function( x ) {
  n <-length(x)
  ll <- as.list(x)
  for(i in 2:length(x)) {
      indices <- combn(1:n, i) #給出所有可能組合(排列組合)
      for(j in 1:dim(indices)[2]) {
          new_ll <- list(x[indices[, j]])
          ll <- c(ll, new_ll)
      }
   }
   return(ll)
}
# test it
nameCombo(c("V1", "V2", "V3"))
## [[1]]
## [1] "V1"
## 
## [[2]]
## [1] "V2"
## 
## [[3]]
## [1] "V3"
## 
## [[4]]
## [1] "V1" "V2"
## 
## [[5]]
## [1] "V1" "V3"
## 
## [[6]]
## [1] "V2" "V3"
## 
## [[7]]
## [1] "V1" "V2" "V3"
nameCombo_new <- function(x) {
ll <- list()
for(i in 1:length(x)){
  b1 <- apply(combn(x,i), 2, list)
  new_ll <- lapply(b1,unlist)
  ll <- c(ll,new_ll)
}
return(ll)
}

#test it
nameCombo_new(c("V1", "V2", "V3"))
## [[1]]
## [1] "V1"
## 
## [[2]]
## [1] "V2"
## 
## [[3]]
## [1] "V3"
## 
## [[4]]
## [1] "V1" "V2"
## 
## [[5]]
## [1] "V1" "V3"
## 
## [[6]]
## [1] "V2" "V3"
## 
## [[7]]
## [1] "V1" "V2" "V3"

EX05

plot.new()

plot.window(xlim = c(0, 6), ylim = c(0, 6), asp = 1)

my_cl <- c("indianred", "orange", "yellow", "forestgreen", "dodgerblue",
           "violet", "purple")
m <- matrix(1:7, nrow = 6, ncol = 6)
## Warning in matrix(1:7, nrow = 6, ncol = 6): 資料長度 [7] 並非列數量 [6] 的
## 因數或倍數
for(i in 1:6) {
  for(j in 1:6){
    cm <- m[i, j]
    rect(i-1, j-1, i, j, col = my_cl[cm])
  }
}

EX06

set.seed(0423)
coin <- sample(c("H", "T"), 100, replace = TRUE)

coin.rle <- rle(coin)

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

EX07

library(data.table)
## 
## Attaching package: 'data.table'
## The following objects are masked from 'package:dplyr':
## 
##     between, first, last
library(tidyverse)
## -- Attaching packages ------------------------------------------------ tidyverse 1.2.1 --
## √ ggplot2 2.2.1     √ readr   1.1.1
## √ tibble  1.4.2     √ purrr   0.2.4
## √ tidyr   0.8.0     √ stringr 1.3.0
## √ ggplot2 2.2.1     √ forcats 0.3.0
## -- Conflicts --------------------------------------------------- tidyverse_conflicts() --
## x data.table::between() masks dplyr::between()
## x dplyr::filter()       masks stats::filter()
## x data.table::first()   masks dplyr::first()
## x dplyr::lag()          masks stats::lag()
## x data.table::last()    masks dplyr::last()
## x purrr::transpose()    masks data.table::transpose()
library(knitr)
#
dta1 <- fread("plasma.txt", fill = TRUE)[, 1:7]

#
names(dta1) <- c(paste("week", c(1, 2, 6, 10, 14, 15, 16), sep = "."))

#
dta11 <- dta1 %>% 
  mutate(patient = rep(paste0("S", 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 <- fread("plasma.txt", fill = TRUE)[, 8:14] %>% 
  na.omit

#
names(dta2) <- c(paste("week", c(1, 2, 6, 10, 14, 15, 16), sep = "."))

#
dta22 <- dta2 %>% 
  mutate(patient = rep(paste0("S", 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"))

#
dta7 <- read.csv("plasma.csv", header = TRUE)

new.dta <- rbind(dta11, dta22) %>% 
  spread(variable, value) %>% 
  select(names(dta7)) %>% 
  mutate_at(vars(names(dta7)), funs(ifelse(. == -9, NA, .))) %>% 
  mutate(week = factor(week, level = c(1, 2, 6, 10, 14, 15, 16))) %>% 
  arrange(patient, week)

kable(head(new.dta, 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