R scripts used in the 1st China R conference
# 参会单位 | |
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() |
# 读取博客数据 | |
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 |
This comment has been minimized.
This comment has been minimized.
正在从WP往Jekyll搬家,这是简历中的一份代码,现在我把这样的代码片段都贴到gist里面,方便维护:) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment
This comment has been minimized.
gangchen commentedFeb 7, 2012
然我回忆起了那次会议~~^_^