这周公司组织了电影赏析,看的电影是《狗十三》。我之前并没有看过这部电影,就想着先去豆瓣上看一下评论。这电影的评论还不少,有好几百条,完全可以全爬下来,分析一下。拉到页面下面,点击后页,url就会跟着变化(start=那里),说明这也不是啥动态网页,完全可以写个循环,用rvest包一页一页的爬。但实际爬取的时候,遇到了问题,就是未登陆的状态下,只能爬前220条评论。我搜索了一下模拟登录的办法,似乎是成功了,但后续该怎么弄,我就不知道了。我在这里卡了一天,没想到解决办法。昨天早上躺在被窝里,突然想到,我之前研究了下用RSelenium爬取动态网页,这里我完全可以先用RSelenium模拟登录,然后把网页当成动态网页爬啊。试了一下,成功了,下面就是相关的操作过程。 首先还是载入需要用的包,要使用RSelenium包,还要先进行一些配置,具体内容可以看RSelenium包的官方网站(这网站好像需要科学上网): library(tidyverse) library(RSelenium) library(rvest) library(jiebaR) library(wordcloud2) library(knitr) 接下来跟Selenium Server进行连接,这里我用的是Chrome浏览器(变量名rd本应该在第一行,不知道为什么跑到下边去了……): rd <- remoteDriver( remoteServerAddr = "localhost", port = 4444L, browserName = "chrome" ) 然后模拟打开豆瓣电影的登录页面,输入用户名和密码,点击登录按键,就可以登录了: rd$open() rd$navigate('https://www.douban.com/accounts/login?source=movie') we <- rd$findElement(using = 'xpath', '//*[@id="email"]') we$sendKeysToElement(list('用户名')) we <- rd$findElement(using = 'xpath', '//*[@id="password"]') we$sendKeysToElement(list('密码')) we <- rd$findElement(using = 'xpath', '//*[@id="lzform"]/div[6]/input') we$clickElement() 如果没接触过爬虫的,看着上面的代码可能有点懵,但实际上没啥太玄奥的东西。RSelenium包中的函数名就明白显示了它是干什么的,而参数中的那些xpath,在Chrome浏览器中都是可以直接复制出来的。 后面就可以开始爬虫了。我只爬了评价星级、短评时间、有帮助次数和短评文本四项信息。需要说明的是,有些用户虽然写了短评,但不会打分,这种情况下,我认为的将其评价星级定位“无评价”。因为不打分也会影响后面内容的xpath,所以那部分用了一些if条件。另外,虽然不知道会不会用上,在每页的内容爬取完之后,我也会让程序随机休息几秒,省得被轻易地认定为是爬虫程序。 rd$navigate('https://movie.douban.com/subject/25716096/comments?start=0&limit=20&sort=new_score&status=P') dog13 <- tibble() for (i in 1:50) { rank <- character(0) time <- character(0) help <- character(0) text <- character(0) temp <- tibble() for (j in 1:20) { xpath_rank <- str_c('//*[@id="comments"]/div[', j, ']/div[2]/h3/span[2]/span[2]') we <- rd$findElement(using = 'xpath', xpath_rank) rank[j] <- ifelse(str_length(we$getElementAttribute('title') %>% unlist()) > 2, '无评价', we$getElementAttribute('title') %>% unlist()) if (str_length(we$getElementAttribute('title') %>% unlist()) < 3) { xpath_time <- str_c('//*[@id="comments"]/div[', j, ']/div[2]/h3/span[2]/span[3]') we <- rd$findElement(using = 'xpath', xpath_time) time[j] <- we$getElementText() %>% unlist() } else { xpath_time <- str_c('//*[@id="comments"]/div[', j, ']/div[2]/h3/span[2]/span[2]') we <- rd$findElement(using = 'xpath', xpath_time) time[j] <- we$getElementText() %>% unlist() } xpath_help <- str_c('//*[@id="comments"]/div[', j, ']/div[2]/h3/span[1]/span') we <- rd$findElement(using = 'xpath', xpath_help) help[j] <- we$getElementText() %>% unlist() xpath_text <- str_c('//*[@id="comments"]/div[', j, ']/div[2]/p/span') we <- rd$findElement(using = 'xpath', xpath_text) text[j] <- we$getElementText() %>% unlist() df <- tibble(rank, time, help, text) } dog13 <- bind_rows(dog13, df) rest <- sample(1:10, 1) if (i < 2) { we <- rd$findElement(using = 'xpath', '//*[@id="paginator"]/a') we$clickElement() Sys.

Continue reading

使用R语言模拟抢红包

有一次参加了一个特别无聊的讲座,实在是无事可做,就琢磨了一下像微信抢红包那样的机制是如何实现的。自己当时想了一个模拟的方式,出来的结果似乎也可以以假乱真。后来把相关的代码完善了下,用来在自己组织的R语言课上讲for循环和自编函数。现在把这些内容整理出来,权当作一篇小小的教程。 首先假设,有人发了一个200块钱的红包,分给10个人抢: money <- 200 people <- 10 给每个人安排一个随机数: set.seed(181209) rand_number <- sample(1:10000, people, replace = TRUE) rand_number ## [1] 4188 591 2386 4520 3692 979 8170 3728 7121 4408 随后用每个随机数除以所有随机数的总和得到一个比值,乘以总钱数,进而得到每个人的钱数: rand_money <- rand_number/sum(rand_number)*money rand_money ## [1] 21.054219 2.971118 11.995073 22.723274 18.560692 4.921700 41.072820 ## [8] 18.741674 35.799211 22.160219 然后就可以知道具体每个人得到多少钱了: paste0(paste0(sample(letters, 5, replace = TRUE), collapse = ''), '得到了', round(rand_money[1], 2), '元,红包剩余', round(money - sum(rand_money[1:1]), 2), '元。') ## [1] "hdprm得到了21.

Continue reading

Bar Plot Box Plot Heatmap Histgram Line Chart Map Pie Chart Radar Chart Scatter Plot Treemap 像这样的教程应该有很多了,但为了自己查阅起来方便,我决定自己也写一个。这里我会尽量多的用到各种theme和palette,省得每次绘图还要一个一个试,看哪个好看(通过这个过程,我可能体验到了女生出门前挑衣服的感觉)。 先把需要用到的包载入: library(tidyverse) library(ggthemes) Bar Plot 直条图应该是最常见的了,在心理学论文中用到直条图时,一般都是把自变量放到x轴上,因变量放到y轴上,然后再添加误差条: iris %>% group_by(Species) %>% summarise(avg_sl = mean(Sepal.Length), se = sqrt(sd(Sepal.Length)/n())) %>% ggplot(aes(Species, avg_sl, fill = Species)) + geom_col(width = .5) + geom_errorbar(aes(ymin = avg_sl - se, ymax = avg_sl + se),width = .3) + scale_y_continuous(expand = c(0, 0)) + scale_fill_brewer(palette = 'Set2') + labs(y = 'Sepal.

Continue reading

今年三月份,为了掌握文本分析技术,特意找了两个版本《天龙八部》的txt文件作为数据而进行练习,但可能被其他事情给耽搁了,当时只完成了一部分。前几天金老去世,令人不胜感概,于是想把这个《天龙八部》的文本分析完成,也算是以自己的方式表达对大师的怀念。 首先还是载入相关的包,这次的包有点多: library(tidyverse) library(readxl) library(tidytext) library(jiebaR) library(ggthemes) library(widyr) library(igraph) library(ggraph) 然后将两个版本的小说文本导入,顺便导入了主要人物的人名,因为这次分析是以分析主要人物为主: tl_new <- read_lines('tl_new.txt') tl_old <- read_lines('tl_old.txt') tl_main <- read_lines('tl_main.txt') %>% .[-1] 因为每个人的称呼不止一个,如乔帮主、萧大王、姊夫等等,都是指萧峰一个人,所以为了统一人名,还要做一些替换工作: tl_new_tran <- tl_new %>% str_replace_all('(段公子)|(哥哥)|(誉儿)', '段誉') %>% str_replace_all('(乔峰)|(乔帮主)|(姊夫)|(萧大王)', '萧峰') %>% str_replace_all('(梦郎)|(小和尚)', '虚竹') %>% str_replace_all('(南海鳄神)|(岳老二)', '岳老三') %>% str_replace_all('带头大哥', '玄慈') %>% str_replace_all('延庆太子', '段延庆') %>% str_replace_all('白长老', '白世镜') %>% str_replace_all('全舵主', '全冠清') %>% str_replace_all('甘宝宝', '钟夫人') %>% str_replace_all('小康', '马夫人') %>% str_replace_all('灵儿', '钟灵') %>% str_replace_all('(星宿老怪)|(星宿老仙)', '丁春秋') %>% str_replace_all('庄聚贤', '游坦之') %>% str_replace_all('(慕容公子)|(表哥)', '慕容复') %>% str_replace_all('国师', '鸠摩智') %>% str_replace_all('表妹', '王语嫣') %>% str_replace_all('(婉妹)|(木姊姊)', '木婉清') %>% str_replace_all('(郡主)|(小师妹)', '阿紫') %>% str_replace_all('段王爷', '段正淳') tl_old_tran <- tl_old %>% str_replace_all('(段公子)|(哥哥)|(誉儿)', '段誉') %>% str_replace_all('(乔峰)|(乔帮主)|(姊夫)|(萧大王)', '萧峰') %>% str_replace_all('(梦郎)|(小和尚)', '虚竹') %>% str_replace_all('(南海鳄神)|(岳老二)', '岳老三') %>% str_replace_all('带头大哥', '玄慈') %>% str_replace_all('延庆太子', '段延庆') %>% str_replace_all('白长老', '白世镜') %>% str_replace_all('全舵主', '全冠清') %>% str_replace_all('甘宝宝', '钟夫人') %>% str_replace_all('小康', '马夫人') %>% str_replace_all('灵儿', '钟灵') %>% str_replace_all('(星宿老怪)|(星宿老仙)', '丁春秋') %>% str_replace_all('庄聚贤', '游坦之') %>% str_replace_all('(慕容公子)|(表哥)', '慕容复') %>% str_replace_all('国师', '鸠摩智') %>% str_replace_all('表妹', '王语嫣') %>% str_replace_all('(婉妹)|(木姊姊)', '木婉清') %>% str_replace_all('(郡主)|(小师妹)', '阿紫') %>% str_replace_all('段王爷', '段正淳') 上面的替换工作并不全,比如,同样是段郞,有时可能是指段誉,有时可能是指段正淳,这就需要具体的情境,才能判断出来这个词指的是谁,但这个工作太麻烦了,这里就放弃了。

Continue reading

大概是去年的这个时间,我在一个名叫Data Is Beautiful的reddit论坛上看到了一张Rick and Morty的分集评分热力图,就想用R把它重复出来。当时水平还不怎么样,只能画个大概出来,很多细节都不知道该如何呈现;前几个月,又重新尝试了下,大部分细节都知道该如何实现了,但还是差一点;这里再尝试一下,看看能不能完全重复出来,毕竟这张图应该就是用R画的。 图是这样的: 首先,还是先把需要用到的包载入: library(tidyverse) 然后载入数据: rm <- read_csv("rick & morty.csv") %>% mutate_at(vars(Episode, Season), as.factor) 载入数据的时候,为方便后面的绘图,顺便把集数和季数两个变量改成了因子型。具体的数据是这样的: rm ## # A tibble: 31 x 3 ## Episode Season Rating ## <fct> <fct> <dbl> ## 1 1 1 8.1 ## 2 2 1 8.7 ## 3 3 1 8.4 ## 4 4 1 8.6 ## 5 5 1 8.9 ## 6 6 1 9 ## 7 7 1 8.

Continue reading

据说希腊的德尔菲神庙上刻着几条箴言,其中一条告诫我们要“认识你自己”。这条箴言刻起来容易,做起来却很难,甚至可能是人生最困难的事情之一。要想认识自己,大概有四种方法,一是客观内容的客观描述,如测量人的身高、体重等各种身体特征,这些特征在一定的时间内不会有太大幅度的变化,用来测量这些特征的工具也具有极高的信度和效度,因此不论从要了解的内容和用于了解该内容的方式,都是很客观的;二是客观内容的主观描述,如使用问卷量表测量人的各种能力,人的能力应该也是比较恒定的,但用于测量这些特征的工具,无论是编制过程还是施用过程,都避免不了与人为因素有关的干扰,即便硬要说它是客观的,也是“主观”的客观。三是主观内容的主观描述,如各种投射测验,对于这些测验,我没有实际接触过,但从书本上来看,难免不让我认为这种测验从内容到方式都不是那么客观;最后一种就显而易见了,即对主观内容的客观描述,如对推特的文本分析,我要进行的日记文本分析,也是这一范围之内的。日记本身是主观的产物,但这里我要对这些主观的内容进行客观的数据分析,进而从这一角度来加深对自己的了解,不过这个方法的局限性也很大,毕竟不是每个人都有几十万字的日记文本可以用来分析。另外再加一句,上面这段话,也可以说是对客观内容的主观描述。 这篇文章分为三部分,首先是对我每天记日记的时间进行一个简单的分析,然后对文本进行分词,针对词频进行分析,最后是一个初步的情感分析。下面先载入需要用到的包。 导入需要的包 library(tidyverse) library(readxl) library(jiebaR) library(ggthemes) 一般情况下,我的第一行代码都是library(tidyverse),这次主要用到了其中dplyr、tidyr、stringr以及ggplot2四个包;readxl包用来读入.xlsx格式的文件;jiebarR用来分词;ggthemes用来添加我最喜欢的tufte主题。 时间分析 首先要把日记中与时间有关的内容提取出来,我记录时间的格式很固定,都是20XX年X月X日 周X XX:XX的形式,通过以下代码,可以把这部分内容提取出来: time <- read_lines('dairy.txt') %>% as.tibble() %>% filter(str_detect(value, '.*年.*月.*日.*周')) %>% mutate(num = row_number()) %>% select(2, time = 1) 处理后是这个样子的: num time 1 2012年1月13日 周五 21:40 2 2012年1月14日 周六 21:41 3 2012年1月15日 周日 21:53 4 2012年1月16日 周一 21:58 5 2012年1月17日 周二 21:45 6 2012年1月18日 周三 21:51 7 2012年1月19日 周四 22:01 8 2012年1月20日 周五 21:43 9 2012年1月21日 周六 21:35 10 2012年1月22日 周日 21:53 所有的时间都放在一起是没法分析的,接下来我就把各部分时间分离开,并转化成了整数型,这一步代码如下:

Continue reading

学习与考试 学习是由经验引起的相对持久的变化,而考试,一方面是对习得的知识与技能的掌握情况的测试,另一方面也是对能否进入下一阶段学习或工作的考核。虽然学习能力受个人的智力水平以及学习方法的影响,但一般而言,学习是没有捷径的;但考试却不一样,在应付考试的时候,确实存在一些捷径可走。且以我个人的经历举三个例子。 高中的时候,我的立体几何学得不是很好,对于如何解立体几何大题完全摸不着门路。然而有一天,我在一本辅导书中看到一种用空间向量解立体几何大题的方法,而且相当简单易学,做了几道类似的题,我就掌握了这个方法。随后在整个高中阶段,我就靠着这一捷径,在并不具备足够的立体几何知识的前提下做到了立体几何大题从来不丢分。 我本科是自考的英语专业,其中有一门课,叫《英美文学选读》。这门课应该是所有20多门课中最有价值的一门,同时也是最难的一门。教材中介绍了英国与美国的70多位著名的作家以及他们的代表作。我第一次没能考过,因为内容实在是太多了,不好把握重点。后来,我找了几份历年的真题,看过之后才发现,原来70多位作者当中,只有30多位会在考试中考到,这一下就把任务量缩减了一半。虽然难度还是挺大的,但第二次终于顺便通过了。我又一次找到了考试的捷径,同时也第一次意识到真题对于考试的重要性。 拿到本科毕业证之后,我就开始着手考研。专业课所涉及的内容不可谓不多,如果想全面的复习,时间肯定不够,只能有所侧重的进行复习。有了先前的经验,我开始反复地研究真题。哪些知识点会以选择题的形式考察,哪些知识点会以大题的形式考察,哪些部分的内容考试从来不涉及,可以忽略,哪些部分的内容频繁考到,必须重点记忆?经过反复地分析,我根据真题总结出了一份比较精简的笔记,并在考试中拿到了一个还算满意的分数。如果仅仅按大纲来复习的话,肯定会浪费很多时间。 从我个人经历来看,考试确实是有捷径可循,而这个捷径往往跟历年的真题有关。但是对于大部分考试来说,可用于分析的样本量太低,而且找不到客观的指标,只能通过自己的主观判断,因此在知识点的选取上难免会有一些偏差。但有一门考试却不存在这两个问题,既有足够大的样本量可供分析,又能产生客观的指标。很明显,这门考试就是大家“喜闻乐见”英语考试。 上大学之前,语数外三科同等重要;而上大学之后,大多数专业应该都不用学语文了,文科的一般也不用学数学了,只有英语,坚挺地为几乎所有专业所必学,并在很多学校作为毕业的条件之一。从这一点也可以看出来英语的重要性。学好英语不是一件轻松的事情,需要长时间的积累。虽然我恐怕不会再参加任何类型的英语考试了,但是未了将来的更好发展,我基本上保持着每天10K的英文阅读量。不过,应付英语考试就是另外一回事了,完全有可能出现我在备考《英美文学选读》时的情况。此外,我还想强调一点,我们这一辈子为了应付考试浪费了太多的生命了,也许功利地应付考试,反而倒是一种非功利的学习行为。 要准备英语考试,大部分人的第一反应应该都是要背单词!各个级别的英语考试都有那么几千到上万的单词需要背诵,绝大多数考生都或多或少地受到过背单词的折磨。背了忘,忘了再背,背了再忘,反反复复,没有休止。一方面,对单词的记忆会随着时间的流逝而消退,另一方面,几千个单词之间往往也会产生各种干扰,导致遗忘。如果需要背诵的单词量大大减少的话,情况就会好得多了。那现在的问题就是,各级别英语考试大纲中的那些单词,真的都需要背下来吗? 社会学中有个著名的80/20定律,即这个世界80%的财富都集中在20%的人手里。对于英语试卷这一定律可能也适用,即80%的文本都是由那20%最常见的单词组成。如果真是这样的话,那只需要原先五分之一的时间(也许更少,因为这时的干扰也更少),就足以应付英语考试了。市面上其实早就有了通过词频来排列单词供人背诵的参考书,但是这些书的销量似乎并不是很好,这大概是因为这些书只是笼统的把全部文本都拿来进行统计,不够细致,也没有针对性。如果能针对不同类型的试题,甚至针对这些试题的不同部分,统计出来词频,肯定会有更好的指导作用。 针对高考英语阅读题的文本分析 为了进行验证与分析,我从网上找到了最近9年的天津高考英语试题文档。我把其中的阅读部分复制了出来,按年份保存在了txt文档中,然后利用tidyverse和tidytext包,制作了两份csv格式句子库文档,其中一份是以全部阅读文本为基础生成的,另一份则只针对阅读题的题干而生成。现在先载入需要的包,并把这两份数据导入: library(tidyverse) library(tidytext) library(pipeR) library(magrittr) library(knitr) reading <- read.csv('reading.csv', stringsAsFactors = FALSE) question <- read.csv('question.csv', stringsAsFactors = FALSE) 因为readr包中的函数对中文的支持不是很好,所以我这里使用了R自带的函数。先看一下这两份数据: reading %>% head() %>% kable() year region passage sentence sentence_low 2007 天津 A The city of Rome has passed a new law to prevent cruelty to animals. the city of rome has passed a new law to prevent cruelty to animals.

Continue reading

Author's picture

孟祥良

R语言爱好者, 心理学专业硕士 & FGO休闲玩家