hk0427_programming

# In-class exercises1 (unsolved)

##
ci_norm <- function(n=100, nci=50, nRun=3, level=0.95, pause=0.05) {
  ci <- NULL
  z0 = qnorm(1 - (1 - level)/2)
  for ( j in 1:nRun ) {
      zbar <- colMeans(replicate(nci, rnorm(n)))     
      zl <- zbar - z0 * 1/sqrt(n); zu <- zbar + z0 * 1/sqrt(n)
      plot(1, xlim = c(0.5, nci + 0.5), ylim = c(min(zl), max(zu)), 
           type = "n", xlab = "Sample ID", ylab = "Average") 
      abline(h = 0, lty = 2)
      for( i in 1:nci ) {
          arrows(i, zl[i], i, zu[i], length = 0.05, angle = 90, 
               code = 3,
               col = ifelse(0 > zl[i] & 0 < zu[i], "gray", "red"))
          points(i, zbar[i], pch = 19, col = "gray")
          Sys.sleep(pause)
      }
      Sys.sleep(3)
   }
}

##
ci_norm(n = 36, nci = 51, nRun = 2)

In-class exercises2

library(hrbrthemes)

## NOTE: Either Arial Narrow or Roboto Condensed fonts are required to use these themes.

##       Please use hrbrthemes::import_roboto_condensed() to install Roboto Condensed and

##       if Arial Narrow is not on your system, please see https://bit.ly/arialnarrow

library(tidyverse)

## -- Attaching packages --------------------------------------------------------------------------------------- tidyverse 1.3.0 --

## √ ggplot2 3.3.0     √ purrr   0.3.3
## √ tibble  2.1.3     √ dplyr   0.8.5
## √ tidyr   1.0.2     √ stringr 1.4.0
## √ readr   1.3.1     √ forcats 0.5.0

## -- Conflicts ------------------------------------------------------------------------------------------ tidyverse_conflicts() --
## x dplyr::filter() masks stats::filter()
## x dplyr::lag()    masks stats::lag()

update_geom_font_defaults(font_rc)

dta <- read.table("/Users/User/Desktop/DM_R/hk0511/hs0.txt", header=T , stringsAsFactor=F, fill=T )

dta.asian <- subset(dta, race=="asian")
#只選用race為asian的資料
r0 <- cor(dta.asian$math, dta.asian$socst)

#cnt項目次數為0
cnt <- 0
#nIter重複1001次
#將read資料隨機抽取後，再與math求相關係數
#算比例
nIter <- 1001
for (i in 1:nIter) {
    new <- sample(dta.asian$read)
    r <- cor(new, dta.asian$math)
    if ( r0 <= r ) cnt <- cnt+1
}
cnt/nIter

## [1] 0.04295704

#cnt項目次數為0
cnt <- 0
nIter <- 1001
i=1
while(i<=nIter){
  new<-sample(dta.asian$read)
  r<-cor(new,dta.asian$math)
  if (r0<=r) cnt <- cnt+1
  i=i+1
}
cnt/nIter

## [1] 0.03496503

#算Pearson's的"asian", "math"和"asian", "socst"相關
cor.test(dta[dta$race=="asian", "math"], dta[dta$race=="asian", "socst"])

## 
##  Pearson's product-moment correlation
## 
## data:  dta[dta$race == "asian", "math"] and dta[dta$race == "asian", "socst"]
## t = 1.9887, df = 9, p-value = 0.07796
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
##  -0.07083501  0.86552255
## sample estimates:
##       cor 
## 0.5525177

###以上參考 凱揚與慧娟同學

In-class exercises5

#
#
#
simSexHeight <- function(n)  {
   m <- matrix(c(runif(n), rnorm(n)), ncol=2)
   draw <- function(mr) {  # mr = one row of m
      if (mr[1] < 0.505) {
         sex <- 1
         cm <- 170 + 7*mr[2]
      } else {
         sex <- 0
         cm <- 160 + 5*mr[2] 
      }
      return(c(sex, cm))
   }
   person <- t(apply(m, 1, draw))
   person <- as.data.frame(person)
   person[, 1] <- ifelse(person[, 1]==1, "M", "F")
   names(person) <- c("Gender", "Height")
   return(person)
}
###

simSexHeight(20)

##    Gender   Height
## 1       F 157.1574
## 2       M 173.2550
## 3       M 151.1136
## 4       F 163.1146
## 5       M 156.7578
## 6       M 166.1228
## 7       M 177.5595
## 8       F 165.3231
## 9       F 170.4981
## 10      F 163.5158
## 11      F 161.3765
## 12      F 155.2836
## 13      F 166.5101
## 14      M 164.6762
## 15      M 175.9051
## 16      F 164.7333
## 17      F 159.0905
## 18      M 174.6103
## 19      M 169.4555
## 20      M 170.8732

simSexHeight <- function(n){
count<-sum(runif(n)<0.505)
data.frame(Gender=c(rep("M",count), rep("F", n-count)),
           Height=c(rnorm(count, 170, 7), rnorm(n-count, 160, 5))
           )}

simSexHeight(20)

##    Gender   Height
## 1       M 180.6595
## 2       M 180.6258
## 3       M 159.6260
## 4       M 177.4188
## 5       M 169.9176
## 6       M 171.7264
## 7       M 155.9087
## 8       M 168.3188
## 9       M 169.2623
## 10      F 154.7349
## 11      F 157.1179
## 12      F 158.6332
## 13      F 162.6570
## 14      F 155.1333
## 15      F 150.7868
## 16      F 161.1732
## 17      F 164.6259
## 18      F 162.1425
## 19      F 157.5254
## 20      F 157.2583