1070416HW

HW2

median minimizes sum of absolute deviation 老師的範例

cal_median <- function(x) {
 n <- length(x)
 h <- round((n+1)/2)
 m <- unique(apply(expand.grid(x[1:h], x[h:n]), 1, sum)/2)
 sad <- rep(NA, length(m))
 for( i in seq_along(m)) {
    sad[i] = sum(abs(x - m[i]))
 }
 ll <- length(which(sad == min(sad)))
 if( ll == 1)
  m[which(sad == min(sad))]
 else
  sort(m[which(sad == min(sad))])[(ll+1)/2]
}
# test it
cal_median(women$height)

## [1] 65

improve the code

cal_median_new <- function(x) {
 newn <- length(x)
 newx <- sort(x)
 if(newn/2==0)
   (newx[newn/2]+newx[newn/+1])/2
 else
   newx[(newn%/%2)+1]
}
# test it
cal_median_new(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)))))
}
  
# test it
riffle(1:10, 50:55)

##  [1]  1 50  2 51  3 52  4 53  5 54  6 55  7  8  9 10

HW4

依輸入函數的字元，找出所有可能的排列組合

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("A", "B", "C", "D"))

## [[1]]
## [1] "A"
## 
## [[2]]
## [1] "B"
## 
## [[3]]
## [1] "C"
## 
## [[4]]
## [1] "D"
## 
## [[5]]
## [1] "A" "B"
## 
## [[6]]
## [1] "A" "C"
## 
## [[7]]
## [1] "A" "D"
## 
## [[8]]
## [1] "B" "C"
## 
## [[9]]
## [1] "B" "D"
## 
## [[10]]
## [1] "C" "D"
## 
## [[11]]
## [1] "A" "B" "C"
## 
## [[12]]
## [1] "A" "B" "D"
## 
## [[13]]
## [1] "A" "C" "D"
## 
## [[14]]
## [1] "B" "C" "D"
## 
## [[15]]
## [1] "A" "B" "C" "D"

4選1，4選2(先固定前者，依序變動後者)，4選3，4選4

HW5

plot.new()
plot.window(xlim = c(0, 6), ylim = c(0, 6), asp = 1)#設定畫布有6X6格,比例為1
my_cl <- c("indianred", "orange", "yellow", "forestgreen", "dodgerblue",
           "violet", "purple")#設定顏色
c_num <- matrix(1:7, nrow = 6, ncol = 6)

## Warning in matrix(1:7, nrow = 6, ncol = 6): 資料長度 [7] 並非列數量 [6] 的
## 因數或倍數

c_num  #依序編上顏色代號

##      [,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

for(i in 1:6) {
  for(j in 1:6){
    color <- c_num[i, j]
    rect(i-1, j-1, i, j, col = my_cl[color])
  }
}#著色

HW6

set.seed(1070416)
coin <- sample(c("Heads", "Tails"), 100, replace = TRUE)
coin.rle <- rle(coin)
plot(prop.table(table(coin.rle$lengths)), 
     xlab = "run length",
     ylab = "probability")

HW7

library(data.table)
library(tidyverse)

## -- Attaching packages ------------------------------------------------------ tidyverse 1.2.1 --

## √ ggplot2 2.2.1     √ purrr   0.2.4
## √ tibble  1.4.2     √ dplyr   0.7.4
## √ tidyr   0.8.0     √ stringr 1.3.0
## √ readr   1.1.1     √ forcats 0.3.0

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

## -- Conflicts --------------------------------------------------------- tidyverse_conflicts() --
## x dplyr::between()   masks data.table::between()
## x dplyr::filter()    masks stats::filter()
## x dplyr::first()     masks data.table::first()
## x dplyr::lag()       masks stats::lag()
## x dplyr::last()      masks data.table::last()
## x purrr::transpose() masks data.table::transpose()

library(knitr)
dta_odd <- fread("plasma.txt", fill = TRUE)[, 1:7]#處理原始資料左半邊
names(dta_odd) <- c(paste("week", c(1, 2, 6, 10, 14, 15, 16), sep = "."))
#
dta_odd2 <- 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"))
#
dta_even <- fread("plasma.txt", fill = TRUE)[, 8:14] %>% na.omit #處理原始資料右半邊
names(dta_even) <- c(paste("week", c(1, 2, 6, 10, 14, 15, 16), sep = "."))
dta_even2 <- 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"))
#
dta7 <- read.csv("plasma.csv", header = TRUE)
new.dta <- rbind(dta_odd2, dta_even2) %>% 
  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