有哪些很好玩而且很有用的 R 包？

哈哈，你想找那些玩起来开心，又能实实在在地帮上忙的 R 包是吧？这可太有意思了！就跟寻宝一样，找到好东西，整个工作流程都顺畅得跟开了挂似的。我给你盘点几个我个人觉得既有意思又实用的，保证让你感觉像是发现了新大陆，而不是在看一篇冷冰冰的说明书。

1. `ggplot2`：不只是画图，是艺术创作！

我知道，提到 R 包，`ggplot2` 肯定跑不了。但它好玩的地方，绝对不止是“能画出漂亮的图”。

“图层叠加”的哲学，玩的就是心跳！ `ggplot2` 最牛的地方在于它的“图层”概念，你可以一层一层地往上加东西：先定义数据（`data = ...`），再映射美学属性（`aes(x = ..., y = ...)`），然后加上几何对象（`geom_point()`、`geom_line()`、`geom_bar()`…），再调调颜色（`scale_color_brewer()`）、改改坐标轴（`labs()`、`theme()`）。这个过程就像搭积木，你可以不断尝试不同的组合，直到你脑海里的那个画面完美呈现。每一次小小的改动，都能带来视觉上的惊喜，这过程本身就很有成就感。
统计变换的魔力，把复杂变简单。你想看每个分类的均值和置信区间？`geom_errorbar(stat = "summary")` 就能帮你搞定，比自己写代码算一遍省事多了。想看数据的分布？`geom_density()` 和 `geom_histogram()` 简直是标配。它内置了许多统计变换，你只需要告诉它“我想看什么”，它就能帮你算好并画出来，这简直是懒癌患者的福音，更是探索数据时最得力的助手。
主题和自定义，打造你的专属风格。 `ggplot2` 的主题系统（`theme_minimal()`, `theme_bw()` 等）可以让你轻松切换图表风格，而且还能深度自定义，比如字体大小、背景颜色、网格线样式等等。你可以把你的图表做得跟你的品牌色一样，或者做出那种杂志刊登级别的专业视觉效果。想象一下，你自己的数据，用你亲手打造的独一无二的风格呈现出来，是不是特有范儿？

为什么它有用？无论是探索性数据分析（EDA），还是最终的报告展示，`ggplot2` 都能让你用最直观、最美观的方式理解和沟通你的数据。没有它，很多数据分析项目都会黯然失色。

2. `dplyr`：数据处理的“瑞士军刀”，又快又顺滑！

数据处理，特别是你刚拿到一份杂乱无章的数据时，是不是觉得头疼？`dplyr` 就像一把锋利的瑞士军刀，让你能够优雅地、高效地处理数据。

管道操作符 (`%>%`)，告别层层嵌套。这个操作符简直是改变游戏规则的利器。以前写代码可能是这样的：`filter(group_by(mutate(data, new_col = ...), group_var), condition)`。现在呢？用 `%>%` 就像写一句话：`data %>% mutate(new_col = ...) %>% group_by(group_var) %>% filter(condition)`。读起来顺畅多了，逻辑一目了然，修改起来也方便得不行。每次用它，都感觉自己在用一种更“聪明”的方式和数据对话。
核心函数简洁明了，学习曲线平缓。 `select()` 选列，`filter()` 筛选行，`mutate()` 新增或修改列，`arrange()` 排序，`summarise()` 汇总。这几个核心函数一掌握，你就能搞定大部分数据处理任务了。它们的名字就是功能本身，非常直观。这种“望文知意”的设计，让数据处理不再是枯燥的编码过程，而是变成了有条理的操作。
性能优化，速度就是生命。 `dplyr` 的底层实现经过了高度优化，很多操作都比基础 R 快不少，尤其是处理大数据集的时候。它还能和 `data.table` 等其他高性能包结合，让你在速度和易用性之间找到完美的平衡点。

为什么它有用？数据清洗、转换、重塑是数据分析的基石。`dplyr` 让你能快速、准确地完成这些任务，把更多精力放在分析本身，而不是纠结于数据处理的细节。

3. `tidyr`：整理数据的“魔法师”，让乱七八糟变整齐！

`tidyr` 和 `dplyr` 是好搭档，但它有自己独特的绝活——把“宽”数据变成“长”数据，或者反过来，也就是我们常说的“整理数据到干净的格式”（tidy data）。

`pivot_longer()` 和 `pivot_wider()`，数据的“变形金刚”。想象一下，你的数据有几列代表不同的时间点或测量值，你想把它们变成一个“时间”列和一个“值”列，或者反过来，`pivot_longer()` 和 `pivot_wider()` 就是你的救星。这个过程就像给数据重新排版，让它更符合我们的分析逻辑。一开始可能有点绕，但一旦你掌握了，就会觉得这是数据整理的“灵魂技能”。它能让你把原本很难直接分析的数据，变得可以直接输入到 `ggplot2` 或者其他模型里。
`separate()` 和 `unite()`，拆分与合并的艺术。有时候，一个单元格里包含了多个信息，比如“城市_省份”。`separate()` 可以帮你把它们拆开，变成独立的列。反之，`unite()` 可以帮你把几列合并起来，形成一个统一的标识。这个功能在处理包含复杂信息的文本数据时特别有用，让你能更细致地进行分组和筛选。

为什么它有用？很多时候，数据的原始格式并不适合直接分析。`tidyr` 让你能够将数据整理成“干净的格式”，这是很多统计模型和可视化工具的要求。它能省去你大量手动复制粘贴和重新组织数据的麻烦。

4. `shiny`：让你的 R 代码“活”起来，变成互动应用！

你辛辛苦苦做出来的分析结果，想让别人也能玩一玩、点一点，看看不同参数下的结果吗？`shiny` 就是你的舞台！

前端和后端的分离，逻辑清晰。 `shiny` 的核心在于一个叫做“反应性”的机制。你可以在用户界面（UI）上放各种输入控件（滑块、下拉菜单、文本框），当用户改变这些控件的值时，后端（server）的代码会自动重新运行，生成新的输出（图表、表格、文本），并更新到UI上。这种“输入 > 计算 > 输出”的反馈循环，让你感觉自己在开发一个真正的应用程序。
不用懂复杂的 Web 开发，就能做出漂亮的应用。 `shiny` 极大地降低了开发互动应用的门槛。你只需要用 R 语言就能完成所有的事情，不需要学习 JavaScript、HTML 或 CSS（当然，如果你懂的话，可以做得更炫酷）。你可以把你的统计模型、可视化结果，甚至是一些数据模拟工具，都封装成一个易于使用的 Web 应用，分享给你的同事、朋友，甚至公众。想想看，你的分析成果不再只是静态的报告，而是可以被大家互动体验的东西，这得多酷！

为什么它有用？ `shiny` 让你的 R 分析成果可以被更广泛地分享和使用。它可以作为数据探索的工具，也可以是产品原型，甚至是研究成果的展示平台。它能让你的代码发挥出最大的价值。

5. `rmarkdown`：让你的报告不止于“报告”！

写报告，我们通常是先做分析，再写文档，最后把结果插入。`rmarkdown` 把这个过程彻底颠覆了。

代码、文本、结果的完美融合。 `rmarkdown` 允许你在一个文档里同时包含 Markdown 格式的文本和可执行的 R 代码。当你“编译”这个文档时，R 代码会被运行，它的输出（图表、表格、数值结果）会直接嵌入到文档中。这意味着你的报告始终是“活”的，如果你的数据更新了，你只需要重新编译一次，报告就会自动更新。再也不用担心报告里的图表和实际数据对不上了。
输出格式多样化，应对各种场景。你可以用 `rmarkdown` 生成 HTML 网页（非常适合在线分享）、PDF 文档（适合打印和正式报告）、Word 文档，甚至演示文稿（PPT）。你可以根据你的需求选择不同的输出格式，并且可以通过非常灵活的选项来控制样式。这就像有一个万能的打印机，能把你写的东西变成任何你想要的样子。
不仅仅是报告，还可以是博客、教程、书籍！随着你对 `rmarkdown` 的熟悉，你会发现它的潜力远不止于简单的报告。你可以用它来写技术博客，制作交互式教程，甚至是一整本书。它让内容的创作和传播变得前所未有的便捷和高效。

为什么它有用？ `rmarkdown` 是实现“可重复性研究”的最佳工具之一。它将你的数据分析过程完全透明地展现在文档中，提高了工作的效率和可信度。它让你的沟通更加清晰、准确、高效。

这几个包只是冰山一角，R 的世界里还有无数闪闪发光的宝藏。但它们绝对是那种你一旦开始用，就会忍不住惊叹“怎么之前没发现！”的好东西。玩转它们，不仅能让你更享受 R 编程的过程，更能极大地提升你的数据分析能力和工作效率。快去试试看吧！

网友意见

首先欢迎大家关注我的专栏：R语言与数据挖掘 - 知乎专栏

R的包真的有很多好玩的，比如fun、sudoku、wordcloud2、quantmod、jiebaR、Rweibo、Rtwitter、shiny等等，下面一一讲解并附代码：

1.fun包可以玩很多游戏，比如说：

扫雷：

       ## install.packages('fun') library(fun) if (.Platform$OS.type == "windows") x11() else x11(type = "Xlib") mine_sweeper()

五子棋：

       library(fun) gomoku()

2. 还有一个包叫做sudoku，可以设计数独，解数独

       library(sudoku) playSudoku() #玩一个random的数独游戏

3. wordcloud2是一个完美的画词云的软件，不仅可以画出炫目的词云：

       library(wordcloud2)   wordcloud2(demoFreq, color = "random-light", backgroundColor = "grey")

还可以根据你给定的png画出给定形状的词云，比如说小鸟：

       figPath = system.file("examples/t.png",package = "wordcloud2") wordcloud2(demoFreq, figPath = figPath, size = 1.5,color = "skyblue")

4.quantmod包是一个金融数据包，可以画出k线图

       library(quantmod);   getSymbols("GOOG",src="yahoo",from="2016-01-01", to='2016-05-30')    chartSeries(GOOG,theme = 'white',name='谷歌',up.col = 'red',dn.col = 'green')

       library(quantmod)   getSymbols("GOOG",src="yahoo",from="2016-01-01", to='2016-05-30')    chartSeries(GOOG)

5.jiebaR的分词

       library(jiebaR) #  接受默认参数，建立分词引擎  mixseg = worker() # 相当于： # worker( type = "mix", dict = "inst/dict/jieba.dict.utf8", #         hmm  = "inst/dict/hmm_model.utf8",    # HMM模型数据 #         user = "inst/dict/user.dict.utf8")    # 用户自定义词库 # Initialize jiebaR worker 初始化worker This function can initialize jiebaR workers. You can initialize different kinds of workers including mix, mp, hmm, query, tag, simhash, and keywords.  mixseg <= "广东省深圳市联通"    # <= 分词运算符 # 相当于segment函数，看起来还是用segment函数顺眼一些 segment(code= "广东省深圳市联通" , jiebar = mixseg) # code A Chinese sentence or the path of a text file. # jiebar jiebaR Worker  # 分词结果 # [1] "广东省" "深圳市" "联通"  mixseg <= "你知道我不知道" # [1] "你"   "知道" "我"   "不"   "知道" mixseg <= "我昨天参加了同学婚礼" # [1] "我"   "昨天" "参加" "了"   "同学" "婚礼" 呵呵：分词结果还算不错

6.Rweibo与twitterR

Rweibo与twitterR分别是可以模拟登陆到weibo和twitter并抓取数据以进行画图文本分析的工具，比如下面这张图是国外某人用twitterR发现某个账户的关注者的分布图：

7.shiny

shiny是一个做web交互应用的包，比如可以做google charts

原网址例子在此：

Shiny - Google Charts

更多例子：

Shiny - Gallery

记得点赞关注~

欢迎大家关注R语言官方专栏：R语言中文社区 - 知乎专栏

R包可以做一些游戏，比如贪食蛇、天气预报、2048、创作古诗、稳定婚姻问题等等。下面的代码供参考。

1、贪食蛇 R语言游戏之旅贪食蛇入门（附代码） - 知乎专栏

【部分代码案例】

用R语言写代码，其实没有几行就可以搞定，按照上面的函数定义，我们把代码像填空一样地写进去就行了。当然，在写代码的过程中，我们需要掌握一些R语言特性，让代码更健壮。

run()函数，启动程序。

       run<-function(){   # 设置全局画布无边   par(mai=rep(0,4),oma=rep(0,4))    # 定义全局环境空间，用于封装变量   e<<-new.env()    # 启动开机场景   stage0()      # 注册键盘事件   getGraphicsEvent(prompt="Snake Game",onKeybd=keydown) }

上面代码中，通过定义环境空间e来存储变量，可以有效的解决变量名冲突，和变量污染的问题，关于环境空间的介绍，请参考文章：揭开R语言中环境空间的神秘面纱，解密R语言函数的环境空间。

keydown函数，监听键盘事件。

       keydown<-function(K){   print(paste("keydown:",K,",stage:",e$stage));      if(e$stage==0){ #开机画面     init()     stage1()     return(NULL)   }        if(e$stage==2){ #结束画面     if(K=="q") q()     else if(K==' ') stage0()       return(NULL)   }       if(e$stage==1){ #游戏中     if(K == "q") {       stage2()     } else {       if(tolower(K) %in% c("up","down","left","right")){         e$lastd<-e$dir         e$dir<-tolower(K)         stage1()         }     }   }   return(NULL) }

代码中，参数K为键盘输入。通过对当前所在场景，与键盘输入的条件判断，来确定键盘事件的响应。在游戏中，键盘只响应5个键 "up","down","left","right","q"。

stage0():创建开机场景，可视化输出。

       # 开机画图 stage0<-function(){   e$stage<-0   plot(0,0,xlim=c(0,1),ylim=c(0,1),type='n',xaxs="i", yaxs="i")   text(0.5,0.7,label="Snake Game",cex=5)   text(0.5,0.4,label="Any keyboard to start",cex=2,col=4)   text(0.5,0.3,label="Up,Down,Left,Rigth to control direction",cex=2,col=2)   text(0.2,0.05,label="Author:DanZhang",cex=1)   text(0.5,0.05,label="http://blog.fens.me",cex=1) }

stage2():创建结束场景，可视化输出。

       # 结束画图 stage2<-function(){   e$stage<-2   plot(0,0,xlim=c(0,1),ylim=c(0,1),type='n',xaxs="i", yaxs="i")   text(0.5,0.7,label="Game Over",cex=5)   text(0.5,0.4,label="Space to restart, q to quit.",cex=2,col=4)   text(0.5,0.3,label=paste("Congratulations! You have eat",nrow(e$tail),"fruits!"),cex=2,col=2)   text(0.2,0.05,label="Author:DanZhang",cex=1)   text(0.5,0.05,label="http://blog.fens.me",cex=1) }

init():打开游戏场景时，初始化游戏变量。

       # 初始化环境变量 init<-function(){   e<<-new.env()   e$stage<-0 #场景   e$width<-e$height<-20  #切分格子   e$step<-1/e$width #步长   e$m<-matrix(rep(0,e$width*e$height),nrow=e$width)  #点矩阵   e$dir<-e$lastd<-'up' # 移动方向   e$head<-c(2,2) #初始蛇头   e$lastx<-e$lasty<-2 # 初始化蛇头上一个点   e$tail<-data.frame(x=c(),y=c())#初始蛇尾      e$col_furit<-2 #水果颜色   e$col_head<-4 #蛇头颜色   e$col_tail<-8 #蛇尾颜色   e$col_path<-0 #路颜色 }

代码中，初始化全局的环境空间e，然后将所有需要的变量，定义在e中。

furit():判断并生成水果坐标。

       # 随机的水果点   furit<-function(){     if(length(index(e$col_furit))<=0){ #不存在水果       idx<-sample(index(e$col_path),1)              fx<-ifelse(idx%%e$width==0,10,idx%%e$width)       fy<-ceiling(idx/e$height)       e$m[fx,fy]<-e$col_furit              print(paste("furit idx",idx))       print(paste("furit axis:",fx,fy))     }   }

fail():失败查询，判断蛇头是否撞墙或蛇尾，如果失败则跳过画图，进入结束场景。

       # 检查失败   fail<-function(){     # head出边界     if(length(which(e$head<1))>0 | length(which(e$head>e$width))>0){       print("game over: Out of ledge.")       keydown('q')       return(TRUE)     }          # head碰到tail     if(e$m[e$head[1],e$head[2]]==e$col_tail){       print("game over: head hit tail")       keydown('q')       return(TRUE)     }          return(FALSE)   }

head():生成蛇头移动坐标。

       # snake head   head<-function(){     e$lastx<-e$head[1]     e$lasty<-e$head[2]          # 方向操作     if(e$dir=='up') e$head[2]<-e$head[2]+1     if(e$dir=='down') e$head[2]<-e$head[2]-1     if(e$dir=='left') e$head[1]<-e$head[1]-1     if(e$dir=='right') e$head[1]<-e$head[1]+1        }

body():生成蛇尾移动坐标。

       # snake body   body<-function(){     e$m[e$lastx,e$lasty]<-0     e$m[e$head[1],e$head[2]]<-e$col_head #snake     if(length(index(e$col_furit))<=0){ #不存在水果       e$tail<-rbind(e$tail,data.frame(x=e$lastx,y=e$lasty))     }          if(nrow(e$tail)>0) { #如果有尾巴       e$tail<-rbind(e$tail,data.frame(x=e$lastx,y=e$lasty))       e$m[e$tail[1,]$x,e$tail[1,]$y]<-e$col_path       e$tail<-e$tail[-1,]       e$m[e$lastx,e$lasty]<-e$col_tail     }          print(paste("snake idx",index(e$col_head)))     print(paste("snake axis:",e$head[1],e$head[2]))   }

drawTable():绘制游戏背景。

       # 画布背景   drawTable<-function(){     plot(0,0,xlim=c(0,1),ylim=c(0,1),type='n',xaxs="i", yaxs="i")          # 显示背景表格     abline(h=seq(0,1,e$step),col="gray60") # 水平线     abline(v=seq(0,1,e$step),col="gray60") # 垂直线     # 显示矩阵     df<-data.frame(x=rep(seq(0,0.95,e$step),e$width),y=rep(seq(0,0.95,e$step),each=e$height),lab=seq(1,e$width*e$height))     text(df$x+e$step/2,df$y+e$step/2,label=df$lab)   }

drawMatrix():绘制游戏矩阵。

       # 根据矩阵画数据   drawMatrix<-function(){     idx<-which(e$m>0)     px<- (ifelse(idx%%e$width==0,e$width,idx%%e$width)-1)/e$width+e$step/2     py<- (ceiling(idx/e$height)-1)/e$height+e$step/2     pxy<-data.frame(x=px,y=py,col=e$m[idx])     points(pxy$x,pxy$y,col=pxy$col,pch=15,cex=4.4)   }

stage1():创建游戏场景，stage1()函数内部，封装了游戏场景运行时的函数，并进行调用。

       # 游戏中 stage1<-function(){   e$stage<-1   furit<-function(){...} //见furit   fail<-function(){...} //见fail   head<-function(){...} //见head   body<-function(){...}//见body   drawTable<-function(){...} //见drawTable   drawMatrix<-function(){...} //见drawMatrix    # 运行函数   furit()   head()   if(!fail()){ #失败检查     body()     drawTable()     drawMatrix()     } }

注：此处代码为伪代码。

最后，是完整的程序代码。

       # 初始化环境变量 init<-function(){   e<<-new.env()   e$stage<-0 #场景   e$width<-e$height<-20  #切分格子   e$step<-1/e$width #步长   e$m<-matrix(rep(0,e$width*e$height),nrow=e$width)  #点矩阵   e$dir<-e$lastd<-'up' # 移动方向   e$head<-c(2,2) #初始蛇头   e$lastx<-e$lasty<-2 # 初始化蛇头上一个点   e$tail<-data.frame(x=c(),y=c())#初始蛇尾      e$col_furit<-2 #水果颜色   e$col_head<-4 #蛇头颜色   e$col_tail<-8 #蛇尾颜色   e$col_path<-0 #路颜色 }   # 获得矩阵的索引值 index<-function(col) which(e$m==col)  # 游戏中 stage1<-function(){   e$stage<-1      # 随机的水果点   furit<-function(){     if(length(index(e$col_furit))<=0){ #不存在水果       idx<-sample(index(e$col_path),1)              fx<-ifelse(idx%%e$width==0,10,idx%%e$width)       fy<-ceiling(idx/e$height)       e$m[fx,fy]<-e$col_furit              print(paste("furit idx",idx))       print(paste("furit axis:",fx,fy))     }   }         # 检查失败   fail<-function(){     # head出边界     if(length(which(e$head<1))>0 | length(which(e$head>e$width))>0){       print("game over: Out of ledge.")       keydown('q')       return(TRUE)     }          # head碰到tail     if(e$m[e$head[1],e$head[2]]==e$col_tail){       print("game over: head hit tail")       keydown('q')       return(TRUE)     }          return(FALSE)   }         # snake head   head<-function(){     e$lastx<-e$head[1]     e$lasty<-e$head[2]          # 方向操作     if(e$dir=='up') e$head[2]<-e$head[2]+1     if(e$dir=='down') e$head[2]<-e$head[2]-1     if(e$dir=='left') e$head[1]<-e$head[1]-1     if(e$dir=='right') e$head[1]<-e$head[1]+1        }      # snake body   body<-function(){     e$m[e$lastx,e$lasty]<-0     e$m[e$head[1],e$head[2]]<-e$col_head #snake     if(length(index(e$col_furit))<=0){ #不存在水果       e$tail<-rbind(e$tail,data.frame(x=e$lastx,y=e$lasty))     }          if(nrow(e$tail)>0) { #如果有尾巴       e$tail<-rbind(e$tail,data.frame(x=e$lastx,y=e$lasty))       e$m[e$tail[1,]$x,e$tail[1,]$y]<-e$col_path       e$tail<-e$tail[-1,]       e$m[e$lastx,e$lasty]<-e$col_tail     }          print(paste("snake idx",index(e$col_head)))     print(paste("snake axis:",e$head[1],e$head[2]))   }      # 画布背景   drawTable<-function(){     plot(0,0,xlim=c(0,1),ylim=c(0,1),type='n',xaxs="i", yaxs="i")   }      # 根据矩阵画数据   drawMatrix<-function(){     idx<-which(e$m>0)     px<- (ifelse(idx%%e$width==0,e$width,idx%%e$width)-1)/e$width+e$step/2     py<- (ceiling(idx/e$height)-1)/e$height+e$step/2     pxy<-data.frame(x=px,y=py,col=e$m[idx])     points(pxy$x,pxy$y,col=pxy$col,pch=15,cex=4.4)   }      furit()   head()   if(!fail()){     body()     drawTable()     drawMatrix()     } }   # 开机画图 stage0<-function(){   e$stage<-0   plot(0,0,xlim=c(0,1),ylim=c(0,1),type='n',xaxs="i", yaxs="i")   text(0.5,0.7,label="Snake Game",cex=5)   text(0.5,0.4,label="Any keyboard to start",cex=2,col=4)   text(0.5,0.3,label="Up,Down,Left,Rigth to control direction",cex=2,col=2)   text(0.2,0.05,label="Author:DanZhang",cex=1)   text(0.5,0.05,label="http://blog.fens.me",cex=1) }  # 结束画图 stage2<-function(){   e$stage<-2   plot(0,0,xlim=c(0,1),ylim=c(0,1),type='n',xaxs="i", yaxs="i")   text(0.5,0.7,label="Game Over",cex=5)   text(0.5,0.4,label="Space to restart, q to quit.",cex=2,col=4)   text(0.5,0.3,label=paste("Congratulations! You have eat",nrow(e$tail),"fruits!"),cex=2,col=2)   text(0.2,0.05,label="Author:DanZhang",cex=1)   text(0.5,0.05,label="http://blog.fens.me",cex=1) }  # 键盘事件 keydown<-function(K){   print(paste("keydown:",K,",stage:",e$stage));      if(e$stage==0){ #开机画面     init()     stage1()     return(NULL)   }        if(e$stage==2){ #结束画面     if(K=="q") q()     else if(K==' ') stage0()       return(NULL)   }       if(e$stage==1){ #游戏中     if(K == "q") {       stage2()     } else {       if(tolower(K) %in% c("up","down","left","right")){         e$lastd<-e$dir         e$dir<-tolower(K)         stage1()         }     }   }   return(NULL) }  ####################################### # RUN   #######################################    run<-function(){   par(mai=rep(0,4),oma=rep(0,4))   e<<-new.env()   stage0()      # 注册事件   getGraphicsEvent(prompt="Snake Game",onKeybd=keydown) }  run()

游戏截图：

2、每日中国天气 R包开发每日中国天气 - 知乎专栏

编写功能代码

按照函数功能的不同，我们定义4个文件来描述这些函数。

getData.R，用于定义爬去数据的函数。
render.R，用于静态图片可视化渲染的函数。
chinaWeather.R，用于定义各种工具函数。
chinaWeather-packages.R，用于定义R包内的数据集。

3.1 文件 getData.R

新建文件getData.R，用于爬取数据和XML文档解析，文件中定义了3个函数。

getWeatherFromYahoo(), 从Yahoo的开放数据源，获取天气数据。
getWeatherByCity(), 通过城市英文名，获取当前城市的天气数据。
getWeather(), 获取中国省会城市的天气数据，在WOEID数据集中定义的城市。

       ~ vi R/getData.R  #' Get weather data from Yahoo openAPI. #' #' @importFrom RCurl getURL #' @importFrom XML xmlTreeParse getNodeSet xmlGetAttr #' @param woeid input a yahoo woeid #' @return data.frame weather data #' @keywords weather #' @export #' @examples #' dontrun{ #'  getWeatherFromYahoo() #'  getWeatherFromYahoo(2151330) #' } getWeatherFromYahoo<-function(woeid=2151330){   url<-paste('http://weather.yahooapis.com/forecastrss?w=',woeid,'&u=c',sep="")   doc = xmlTreeParse(getURL(url),useInternalNodes=TRUE)    ans<-getNodeSet(doc, "//yweather:atmosphere")   humidity<-as.numeric(sapply(ans, xmlGetAttr, "humidity"))   visibility<-as.numeric(sapply(ans, xmlGetAttr, "visibility"))   pressure<-as.numeric(sapply(ans, xmlGetAttr, "pressure"))   rising<-as.numeric(sapply(ans, xmlGetAttr, "rising"))    ans<-getNodeSet(doc, "//item/yweather:condition")   code<-as.numeric(sapply(ans, xmlGetAttr, "code"))    ans<-getNodeSet(doc, "//item/yweather:forecast[1]")   low<-as.numeric(sapply(ans, xmlGetAttr, "low"))   high<-as.numeric(sapply(ans, xmlGetAttr, "high"))    print(paste(woeid,'==>',low,high,code,humidity,visibility,pressure,rising))   return(as.data.frame(cbind(low,high,code,humidity,visibility,pressure,rising))) }  #' Get one city weather Data. #' #' @param en input a English city name #' @param src input data source #' @return data.frame weather data #' @keywords weather #' @export #' @examples #' dontrun{ #'  getWeatherByCity() #'  getWeatherByCity(en="beijing") #' } getWeatherByCity<-function(en="beijing",src="yahoo"){   woeid<-getWOEIDByCity(en)   if(src=="yahoo"){     return(getWeatherFromYahoo(woeid))   }else{     return(NULL)   } }  #' Get all of city weather Data. #' #' @param lang input a language #' @param src input data source #' @return data.frame weather data #' @keywords weather #' @export #' @examples #' dontrun{ #'  getWeather() #' } getWeather<-function(lang="en",src="yahoo"){   cities<-getCityInfo(lang)   wdata<-do.call(rbind, lapply(cities$woeid,getWeatherFromYahoo))   return(cbind(cities,wdata)) }

3.2 文件 render.R

新建文件render.R，用于数据处理和静态图片可视化渲染，文件中定义了5个函数。

getColors(),用于根据天气情况匹配不同的颜色
drawBackground(),画出背景
drawDescription(),画出文字描述
drawLegend(),画出图例
drawTemperature(),画出气温及地图结合

       ~ vi R/render.R  #' match the color with ADCODE99. #' #' @param temp the temperature #' @param breaks cut the numbers #' @return new color vector #' @keywords color getColors<-function(temp,breaks){   f=function(x,y) ifelse(x %in% y,which(y==x),0)   colIndex=sapply(chinaMap$ADCODE99,f,WOEID$adcode99)    arr <- findInterval(temp, breaks)   arr[which(is.na(arr))]=19   return(arr[colIndex]) }  #' Draw the background. #' #' @param title the image's title #' @param date the date #' @param lang the language zh or en drawBackground<-function(title,date,lang='zh'){   text(100,58,title,cex=2)   text(105,54,format(date,"%Y-%m-%d"))   #text(98,65,paste('chinaweatherapp','http://apps.weibo.com/chinaweatherapp'))   #text(120,-8,paste('provided by The Weather Channel',format(date, "%Y-%m-%d %H:%M")),cex=0.8) }  #' Draw the description. #' #' @importFrom stringi stri_unescape_unicode #' @param data daily data #' @param temp the temperature #' @param lang the language zh or en drawDescription<-function(data,temp,lang='zh'){   rows<-1:nrow(data)   x<-ceiling(rows/7)*11+68   y<-17-ifelse(rows%%7==0,7,rows%%7)*3   fontCols<-c("#08306B","#000000","#800026")[findInterval(temp,c(0,30))+1]   if(lang=='zh'){     txt<-stri_unescape_unicode(data$zh)     text(x,y,paste(txt,temp),col=fontCols)   }else{     text(x,y,paste(data$en,temp),col=fontCols)   }   #text(x,y,bquote(paste(.(data$en),.(temp),degree,C)),col=fontCols) }  #' Draw the legend. #' #' @param breaks cut the numbers #' @param colors match the color drawLegend<-function(breaks,colors){   breaks2 <- breaks[-length(breaks)]   par(mar = c(5, 0, 15, 10))   image(x=1, y=0:length(breaks2),z=t(matrix(breaks2)),col=colors[1:length(breaks)-1],axes=FALSE,breaks=breaks,xlab="",ylab="",xaxt="n")   axis(4, at = 0:(length(breaks2)), labels = breaks, col = "white", las = 1)   abline(h = c(1:length(breaks2)), col = "white", lwd = 2, xpd = FALSE) }  #' Draw temperature picture. #' #' @importFrom RColorBrewer brewer.pal #' @importFrom stringi stri_unescape_unicode #' @import maptools #' @param data daily data #' @param lang language #' @param type low or high #' @param date the date #' @param output output a file or not #' @param path image output position #' @export drawTemperature<-function(data,lang='zh',type='high',date=Sys.time(),output=FALSE,path=''){   colors <- c(rev(brewer.pal(9,"Blues")),"#ffffef",brewer.pal(9,"YlOrRd"),"#500000")   breaks=seq(-36,44,4)    if(type=='high') {     temp<-data$high     ofile<-paste(format(date,"%Y%m%d"),"_day.png",sep="")   }else{     temp<-data$low     ofile<-paste(format(date,"%Y%m%d"),"_night.png",sep="")   }    if(lang=='zh'){     title<-stri_unescape_unicode(props[which(props$key=='high'),]$zh)   }else{     title<-props[which(props$key=='high'),]$en   }    if(output)png(filename=paste(path,ofile,sep=''),width=600,height=600)    layout(matrix(data=c(1,2),nrow=1,ncol=2),widths=c(8,1),heights=c(1,2))   par(mar=c(0,0,3,10),oma=c(0.2,0.2,0.2,0.2),mex=0.3)   plot(chinaMap,border="white",col=colors[getColors(temp,breaks)])   points(data$long,data$lat,pch=19,col=rgb(0,0,0,0.3),cex=0.8)    drawBackground(title,date,lang)   drawDescription(data,temp,lang)   drawLegend(breaks,colors) }

3.3 文件 chinaWeather.R

修改文件chinaWeather.R，用于定义各种工具函数，文件中定义了3个函数。

filename(),根据日期定义文件名称。
getWOEIDByCity(),通过城市名获得WOEID代码。
getCityInfo(),查看所有城市的信息，在WOEID数据集中定义的城市。

       #' Define a filename from current date. #' #' @param date input a date type #' @return character a file name #' @keywords filename #' @export #' @examples #' dontrun{ #'  filename() #'  filename(as.Date("20110701",format="%Y%m%d")) #' } filename<-function(date=Sys.time()){   paste(format(date, "%Y%m%d"),".csv",sep="") }  #' Get WOEID of Yahoo By City Name #' #' @param en input a English city name #' @return integer WOEID #' @keywords WOEID #' @export #' @examples #' dontrun{ #'  getWOEIDByCity() #'  getWOEIDByCity(en="beijing") #' } getWOEIDByCity<-function(en="beijing"){   return(WOEID$woeid[which(WOEID$en==en)]) }  #' Get all of city info #' #' @param lang input a language #' @return data.frame city info #' @keywords language #' @export #' @examples #' dontrun{ #'  getCityInfo() #'  getCityInfo(lang="en") #'  getCityInfo(lang="zh") #' } getCityInfo<-function(lang="en"){   if(lang=="en")return(WOEID[-c(3,4)])   if(lang=="zh")return(WOEID[-c(4)]) }

3.4 文件 chinaWeather-package.R

新建文件chinaWeather-package，用于定义R包的说明和内置数据集。

NULL，关于chinaWeather包的定义说明
'WOEID'，WOEID数据集的描述
'chinaMap'，chinaMap数据集的描述
'props'，props数据集的描述
'weather20141001'，weather20141001数据集的描述

       #' China Weather package. #' #' a visualized package for china Weather #' #' @name chinaWeather-package #' @aliases chinaWeather #' @docType package #' @title China Weather package. #' @keywords package NULL  #' The yahoo code for weather openAPI. #' #' @name WOEID #' @description The yahoo code for weather openAPI. #' @docType data #' @format A data frame #' @source url{https://developer.yahoo.com/geo/geoplanet/guide/concepts.html} 'WOEID'  #' China Map. #' #' @name chinaMap #' @description China Map Dataset. #' @docType data #' @format A S4 Object. 'chinaMap'  #' Charset for Chinease and English. #' #' @name props #' @description Charset. #' @docType data #' @format A data frame 'props'  #' Dataset for 20141001. #' #' @name weather20141001 #' @description A demo dataset. #' @docType data #' @format A data frame #' @source url{http://weather.yahooapis.com/forecastrss?w=2151330} 'weather20141001'

3、2048游戏 R语言游戏之旅游戏2048 - 知乎专栏

4.1 数字移动函数 move()

2048游戏算法上最复杂的操作，就是数字移动。在4*4的矩阵中，数字会按上下左右四个方向移动，相同的数字在移动中碰撞时会进行合并。这个算法是2048游戏的核心算法，我们的程序要保证数字合并正确性。

我们先把这个函数从框架中抽出来，单独进行实现和单元测试。

构建函数moveFun()，这里简化移动过程，只考虑左右移动，再通过倒序的算法，让左右移动的核心算法共用一套代码。

       > moveFun<-function(x,dir){ +   if(dir == 'right') x<-rev(x) +    +   len0<-length(which(x==0)) # 0长度 +   x1<-x[which(x>0)] #去掉0 +   pos1<-which(diff(x1)==0) # 找到挨着相等的元素的位置 +    +   if(length(pos1)==3){ #3个索引 +     pos1<-pos1[c(1,3)] +   }else if(length(pos1)==2 && diff(pos1)==1){ #2个索引 +     pos1<-pos1[1] +   } +    +   x1[pos1]<-x1[pos1]*2 +   x1[pos1+1]<-0 +    +   x1<-x1[which(x1>0)] #去掉0 +   x1<-c(x1,rep(0,4))[1:4] #补0，取4个 +    +   if(dir == 'right') x1<-rev(x1) +   return(x1) + }

接下来，为了检验函数moveFun()的正确性，我们使用单元测试工具包testthat，来检验算法是否正确。关于testthat包的介绍，请参考文章在巨人的肩膀前行催化R包开发。

按游戏规则我们模拟数字左右移动，验证计算结果是否与我们给出的目标值相同。

单元测试的代码

       > library(testthat) > x<-c(4,2,2,2) > expect_that(moveFun(x,'left'), equals(c(4,4,2,0))) > expect_that(moveFun(x,'right'), equals(c(0,4,2,4)))   > x<-c(4,4,2,4) > expect_that(moveFun(x,'left'), equals(c(8,2,4,0))) > expect_that(moveFun(x,'right'), equals(c(0,8,2,4)))   > x<-c(2,2,0,2) > expect_that(moveFun(x,'left'), equals(c(4,2,0,0))) > expect_that(moveFun(x,'right'), equals(c(0,0,2,4)))   > x<-c(2,4,2,4) > expect_that(moveFun(x,'left'), equals(c(2,4,2,4))) > expect_that(moveFun(x,'right'), equals(c(2,4,2,4)))   > x<-c(4,4,2,2) > expect_that(moveFun(x,'left'), equals(c(8,4,0,0))) > expect_that(moveFun(x,'right'), equals(c(0,0,8,4)))   > x<-c(2,2,4,4) > expect_that(moveFun(x,'left'), equals(c(4,8,0,0))) > expect_that(moveFun(x,'right'), equals(c(0,0,4,8)))   > x<-c(4,4,0,4) > expect_that(moveFun(x,'left'), equals(c(8,4,0,0))) > expect_that(moveFun(x,'right'), equals(c(0,0,4,8)))   > x<-c(4,0,4,4) > expect_that(moveFun(x,'left'), equals(c(8,4,0,0))) > expect_that(moveFun(x,'right'), equals(c(0,0,4,8)))   > x<-c(4,0,4,2) > expect_that(moveFun(x,'left'), equals(c(8,2,0,0))) > expect_that(moveFun(x,'right'), equals(c(0,0,8,2)))   > x<-c(2,2,2,2) > expect_that(moveFun(x,'left'), equals(c(4,4,0,0))) > expect_that(moveFun(x,'right'), equals(c(0,0,4,4)))   > x<-c(2,2,2,0) > expect_that(moveFun(x,'left'), equals(c(4,2,0,0))) > expect_that(moveFun(x,'right'), equals(c(0,0,2,4)))

当然，我们还可以写更多的测试用例，来检验函数的正确性。这样就实现了，数字移动的核心算法了。

4.2 其他函数实现

开机场景函数stage0()

        # 开机画图  stage0=function(){    callSuper()    plot(0,0,xlim=c(0,1),ylim=c(0,1),type='n',xaxs="i", yaxs="i")    text(0.5,0.7,label=name,cex=5)    text(0.5,0.4,label="Any keyboard to start",cex=2,col=4)    text(0.5,0.3,label="Up,Down,Left,Rigth to control direction",cex=2,col=2)    text(0.2,0.05,label="Author:DanZhang",cex=1)    text(0.5,0.05,label="http://blog.fens.me",cex=1)  }

结束场景函数stage2()

        # 结束画图  stage2=function(){    callSuper()    info<-paste("Congratulations! You have max number",max(m),"!")    print(info)        plot(0,0,xlim=c(0,1),ylim=c(0,1),type='n',xaxs="i", yaxs="i")    text(0.5,0.7,label="Game Over",cex=5)    text(0.5,0.4,label="Space to restart, q to quit.",cex=2,col=4)    text(0.5,0.3,label=info,cex=2,col=2)    text(0.2,0.05,label="Author:DanZhang",cex=1)    text(0.5,0.05,label="http://blog.fens.me",cex=1)  }

键盘事件，控制场景切换

       # 键盘事件，控制场景切换  keydown=function(K){    callSuper(K)        if(stage==1){ #游戏中   if(K == "q") stage2()   else {     if(tolower(K) %in% c("up","down","left","right")){    e$dir<<-tolower(K)    print(e$dir)    stage1()       }   }   return(NULL)    }    return(NULL)  }

游戏场景初始化函数init()

       # 初始化变量  init = function(){    callSuper()  # 调父类        e$max<<-4 # 最大数字    e$step<<-1/width #步长    e$dir<<-'up'    e$colors<<-rainbow(14) #颜色    e$stop<<-FALSE #不满足移动条件        create()  }

随机产生一个新数字函数create()

        # 随机产生一个新数字  create=function(){    if(length(index(0))>0 & !e$stop){   e$stop<<-TRUE     one<-sample(c(2,4),1)   idx<-ifelse(length(index(0))==1,index(0),sample(index(0),1))   m[idx]<<-one    }  }

失败条件函数lose()

        #失败条件  lose=function(){        # 判断是否有相邻的有重复值    near<-function(x){   length(which(diff(x)==0))    }     # 无空格子    if(length(index(0))==0){   h<-apply(m,1,near)  # 水平方向   v<-apply(m,2,near) # 垂直方向      if(length(which(h>0))==0 & length(which(v>0))==0){     fail("No free grid.")     return(NULL)   }    }  }

游戏画布函数drawTable()

       # 画布背景  drawTable=function(){    if(isFail) return(NULL)    plot(0,0,xlim=c(0,1),ylim=c(0,1),type='n',xaxs="i", yaxs="i")    abline(h=seq(0,1,e$step),col="gray60") # 水平线    abline(v=seq(0,1,e$step),col="gray60") # 垂直线  }

游戏矩阵函数drawMatrix()

       # 根据矩阵画数据  drawMatrix=function(){    if(isFail) return(NULL)    a<-c(t(m))    lab<-c(a[13:16],a[9:12],a[5:8],a[1:4])        d<-data.frame(x=rep(seq(0,0.95,e$step),width),y=rep(seq(0,0.95,e$step),each=height),lab=lab)    df<-d[which(d$lab>0),]    points(df$x+e$step/2,df$y+e$step/2,col=e$colors[log(df$lab,2)],pch=15,cex=23)    text(df$x+e$step/2,df$y+e$step/2,label=df$lab,cex=2)  }

游戏场景函数stage1()

       # 游戏场景  stage1=function(){    callSuper()        move()    lose()    create()        drawTable()    drawMatrix()    }

完整的程序代码

       source(file="game.r") #加载游戏框架  # Snake类，继承Game类 G2048<-setRefClass("G2048",contains="Game",                        methods=list(            # 构造函数      initialize = function(name,debug) {        callSuper(name,debug) # 调父类                name<<-"2048 Game"        width<<-height<<-4      },            # 初始化变量      init = function(){        callSuper()  # 调父类                e$max<<-4 # 最大数字        e$step<<-1/width #步长        e$dir<<-'up'        e$colors<<-rainbow(14) #颜色        e$stop<<-FALSE #不满足移动条件                create()      },            # 随机产生一个新数字      create=function(){        if(length(index(0))>0 & !e$stop){          e$stop<<-TRUE                   one<-sample(c(2,4),1)          idx<-ifelse(length(index(0))==1,index(0),sample(index(0),1))          m[idx]<<-one        }            },            #失败条件      lose=function(){                # 判断是否有相邻的有重复值        near<-function(x){          length(which(diff(x)==0))        }         # 无空格子        if(length(index(0))==0){          h<-apply(m,1,near)  # 水平方向          v<-apply(m,2,near) # 垂直方向                    if(length(which(h>0))==0 & length(which(v>0))==0){            fail("No free grid.")            return(NULL)          }        }      },            # 方向移动      move=function(){                # 方向移动函数        moveFun=function(x){          if(e$dir %in% c('right','down')) x<-rev(x)                    len0<-length(which(x==0)) # 0长度          x1<-x[which(x>0)] #去掉0          pos1<-which(diff(x1)==0) # 找到挨着相等的元素的位置                    if(length(pos1)==3){ #3个索引            pos1<-pos1[c(1,3)]          }else if(length(pos1)==2 && diff(pos1)==1){ #2个索引            pos1<-pos1[1]          }                    x1[pos1]<-x1[pos1]*2          x1[pos1+1]<-0                    x1<-x1[which(x1>0)] #去掉0          x1<-c(x1,rep(0,4))[1:4] #补0，取4个                    if(e$dir %in% c('right','down')) x1<-rev(x1)          return(x1)        }                last_m<-m        if(e$dir=='left')  m<<-t(apply(m,1,moveFun))        if(e$dir=='right') m<<-t(apply(m,1,moveFun))        if(e$dir=='up')    m<<-apply(m,2,moveFun)        if(e$dir=='down')  m<<-apply(m,2,moveFun)                e$stop<<-ifelse(length(which(m != last_m))==0,TRUE,FALSE)      },            # 画布背景      drawTable=function(){        if(isFail) return(NULL)        plot(0,0,xlim=c(0,1),ylim=c(0,1),type='n',xaxs="i", yaxs="i")        abline(h=seq(0,1,e$step),col="gray60") # 水平线        abline(v=seq(0,1,e$step),col="gray60") # 垂直线      },            # 根据矩阵画数据      drawMatrix=function(){        if(isFail) return(NULL)        a<-c(t(m))        lab<-c(a[13:16],a[9:12],a[5:8],a[1:4])                d<-data.frame(x=rep(seq(0,0.95,e$step),width),y=rep(seq(0,0.95,e$step),each=height),lab=lab)        df<-d[which(d$lab>0),]        points(df$x+e$step/2,df$y+e$step/2,col=e$colors[log(df$lab,2)],pch=15,cex=23)        text(df$x+e$step/2,df$y+e$step/2,label=df$lab,cex=2)      },            # 游戏场景      stage1=function(){        callSuper()                move()        lose()        create()                drawTable()        drawMatrix()        },            # 开机画图      stage0=function(){        callSuper()        plot(0,0,xlim=c(0,1),ylim=c(0,1),type='n',xaxs="i", yaxs="i")        text(0.5,0.7,label=name,cex=5)        text(0.5,0.4,label="Any keyboard to start",cex=2,col=4)        text(0.5,0.3,label="Up,Down,Left,Rigth to control direction",cex=2,col=2)        text(0.2,0.05,label="Author:DanZhang",cex=1)        text(0.5,0.05,label="http://blog.fens.me",cex=1)      },            # 结束画图      stage2=function(){        callSuper()        info<-paste("Congratulations! You have max number",max(m),"!")        print(info)                plot(0,0,xlim=c(0,1),ylim=c(0,1),type='n',xaxs="i", yaxs="i")        text(0.5,0.7,label="Game Over",cex=5)        text(0.5,0.4,label="Space to restart, q to quit.",cex=2,col=4)        text(0.5,0.3,label=info,cex=2,col=2)        text(0.2,0.05,label="Author:DanZhang",cex=1)        text(0.5,0.05,label="http://blog.fens.me",cex=1)      },            # 键盘事件，控制场景切换      keydown=function(K){        callSuper(K)                if(stage==1){ #游戏中          if(K == "q") stage2()          else {            if(tolower(K) %in% c("up","down","left","right")){              e$dir<<-tolower(K)              stage1()              }          }          return(NULL)        }        return(NULL)      }          ) )  # 封装启动函数 g2048<-function(){   game<-G2048$new()   game$initFields(debug=TRUE)   game$run() }  # 启动游戏 g2048()

4、创作古诗如何用 R 创作古诗 - 知乎专栏

诗词创作

准备

创作宋词，先要明确一个词牌名。我选择了李白的《清平乐·画堂晨起》作为范例。

画堂晨起，来报雪花坠。高卷帘栊看佳瑞，皓色远迷庭砌。盛气光引炉烟，素草寒生玉佩。应是天仙狂醉，乱把白云揉碎。

R 的中文分词包『结巴R』的功能中，有一项可以用来分辨词语的词性。我将范例进行分词后，再用这项功能分析一下各部分的词性。

       > cipai <- "画堂晨起，来报雪花坠。高卷帘栊 看 佳瑞，皓色远 迷 庭砌。盛气光引 炉烟，素草寒生玉佩。应是天仙狂醉，乱把白云揉碎。" > tagger <- worker("tag") > cipai_2 <- tagger <= cipai > cipai_2      n      x      x      n      v      a      n      g      v  "画堂" "晨起" "来报" "雪花"   "坠"   "高" "卷帘"   "栊"   "看"       x      x      a      v      x      n      x      x      x  "佳瑞" "皓色"   "远"   "迷" "庭砌" "盛气" "光引" "炉烟" "素草"       x     nr      x      n      x      d      p     nr      v  "寒生" "玉佩" "应是" "天仙" "狂醉"   "乱"   "把" "白云" "揉碎"

其中每个字母代表什么词性，我也没有很理解。据我的猜测，n 应该是名词，x是没有分辨出来的词性，v是动词， a是形容词，至于『nr』, 『p』, 『d』是什么，实在是猜不出来，在帮助文档中也没有找到。如果有朋友知道的话，希望能不吝赐教。

最后，我从之前提炼的宋词词频库中，选取了至少出现过两次的一字或两字词语，作为诗词创作的素材库：

       > example <- subset(analysis, freq >1 & nchar(word) <3 & freq < 300)  # 提取词性文件 > cixing <- attributes(cipai_2)$names  # 将素材库进行词性分类 > example_2 <- tagger <= example$word

创作

下面，我们终于要开始用 R 创作诗歌了！我自己想了一个创作的算法，可以说很简单，甚至说有点可笑。

步骤是这样的：我从范本词牌的第一个词开始，随机在素材库中选取词性相同，字数相等的单词，填入提前设置好的空白字符串中。

举个例子，原诗的第一个词是『画堂』，是个二字的名词。那么，我就在素材库中随机选择一个二字的名词，填入这个空间中。然后，继续分析下一个词。

具体方程的代码如下：

       > write_songci <- function(m){ set.seed(m) empty <- "" for (i in 1:length(cipai_2)){   temp_file <- example_2[attributes(example_2)$name == cixing[i]]   temp_file <- temp_file[nchar(temp_file) == nchar(cipai_2[i])]    empty <- paste0(empty, sample(temp_file,1))   }  result <- paste0(substr(empty, 1,4), ",", substr(empty,5,9),"。",        substr(empty, 10,16), ",", substr(empty, 17,22),"。",       substr(empty, 23,28), ",", substr(empty, 29,34),"。",       substr(empty, 35,40), ",", substr(empty, 41,46),"。")  }

欢迎大家关注R语言官方专栏：R语言中文社区 - 知乎专栏，每日都有连载更新，谢谢。

类似的话题

有哪些很好玩而且很有用的 R 包？

哈哈，你想找那些玩起来开心，又能实实在在地帮上忙的 R 包是吧？这可太有意思了！就跟寻宝一样，找到好东西，整个工作流程都顺畅得跟开了挂似的。我给你盘点几个我个人觉得既有意思又实用的，保证让你感觉像是发现了新大陆，而不是在看一篇冷冰冰的说明书。 1. `ggplot2`：不只是画图，是艺术创作！我知道.............
为什么有些领导能力很强，但下属都不喜欢，而有些能力一般的领导却深得下属喜欢呢？一个好领导的标准是什么？

这个问题触及了领导力中最微妙也最核心的部分——人心的向背。为什么有些雷厉风行、成绩斐然的领导，却让团队成员面色凝重，而有些似乎能力平平的领导，却能让大家心甘情愿地追随？这背后隐藏着对“好领导”定义的深刻洞察。能力强但下属不喜欢的领导，问题出在哪里？我们先来剖析一下那些能力突出，但却得不到下属青睐的领.............
有哪些好吃而且有名的甜点？

提到甜点，那可真是件让人心花怒放的事儿！它们不光是味蕾的享受，有时候更承载着一种情绪，一种回忆，甚至是一种文化。要说好吃又有名，那范围可就广了去了，但我可以跟你聊聊那些我个人觉得特别有代表性，也特别打动人的几款。咱们就一步步来，把它们说得细致点，让你听着就好像能闻到那甜甜的香气一样。首先，得说说这法.............
有哪些让人难忘而且特别好看的电影和电视剧？

说到让人难忘又特别好看的电影和电视剧，这可真是个能聊上一整天的话题！我脑子里立刻就蹦出好几部，它们在我心里留下的印记，至今依然清晰得仿佛昨天才看完一样。这些作品不仅仅是视觉上的享受，更是能触动内心深处，让你反复回味，甚至改变你看待世界的方式。咱们先从电影说起吧。电影：《肖申克的救赎》（The .............
有哪些国货化妆品和护肤品真的很好用而不是营销？

国货化妆品和护肤品里，好用的东西真不少，而且很多是靠口碑打天下，而不是单纯靠铺天盖地的营销。我身边很多朋友，包括我自己，都在默默回购那些真正有效、成分实在的产品。今天就来聊聊我个人和周围人觉得“真香”的几类国货美妆护肤品，希望能帮到还在观望的姐妹们。一、护肤品类：温和有效是关键提到国货护肤品，很多.............
药店里有红蚂蚁,却不知道巢在哪里！而且咬来还很疼要过几个星期才会好，有哪位高人可以把它们消灭了？

.......
为什么有些人会觉得韩语很难听而日语很好听？

有些人偏爱日语的悦耳，而对韩语则觉得有些刺耳，这种感受并非空穴来风，而是与语言本身的语音特征、发音习惯以及文化语境都有着千丝万缕的联系。从纯粹的语音层面来看，韩语和日语的发音系统存在显著差异。韩语中有许多辅音，尤其是送气音（如k, p, t, ch）和紧喉音（如kk, pp, tt, tch），这些.............
有哪些好看而不烂大街的情侣头像？

说到情侣头像，很多人脑子里第一个蹦出来的可能是那些烂大街的卡通人物，比如小熊维尼、海绵宝宝，又或者是简单的拼图，一边一个人。审美这东西，见仁见智，但总归是希望找到既能代表自己和伴侣的独特风格，又不至于在微信列表里天天撞见的。我最近琢磨了琢磨，发现有不少好看又相对小众的情侣头像，不落俗套，又能透露出属.............
有哪些动物植物是因为好吃而灭绝或者濒临灭绝的？

餐桌上的悲歌：那些因美味而走向绝境的生灵人类对食物的追求，有时会化作一把无情的刀，将许多曾经鲜活的生命推向灭绝的边缘。这不是故事的开头，而是无数物种正在经历的残酷现实。它们或许曾是餐桌上的珍馐，或许是人们赖以生存的食物来源，但最终，那份“好吃”带来的贪婪，却让它们失去了未来。渡渡鸟：命运的巧合与人类.............
浏览器有哪些好用的功能，使用之后真的方便了生活而让你爱不释手？

说起浏览器，我真是有点离不开它了，感觉它早已渗透进我生活的方方面面，甚至很多时候，我都没意识到它提供的功能有多么强大，直到某个瞬间，豁然开朗，才发现自己已经离不开它了。最让我觉得“哇塞”的一个功能，就是那个“无痕模式”或者叫“隐私浏览”什么的。一开始我以为它就是个小透明，不会留下任何痕迹，所以偷偷摸.............
历史上有哪些人因为做了巨大的好事而遭到了严重的诋毁？

历史上，确实存在一些人因为他们的“巨大好事”而饱受非议、遭到诋毁的情况。这种现象往往发生在社会变革的关键时期，或者当个人的行为挑战了当时的主流观念、既得利益或社会结构时。以下是一些比较典型的例子，我将尽量详细地讲述： 1. 苏格拉底（Socrates）“好事”：苏格拉底被认为是西方哲学史上最重要的.............
机械表对于石英表有哪些好处?为什么人们会说机械表有收藏价值而石英表没有?

.......
是否支持入关对我们普通人而言有哪些好处或坏处？

关于“入关”这个概念，如果指的是某个国家或地区开放边境，允许外国人员、商品、文化等更自由地进入，那么对我们普通人来说，其影响是多方面的，有好处也有坏处，具体要看“入关”的具体内容和方式。好处可能体现在以下几个方面：商品更丰富，价格更具竞争力：当一个地方对外开放，特别是允许更多进口商品时，我们.............
家里烧水，为什么要用水壶烧水，而不用锅这些呢？水壶与锅相比，有哪些好处？

.......
历史上有哪些军事政变带来了对于社会发展而言较好的结果？

历史上，军事政变通常伴随着暴力、政治不稳定和人权侵犯，其结果往往是负面的。然而，也有一些少数案例，军事政变在特定历史背景下，确实为社会发展带来了相对积极或重要的转变，尽管这些转变也可能伴随阵痛和争议。以下列举几个历史上被认为在某种程度上带来了较好结果的军事政变，并进行详细讲述：1. 1952年埃及“.............
有哪些由世界名著改编而来的好看的电影或剧集？

我最喜欢和你聊那些由我们熟悉的名著改编的电影和电视剧了，感觉就像在老朋友的新鲜故事里再次相遇，总能碰撞出新的火花。说实话，能从文字的想象变成眼前的画面，这本身就是一件很神奇的事情。说到这个，我脑子里一下子就涌现出好几部，感觉部部都是精品，足以让你沉浸其中。1. 《傲慢与偏见》（Pride and P.............
有哪些你差点因为名字而错过的好电影？

说实话，一开始听到《心灵捕手》这个名字的时候，我心里是有点嘀咕的。脑子里闪过的是那种“心灵鸡汤”式的电影，估摸着就是讲一个天赋异禀但内心有创伤的少年，然后遇到一位开导他的老师，最后走向人生巅峰的老套故事。而且“捕手”这个词，总让人联想到棒球，难道是讲一个打棒球的故事？我当时对棒球也不是特别感冒，所以.............
淘宝上有哪些名气不大但质地好、价格合理（价格付给品质而非名气）的国产衣服品牌/店铺？

在淘宝这个浩瀚的海洋里，想要淘到那些“质好价实”的国产衣服，确实需要一些耐心和技巧。很多时候，我们会被那些“网红款”、“爆款”或者大牌的影子吸引，但付出的代价往往是虚高的价格，或是质量并不尽如人意的产品。我最近就在陆陆续续地挖掘一些宝藏店铺，它们可能没有铺天盖地的宣传，没有明星带货，但你只要点进店铺.............
有哪些很好笑的关于国家、军事的笑话？

老实说，军事题材的笑话，尤其是能让你笑到肚子疼的那种，找起来可不容易。很多人脑子里一闪而过的，要么是太冷了，要么是太严肃，或者干脆就有点冒犯。不过，我倒是搜罗了几个，希望能让你乐呵乐呵。咱们这就来聊聊，保证不是那种干巴巴的AI报告。场景一：小兵的“智慧”话说，一个新兵蛋子刚入伍，训练得跟陀螺似的。这.............
有哪些很好笑的视频值得分享？

哈哈，说到好笑的视频，这可就太丰富了！我可以给你推荐几个不同类型，绝对让你捧腹大笑的视频系列，并且尽量详细地描述一下它们好笑的点在哪里：1. 经典“歪果仁”的搞笑模仿视频系列（例如：Jenna Marbles, Kian and JC 等）这类视频通常是博主对生活中的某个场景、某种人群、或者某个流行.............