HW0416

HW2

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

HW3

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

HW4

# 原始combo根據incices取出x所有物件的排列組合
my_combo <- 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)
}

my_combo(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"

HW5

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

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

# 從左上方開始一直塗過去
for(j in 6:1){
  w <- 7-j
  for(i in 1:6) rect(i-1, j-1, i, j, col = paintcolor[i+w-1])
}

HW6

set.seed(1314)

coin <- sample(c("H", "T"), 100, replace = TRUE)

coin.rle <- rle(coin)

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

HW7

## 將資料劃分成兩塊
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)))

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

## Warning: package 'bindrcpp' was built under R version 3.4.4

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