HW5
U_76031019
1
Explain what the R script does and how.
此段code展示100次布朗運動的狀況，每次停留0.05秒。
這段code真的很炫！
可惜沒辦法在html展示。
2
Use lapply() and an anonymous function to find the coefficient of variation (the standard deviation divided by the mean) for all the test scores in the ‘hs0.txt’ data set.
hs0<-read.table("http://titan.ccunix.ccu.edu.tw/~psycfs/dataM/Data/hs0.txt",h=T)
lapply(hs0[,7:11], function(x) paste0(round(sd(x,na.rm = T)/mean(x,na.rm = T)*100,2),"%"))$read
[1] "19.63%"
$write
[1] "17.96%"
$math
[1] "17.8%"
$science
[1] "18.87%"
$socst
[1] "20.49%"3
split(hs0,hs0$schtyp)$private
id female race ses schtyp prog read write math
18 195 male white middle private general 57 57 60
28 178 male white middle private vocation 47 57 57
29 196 male white high private academic 44 38 49
33 192 male white high private academic 65 67 63
35 199 male white high private academic 52 59 50
37 200 male white middle private academic 68 54 75
41 176 male white middle private academic 47 47 41
42 177 male white middle private academic 55 59 62
49 189 male white middle private academic 47 59 63
54 183 male white middle private academic 63 59 49
59 185 male white middle private academic 63 57 55
61 181 male white middle private academic 50 46 45
65 197 male white high private academic 50 42 50
83 174 male white middle private academic 68 59 71
100 194 female white high private academic 63 63 69
109 54 female african-amer low private general 47 54 46
110 180 female white high private academic 71 65 69
115 34 female hispanic high private academic 73 61 57
121 35 female hispanic low private general 60 54 50
137 190 female white middle private academic 47 59 54
140 55 female african-amer middle private academic 52 49 49
146 191 female white high private academic 47 52 43
148 182 female white middle private academic 44 52 43
163 198 female white high private academic 47 61 51
169 186 female white middle private academic 57 62 63
182 193 female white middle private academic 44 49 48
189 188 female white high private academic 63 62 56
192 175 female white high private general 36 57 42
193 184 female white middle private vocation 50 52 53
195 179 female white middle private academic 47 65 60
196 31 female asian middle private general 55 59 52
198 187 female white middle private general 57 41 57
science socst
18 58 56
28 58 46
29 39 46
33 66 71
35 61 61
37 66 66
41 42 51
42 58 51
49 53 46
54 55 71
59 58 41
61 58 61
65 36 61
83 66 56
100 61 61
109 50 56
110 58 71
115 55 66
121 50 51
137 58 46
140 44 61
146 48 61
148 44 51
163 63 31
169 55 41
182 39 51
189 55 61
192 50 41
193 55 56
195 50 56
196 42 56
198 55 52
$public
id female race ses schtyp prog read write math science
1 70 male white low public general 57 52 41 47
2 121 female white middle public vocation 68 59 53 63
3 86 male white high public general 44 33 54 58
4 141 male white high public vocation 63 44 47 53
5 172 male white middle public academic 47 52 57 53
6 113 male white middle public academic 44 52 51 63
7 50 male african-amer middle public general 50 59 42 53
8 11 male hispanic middle public academic 34 46 45 39
9 84 male white middle public general 63 57 54 58
10 48 male african-amer middle public academic 57 55 52 NA
11 75 male white middle public vocation 60 46 51 53
12 60 male white middle public academic 57 65 51 63
13 95 male white high public academic 73 60 71 61
14 104 male white high public academic 54 63 57 55
15 38 male african-amer low public academic 45 57 50 31
16 115 male white low public general 42 49 43 50
17 76 male white high public academic 47 52 51 50
19 114 male white high public academic 68 65 62 NA
20 85 male white middle public general 55 39 57 53
21 167 male white middle public general 63 49 35 66
22 143 male white middle public vocation 63 63 75 72
23 41 male african-amer middle public academic 50 40 45 55
24 20 male hispanic high public academic 60 52 57 61
25 12 male hispanic middle public vocation 37 44 45 39
26 53 male african-amer middle public vocation 34 37 46 39
27 154 male white high public academic 65 65 66 61
30 29 male asian low public general 52 44 49 55
31 126 male white middle public general 42 31 57 47
32 103 male white high public academic 76 52 64 64
34 150 male white middle public vocation 42 41 57 72
36 144 male white high public general 60 65 58 61
38 80 male white high public academic 65 62 68 NA
39 16 male hispanic low public vocation 47 31 44 36
40 153 male white middle public vocation 39 31 40 39
43 168 male white middle public academic 52 54 57 55
44 40 male african-amer low public general 42 41 43 50
45 62 male white high public general 65 65 48 63
46 169 male white low public general 55 59 63 69
47 49 male african-amer high public vocation 50 40 39 49
48 136 male white middle public academic 65 59 70 63
50 7 male hispanic middle public academic 57 54 59 47
51 27 male asian middle public academic 53 61 61 57
52 128 male white high public academic 39 33 38 47
53 21 male hispanic middle public general 44 44 61 50
55 132 male white middle public academic 73 62 73 69
56 15 male hispanic high public vocation 39 39 44 NA
57 67 male white low public vocation 37 37 42 33
58 22 male hispanic middle public vocation 42 39 39 56
60 9 male hispanic middle public vocation 48 49 52 44
62 170 male white high public academic 47 62 61 69
63 134 male white low public general 44 44 39 34
64 108 male white middle public general 34 33 41 36
66 140 male white middle public vocation 44 41 40 50
67 171 male white middle public academic 60 54 60 55
68 107 male white low public vocation 47 39 47 42
69 81 male white low public academic 63 43 59 65
70 18 male hispanic middle public vocation 50 33 49 44
71 155 male white middle public general 44 44 46 39
72 97 male white high public academic 60 54 58 58
73 68 male white middle public academic 73 67 71 63
74 157 male white middle public general 68 59 58 74
75 56 male white middle public vocation 55 45 46 58
76 5 male hispanic low public academic 47 40 43 45
77 159 male white high public academic 55 61 54 NA
78 123 male white high public general 68 59 56 63
79 164 male white middle public vocation 31 36 46 39
80 14 male hispanic high public academic 47 41 54 42
81 127 male white high public academic 63 59 57 55
82 165 male white low public vocation 36 49 54 61
84 3 male hispanic low public academic 63 65 48 63
85 58 male white middle public vocation 55 41 40 44
86 146 male white high public academic 55 62 64 63
87 102 male white high public academic 52 41 51 53
88 117 male white high public vocation 34 49 39 42
89 133 male white middle public vocation 50 31 40 34
90 94 male white high public academic 55 49 61 61
91 24 male asian middle public academic 52 62 66 47
92 149 male white low public general 63 49 49 66
93 82 female white high public academic 68 62 65 69
94 8 female hispanic low public academic 39 44 52 44
95 129 female white low public general 44 44 46 47
96 173 female white low public general 50 62 61 63
97 57 female white middle public academic 71 65 72 66
98 100 female white high public academic 63 65 71 69
99 1 female hispanic low public vocation 34 44 40 39
101 88 female white high public academic 68 60 64 69
102 99 female white high public general 47 59 56 66
103 47 female african-amer low public academic 47 46 49 33
104 120 female white high public academic 63 52 54 50
105 166 female white middle public academic 52 59 53 61
106 65 female white middle public academic 55 54 66 42
107 101 female white high public academic 60 62 67 50
108 89 female white low public vocation 35 35 40 51
111 162 female white middle public vocation 57 52 40 61
112 4 female hispanic low public academic 44 50 41 39
113 131 female white high public academic 65 59 57 46
114 125 female white low public academic 68 65 58 59
116 106 female white middle public vocation 36 44 37 42
117 130 female white high public general 43 54 55 55
118 93 female white high public academic 73 67 62 58
119 163 female white low public academic 52 57 64 58
120 37 female african-amer low public vocation 41 47 40 39
122 87 female white middle public general 50 52 46 50
123 73 female white middle public academic 50 52 53 39
124 151 female white middle public vocation 47 46 52 48
125 44 female african-amer low public vocation 47 62 45 34
126 152 female white high public academic 55 57 56 58
127 105 female white middle public academic 50 41 45 44
128 28 female asian middle public general 39 53 54 50
129 91 female white high public vocation 50 49 56 47
130 45 female african-amer low public vocation 34 35 41 29
131 116 female white middle public academic 57 59 54 50
132 33 female asian low public academic 57 65 72 54
133 66 female white middle public vocation 68 62 56 50
134 72 female white middle public vocation 42 54 47 47
135 77 female white low public academic 61 59 49 44
136 61 female white high public academic 76 63 60 67
138 42 female african-amer middle public vocation 46 52 55 44
139 2 female hispanic middle public vocation 39 41 33 42
141 19 female hispanic low public general 28 46 43 44
142 90 female white high public academic 42 54 50 50
143 142 female white middle public vocation 47 42 52 39
144 17 female hispanic middle public academic 47 57 48 44
145 122 female white middle public academic 52 59 58 53
147 83 female white middle public vocation 50 62 41 55
149 6 female hispanic low public academic 47 41 46 40
150 46 female african-amer low public academic 45 55 44 34
151 43 female african-amer low public academic 47 37 43 42
152 96 female white high public academic 65 54 61 58
153 138 female white middle public vocation 43 57 40 50
154 10 female hispanic middle public general 47 54 49 53
155 71 female white middle public general 57 62 56 58
156 139 female white middle public academic 68 59 61 55
157 110 female white middle public vocation 52 55 50 54
158 148 female white middle public vocation 42 57 51 47
159 109 female white middle public general 42 39 42 42
160 39 female african-amer high public academic 66 67 67 61
161 147 female white low public academic 47 62 53 53
162 74 female white middle public academic 57 50 50 51
164 161 female white low public academic 57 62 72 61
165 112 female white middle public academic 52 59 48 55
166 69 female white low public vocation 44 44 40 40
167 156 female white middle public academic 50 59 53 61
168 111 female white low public general 39 54 39 47
170 98 female white low public vocation 57 60 51 53
171 119 female white low public general 42 57 45 50
172 13 female hispanic middle public vocation 47 46 39 47
173 51 female african-amer high public general 42 36 42 31
174 26 female asian high public academic 60 59 62 61
175 36 female african-amer low public general 44 49 44 35
176 135 female white low public academic 63 60 65 54
177 59 female white middle public academic 65 67 63 55
178 78 female white middle public academic 39 54 54 53
179 64 female white high public vocation 50 52 45 58
180 63 female white low public general 52 65 60 56
181 79 female white middle public academic 60 62 49 50
183 92 female white high public general 52 67 57 63
184 160 female white middle public academic 55 65 55 50
185 32 female asian high public vocation 50 67 66 66
186 23 female asian low public academic 65 65 64 58
187 158 female white middle public general 52 54 55 53
188 25 female asian middle public general 47 44 42 42
190 52 female african-amer low public academic 50 46 53 53
191 124 female white low public vocation 42 54 41 42
194 30 female asian high public academic 41 59 42 34
197 145 female white middle public vocation 42 46 38 36
199 118 female white middle public general 55 62 58 58
200 137 female white high public academic 63 65 65 53
socst
1 57
2 61
3 31
4 56
5 61
6 61
7 61
8 36
9 51
10 51
11 61
12 61
13 71
14 46
15 56
16 56
17 56
19 61
20 46
21 41
22 66
23 56
24 61
25 46
26 31
27 66
30 41
31 51
32 61
34 31
36 66
38 66
39 36
40 51
43 51
44 41
45 66
46 46
47 47
48 51
50 51
51 56
52 41
53 46
55 66
56 42
57 32
58 46
60 51
62 66
63 46
64 36
66 26
67 66
68 26
69 44
70 36
71 51
72 61
73 66
74 66
75 51
76 31
77 61
78 66
79 46
80 56
81 56
82 36
84 56
85 41
86 66
87 56
88 56
89 31
90 56
91 46
92 46
93 61
94 48
95 51
96 51
97 56
98 71
99 41
101 66
102 61
103 41
104 51
105 51
106 56
107 56
108 33
111 56
112 51
113 66
114 56
116 41
117 46
118 66
119 56
120 51
122 56
123 56
124 46
125 46
126 61
127 56
128 41
129 46
130 26
131 56
132 56
133 51
134 46
135 66
136 66
138 56
139 41
141 51
142 52
143 51
144 41
145 66
147 31
149 41
150 41
151 46
152 56
153 51
154 61
155 66
156 71
157 61
158 61
159 41
160 66
161 61
162 58
164 61
165 61
166 31
167 61
168 36
170 37
171 43
172 61
173 39
174 51
175 51
176 66
177 71
178 41
179 36
180 51
181 51
183 61
184 61
185 56
186 71
187 51
188 36
190 66
191 41
194 51
197 46
199 61
200 614
Produce a separate output of scatter plot of reading scores by writing scores for each ethnic groups using the high schools data example. The colors of plotting symbols should be different.
ggplot2::qplot(x=write,y=read,data=hs0,colour=race,facets=race~.)
5
Use the read and math variables from the high schools data example for this problem. First firgure out what this R script does and then eliminate the for loop in the code segment.
ANS: 此段code計算隨機排列read，並計算與math的correlation後，其值大於math與socst的correlation的比率(在1001次trial中)
dta.asian <- subset(hs0, race=="asian")
r0 <- cor(dta.asian$math, dta.asian$socst)
nIter <- 1001
mean(replicate(nIter,r0<=cor(sample(dta.asian$read), dta.asian$math)))[1] 0.031968036
Explain what the R script does and how.
ANS: 這個funciton會return各個name的組合，從1個至全選個，如果input的name是變項名稱的話，可以說return的東西是考慮各種interaction的saturated model的每個參數。
第一步，先將各自的name做成list的component，再做2:全部個的組合，同樣做為list的component並讓其由小到大排列。
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)
}
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"7
Construct an R function out of the code segments for the demonstration of the Central Limit Theorm in the lecture note.
ANS: 我寫了一個function，可調整疊代次數，抽樣個數以及標準差。
clt<-function(nIter=36,se=1,n=512){
count=1
plot(c(0, n), c(-3*se, 3*se), type="n", xlab="Sample size", ylab="Average", main="Runs of running averages")
while(count < nIter) {
lines(1:n, cumsum(rnorm(n))/1:n, col="skyblue")
count <- count + 1
#Sys.sleep(0.5)
}
lines(1:n, 1.96*(se/sqrt(1:n)), col="red")
lines(1:n, -1.96*(se/sqrt(1:n)), col="red")
abline(h=0, lty=2, col="red")
}
clt(300,1,1000)
8
Use R to simulate tossing a balanced coin 2^n times and compute the running proportion of heads.
n=1028
plot(c(0,log(n,2)),c(0,1),type="n",xlab="Number of Flips=2^n",ylab="Proportion Heads")
abline(h=0.5,lty=2)
j<-sample(c(T,F),n,rep=T)
lines(log(1:n,2),cumsum(j)/1:n)
9
The value of π can be estimated by 4 × the fraction of red dots in the graph below . Write a program in R to verify this.
tryest<-function(n){
x<-runif(n)
y<-runif(n)
4*mean(x^2+y^2<=1)
}
for (i in 1:7) print(c(i,tryest(10^i)))[1] 1.0 2.4
[1] 2.0 3.2
[1] 3.000 3.088
[1] 4.0000 3.1536
[1] 5.00000 3.14176
[1] 6.00000 3.13884
[1] 7.00000 3.14116par(pty = "s")
plot(c(0,1),c(0,1),type="n",xlab="x",ylab="y")
lines(cos(0:90*pi/180),sin(0:90*pi/180))
x<-runif(10^5)
y<-runif(10^5)
points(x[x^2+y^2<=1],y[x^2+y^2<=1],col="red",pch=".")
points(x[x^2+y^2>1],y[x^2+y^2>1],col="blue",pch=".")
10
Twelve hospital patients were measured on the following nine variables: plasma ascorbic acid, leucocyte ascorbic acid, whole blood ascorbic acid, thiamin status-tpp value, grip strength, red cell transketolase, reaction time, folate serum, folate red cell, at 1, 2, 6, 10, 14, 15, and 16 weeks. Missing value = -9. Write an R script to rearrange the data in the plasma (plain text) into the following long format: plasma (comma-delimited)
dir<-"http://titan.ccunix.ccu.edu.tw/~psycfs/dataM/Data/plasma.txt"
elem<-scan(dir,what=" ")
colnm<-c("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")
week<-c(1,2,6,10,14,15,16)
lisnm<-paste0("S",101:112)
ldta <- split(elem, rep(1:(length(elem)/63), each=63))
names(ldta)<-lisnm
ldta2<-lapply(seq_along(ldta),function(x,n) {cbind(n[[x]],week,matrix(ldta[[x]],7,9))},n=names(ldta))
res<-as.data.frame(do.call(rbind,ldta2))
res[res==-9]<-NA
colnames(res)<-colnm
write.csv(res,"test.csv",row.names = F)
head(read.csv("test.csv",h=T)) patient week plasma_ascorbic_acid leucocyte_ascorbic_acid
1 S101 1 22 46
2 S101 2 0 16
3 S101 6 103 37
4 S101 10 67 45
5 S101 14 75 29
6 S101 15 65 35
whole_blood_ascorbic_acid thiamin_status grip_strength
1 76 35 6
2 27 28 4
3 114 0 5
4 100 0 5
5 112 11 4
6 96 0 2
red_cell_transketolase reaction_time folate_serum folate_red_cell
1 984 38 104 NA
2 1595 29 67 NA
3 1984 39 24 375
4 1098 110 66 536
5 1727 59 50 542
6 1300 66 91 26011
The dataset UScrime{MASS} contains crime data for 47 states of the USA for 1960. Unfortunately, the state names are not recorded. The dataset USCrimes{TeachingDemos} contains crime data for the years 1960 through 2010 for all 50 states, Washington DC, and a total for the country. Use the information in the latter to recover the state names in the former in a new data frame.