Created
February 7, 2012 02:43
-
-
Save yihui/1756790 to your computer and use it in GitHub Desktop.
R scripts used in the 1st China R conference
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
# 参会单位 | |
x = c(2, 1, 3, 2, 1, 1, 2, 2, 2, 3, 1, 2, 2, 2, 2, | |
1, 1, 1, 1, 4, 2, 2, 3, 1, 1, 2, 2, 2, 2, 3, 1, 1, 3, 1, | |
1, 1, 1, 1, 1, 2, 2, 1, 1, 3, 3, 3, 1, 2, 1, 2, 3, 1, 2, | |
1, 2, 1, 1, 1, 2, 2, 2, 1, 1, 1, 2, 1, 3, 1, 1, 1, 2, 2, | |
1, 1, 1, 1, 1, 3, 1, 1, 3, 1, 2, 1, 2, 1, 1, 2, 3, 2, 2, | |
2, 3, 1, 2, 2, 3, 2, 1, 3, 2, 1, 1, 1, 1, 2, 2, 1, 3, 3, | |
1, 1, 1, 2, 1, 2, 2, 1, 3, 2, 1, 1, 1, 1, 2, 2, 2, 2, 1, | |
2, 2) | |
# pdf("institute.pdf", width = 7, height = 3, family = "GB1") | |
par(mar = c(3.5, 3, 0.5, 0.1)) | |
barplot(table(x), names.arg = c("高校", "科研机构", | |
"公司企业", "出版社")) | |
# dev.off() | |
# 我的性别 | |
# pdf("gender.pdf", width = 4, height = 4) | |
par(mar = rep(0, 4)) | |
plot(1, type = "n") | |
text(1, 1, "\\MA", cex = 20, vfont = c("serif", "plain")) | |
# dev.off() | |
# 用R赶火车 | |
prb = replicate(100, { | |
x = sample(c(0, 5, 10), 1, prob = c(0.7, 0.2, 0.1)) | |
y = sample(c(28, 30, 32, 34), 1, prob = c(0.3, 0.4, 0.2, 0.1)) | |
plot(0:40, rep(1, 41), type = "n", xlab = "time", ylab = "", | |
axes = FALSE) | |
axis(1, 0:40) | |
r = rnorm(1, 30, 2) | |
points(x, 1, pch = 15) | |
i = 0 | |
while (i <= r) { | |
i = i + 1 | |
segments(x, 1, x + i, 1) | |
if (x + i >= y) | |
points(y, 1, pch = 19) | |
Sys.sleep(0.1) | |
} | |
points(y, 1, pch = 19) | |
title(ifelse(x + r <= y, "poor... missed the train!", "Bingo! catched the train!")) | |
Sys.sleep(4) | |
x + r > y | |
}) | |
# 用R定闹钟 | |
Sys.sleep(5) | |
replicate(10, {alarm(); Sys.sleep(0.2)}) | |
# 用R唱歌 | |
# Uwe Ligges | |
library(tuneR) | |
Wobj <- bind(sine(440, bit = 16), sine(220, bit = 16)) | |
play(Wobj) | |
# 用R跳舞 | |
# Yihui Xie | |
library(animation) | |
par(mar = c(3, 2.5, 1, 0.2), pch = 20, mgp = c(1.5, 0.5, 0)) | |
ani.options(nmax = 200, interval = 0.1) | |
buffon.needle(type = "S") | |
# 用R检验老年痴呆症 | |
alzheimer.test = function(char1 = c("9", "O", "M", | |
"己"), char2 = c("6", "C", "N", "已"), nr = 10, nc = 30, | |
seed = NULL, ...) { | |
cat("This is a REAL neurological test. Sit comfortably and be calm.\n\n") | |
mlen = max(length(char1), length(char2), length(nr), length(nc)) | |
char1 = rep(char1, length = mlen) | |
char2 = rep(char2, length = mlen) | |
nr = rep(nr, length = mlen) | |
nc = rep(nc, length = mlen) | |
if (!is.null(seed)) | |
set.seed(seed, ...) | |
tm1 = tm2 = ans = ans.u = ans.t = NULL | |
for (j in 1:mlen) { | |
x = rep(char1[j], nr[j] * nc[j]) | |
idx = sample(nr[j] * nc[j], 1) | |
x[idx] = char2[j] | |
mx = matrix(x, nr[j], nc[j]) | |
cat("\n\nTEST ", j, "\n") | |
writeLines(formatUL(c(paste("Find the \"", char2[j], | |
"\" below", sep = ""), "Do not use any cursor help"), | |
offset = 2)) | |
cat("\n") | |
m = menu(c("Ready, Go!", "Let me quit the test!")) | |
if (m == 0 | m == 2) { | |
j = j - 1 | |
break | |
} | |
tmp = Sys.time() | |
cat("\n") | |
cat(apply(mx, 1, paste, collapse = ""), sep = "\n") | |
cat("\nFind it now?\n") | |
m = menu(c("Yes! (Input the answer later)", "No... (See the answer later)")) | |
tm1 = c(tm1, as.numeric(difftime(Sys.time(), tmp, units = "secs"))) | |
ans.true = c(ifelse(idx%%nr[j] == 0, nr[j], idx%%nr[j]), | |
idx%/%nr[j] + 1) | |
tmp = Sys.time() | |
if (m == 0 | m == 2) { | |
cat("\nCharacter \"", char2[j], "\" is at [", ifelse(idx%%nr[j] == | |
0, nr[j], idx%%nr[j]), ", ", idx%/%nr[j] + 1, | |
"].\n\n\n", sep = "") | |
ans = c(ans, 3) | |
ans.user = c(NA, NA) | |
} | |
else { | |
cat("\nPlease input the Row number and Column number respectively\n when you find the character:\n") | |
ans.user = scan(nmax = 2) | |
if (length(ans.user) == 2 & is.numeric(ans.user)) { | |
ans = c(ans, as.integer(all(ans.user == ans.true))) | |
} | |
else ans = c(ans, 2) | |
if (ans[length(ans)] != 1) | |
cat("\nWrong answer! :( \nThe correct answer should be: ", | |
ans.true, "\n\n\n") | |
} | |
ans.u = rbind(ans.u, ans.user) | |
ans.t = rbind(ans.t, ans.true) | |
tm2 = c(tm2, as.numeric(difftime(Sys.time(), tmp, units = "secs"))) | |
if (j < mlen) { | |
for (i in 1:round(max(nc) * 1.5)) { | |
cat(" [Take a rest and continue the next test> ", | |
rep("-", i), ">\r", sep = "") | |
flush.console() | |
Sys.sleep(0.1) | |
} | |
} | |
else { | |
for (i in 1:round(max(nc) * 1.5)) { | |
cat(" [All tests are finished; see the results> ", | |
rep("-", i), ">\r", sep = "") | |
flush.console() | |
Sys.sleep(0.1) | |
} | |
} | |
} | |
} | |
x = alzheimer.test() |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
# 读取博客数据 | |
tmp = readLines("http://hi.baidu.com/cloud_wei/blog/item/b26cbfa9b8e601fa1e17a295.html") | |
start = grep("<div id=\"blog_text\" class=\"cnt\">", | |
tmp, fixed = T) | |
end = grep("</div>", tmp, fixed = T) | |
end = end[end > start][1] | |
x = tmp[start:end] | |
x = gsub("<br>", "", x) | |
x = gsub("<.*>", "", x) | |
con = textConnection(paste(x, collapse = "\n")) | |
dat = read.csv(con, strings = F) | |
dat[, 1] = gsub(" ", "", dat[, 1]) | |
close(con) | |
library(maps) | |
library(mapdata) | |
par(mar = c(2, 1.5, 1.5, 1.5), mgp = rep(0, 3), las = 1, | |
col.axis = "gray") | |
map("china", col = "darkgray", ylim = c(18, 54), panel.first = grid()) | |
points(dat$jd, dat$wd, pch = 19, col = rgb(0, 0, 0, | |
0.5)) | |
text(dat$jd, dat$wd, dat[, 1], cex = 0.9, col = rgb(0, | |
0, 0, 0.7), pos = c(2, 4, 4, 4, 3, 4, 2, 3, 4, 2, 4, 2, 2, | |
4, 3, 2, 1, 3, 1, 1, 2, 3, 2, 2, 1, 2, 4, 3, 1, 2, 2, 4, | |
4, 2)) | |
axis(1, lwd = 0) | |
axis(2, lwd = 0) | |
axis(3, lwd = 0) | |
axis(4, lwd = 0) | |
# 心意列联表 | |
xinyi = c("一", "二", "三", "四", "五") | |
n = length(xinyi) | |
tbl = matrix(nrow = n, ncol = n) | |
for (i in 1:n) { | |
for (j in 1:n) { | |
tmp = readLines(paste("http://www.google.com/search?ie=GB2312&oe=GB2312&q=\"", | |
xinyi[i], "心", xinyi[j], "意\"", sep = "")) | |
res = strsplit(tmp[2], "<b>")[[1]][5] | |
tbl[i, j] = as.integer(gsub(",", "", sub("<.*", "", res))) | |
} | |
} | |
tbl |
正在从WP往Jekyll搬家,这是简历中的一份代码,现在我把这样的代码片段都贴到gist里面,方便维护:)
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment
然我回忆起了那次会议~~^_^