Question 2

#使用ifelse
Median<- function(x){
  x1<-x%>%sort()
  n<-length(x)
  ifelse(n/2==0,((x1[n/2]+x1[n/2+1])/2),x1[(n+1)/2])
}

Median(women$height)
## [1] 65

Question 3

new_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)))))
}

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

Question 4

#列出所有組合
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"
#修正code
new_nameCombo<-function(x) {
ll <- list()
for(i in 1:length(x)){
  k<- apply(combn(x,i), 2, list)
  new_ll<-lapply(k,unlist)
  ll <- c(ll,new_ll)
}
return(ll)
}

#test it
new_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"

Question 5

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)
for(j in 6:1){
  k<- 7-j
  for(i in 1:6) rect(i-1, j-1, i, j, col = my_cl[i+k-1])
}

Question 6

set.seed(94878787)
coin_sim<-sample(c("head", "tail"), 100, replace = TRUE)
coin_rle<-rle(coin_sim)
tapply(coin_rle$lengths,coin_rle$values,max)
## head tail 
##    5    5
sort(coin_rle$lengths,decreasing=TRUE) %>%table()%>%plot

Question 7

setwd("/Users/tayloryen/Desktop/大學/成大課業/大四下/資料管理/0416/HW")
library(data.table)
## 
## Attaching package: 'data.table'
## The following objects are masked from 'package:dplyr':
## 
##     between, first, last
library(tidyr)
## 
## Attaching package: 'tidyr'
## The following object is masked from 'package:Matrix':
## 
##     expand
library(knitr)
dta_odd<-fread("plasma_data.txt", fill = TRUE)[, 1:7]
dta_even<-fread("plasma_data.txt", fill = TRUE)[, 8:14] %>%na.omit
names(dta_odd)<-c(paste("week", c(1, 2, 6, 10, 14, 15, 16), sep = "."))
names(dta_even)<-c(paste("week", c(1, 2, 6, 10, 14, 15, 16), sep = "."))
#
dta_odd1 <- dta_odd %>% 
  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"))
## Warning: package 'bindrcpp' was built under R version 3.4.4
#
dta_even1<-dta_even %>% 
  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"))
#
dta_all<-rbind(dta_odd1,dta_even1) %>% 
          spread(variable, value) %>%
          select(-pre) %>%
          mutate(week = factor(week,level = c(1, 2, 6, 10, 14, 15, 16)),
                 patient = factor(patient)) %>%
          arrange(patient, week)

dta_all<-dta_all[c(1,2,7,6,11,10,5,9,8,4,3)]
dta_all[dta_all==-9]<-NA
kable(head(dta_all,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

The End