Q2 Calculate median

# 將數字從小排到大，取中位數
median <- function(x){
  n <- length(x)
  x <- sort(x)
  if((n+1)%%2 == 0)
    x[(n+1)/2]
  else
    (x[n/2]+x[n/2 + 1]) / 2
}

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

Q3 riffle

riffle_new <- function(x, y) {
dl <- abs(length(x) - length(y))   
  if (length(x) >= length(y)) {
    y[(length(y)+1):(length(y)+dl)] <- rep(NA, dl)
    c(na.omit(as.numeric(t(cbind(x,y)))))
  }
  else
    x[(length(x)+1):(length(x)+dl)] <- rep(NA, dl)
    c(na.omit(as.numeric(t(cbind(x,y)))))
}

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

Q4 nameCombo

列出所有輸入的物件組合

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"

Q5 Color square

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

my_cl <- c("yellow", "forestgreen", "dodgerblue",
           "violet", "purple","indianred", "orange") 
my_cl <- rep(my_cl,2)

# plot from upper left; plot row by row
for(j in 6:1){
  w <- 7-j
  for(i in 1:6) rect(i-1, j-1, i, j, col = my_cl[i+w-1])
}

Q6 Toss coin

ll <- data.frame()

# sampling 1000 times
for(i in 1:1000){
  coin <- sample(c("H", "T"), 100, replace = TRUE)
  head_count <- table(coin)[1]   # pick head
  prob_head <- head_count/100
  coin.rle <- rle(coin)
  head_strike <- tapply(coin.rle$lengths, coin.rle$values, max) [2] # maximun of head strike
  pp <- as.data.frame(cbind(prob_head,head_strike ))
  ll <- rbind(ll,pp)
}

plot(ll) ; cor(ll)

             prob_head head_strike
prob_head    1.0000000  -0.4425593
head_strike -0.4425593   1.0000000

Q7 Rearrange data

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
library(tidyr)

# read in left and right part
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

# give names
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)))

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"))

# combine data
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)]  # rearrage columns 
data[data == -9] <- NA                    # replace -9 to 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