[转] R 代码 00003 18.06.19

# 知识来源于网络,仅供交流使用,如有侵权请及时联系予以删除

# Libraries
library(data.table)   # 高效数据操作
library(magrittr)  # 管道操作
library(ggplot2)  # 数据可视化
library(stringr)   # 字符串处理
#  library(quanteda)  该包在加载时出现错误
library(gridExtra)  # 多图
library(dplyr)    # 数据操作
library(tidyr)     # 数据操作
library(caTools)  # 工具:移动窗口统计
library(xgboost)  # 极限梯度提升
library(quanteda)   # 文本数据的定量分析
library(SnowballC)  # 基于C libstemmer UTF-8库的雪球词干分析器
library(tm)  # 文本挖掘软件包
library(corrplot)      # 相关矩阵的可视化


# Data Overview
setwd("e:/")
system.time(train <- fread('../input/train.tsv', showProgress = T , data.table=F))
    # 读取数据,包括工具条、读取时间
str(train)
    # train_id、name、item_condition_id、category_name、brand_name、price、shipping、item_description
dim(train)   # 记录多少
print(object.size(train), units = 'Mb')  # 数据存储大小

# 0: Variable Analysis:Price :价格、及其分布
length(train$price[train$price==""])
length(train$price[is.na(train$price)])
range(train$price)
ggplot(train,aes(x=price))+geom_histogram(fill = 'orangered2')  # 分布范围大,但是不均衡,变换log()表示
ggplot(data = train, aes(x = log(price+1,base=10))) + geom_histogram(fill = 'orangered2')
    # e = 2.718281828459; log(8,2)===>3;   base=exp(1),即e

# 1: Variable Analysis:item_condition_id :产品状况分类情况、及其对价格的影响length(train$item_condition_id[train$item_condition_id==""])
length(train$item_condition_id[is.na(train$item_condition_id)])
table(train$item_condition_id)  # 查看分类分布、与价格关系p1<-train %>%        # 画柱状图
	group_by(item_condition_id) %>%
	summarise(count=length(price),median=median(price))  %>%
	ggplot(aes(x = item_condition_id, y = count)) +  geom_bar(stat = 'identity',fill = "orangered2") 
p2<-train %>%	     # 画箱体图
	ggplot(aes(x = as.factor(item_condition_id), y = log(price+1,base=10))) + 
		stat_boxplot(geom = "errorbar") +  geom_boxplot(fill = "skyblue")  
grid.arrange(p1,p2,nrow=1)
    # 以下为箱体图的解读样本
# 2:Variable Analysis:Shipping :运费状况,及对价格分布的影响
length(train$shipping[train$shipping==""])
length(train$shipping[is.na(train$shipping)])
table(train$shipping) # 分布状况
train %>% 
    ggplot(aes(x = log(price+1), fill = as.factor(shipping))) + 
    geom_density(adjust=2,alpha= 0.6)

# 3:Variable Analysis:brand_name :品牌名称,及对价格分布的影响
length(train$brand_name[train$brand_name==""])
length(train$brand_name[is.na(train$brand_name)])
length(table(train$brand_name))  # 分布状况
train %>%  
    group_by(brand_name) %>%     
    summarise(median_price = median(price)) %>%         
    arrange(desc(median_price)) %>% head(25) %>%        
    ggplot(aes(x = reorder(brand_name,median_price), y = median_price)) +         
        geom_point()+coord_flip()

# 4:Variable Analysis:category_name :产品分类名称,及对价格分布的影响
length(train$category_name[train$category_name==""])
length(train$category_name[is.na(train$category_name)])
length(unique(train$category_name))
      # 等价于  length(table(train$category_name))  # 分布状况
sort(table(train$category_name), decreasing = TRUE)[1:10]
    #分类初始分析
        train %>%  
            group_by(category_name) %>%      
            summarise(median_price = median(price)) %>%             
            arrange(desc(median_price)) %>% head(25) %>%
            ggplot(aes(x = reorder(category_name,median_price), y = median_price)) +         
            geom_point()+coord_flip()

    # 分类分析,进一步细分
        splitVar = str_split(train$cat, "/")
        cat1 = sapply(splitVar,'[',1)
        cat2 = sapply(splitVar,'[',2)
        train['cat1'] = cat1
        train['cat2'] = cat2
        train$cat1[is.na(train$cat2)] = -1
        train$cat2[is.na(train$cat3)] = -1
        train['train$category_name'][is.na(train$train$category_name)] = -1
        # cat1  分析1
                train %>%  ggplot(aes(x = cat1, y = log(price+1,base=10))) + stat_boxplot(geom = "errorbar")+
		    geom_boxplot(fill = 'cyan2', color = 'darkgrey') + coord_flip() + labs(y="",title = 'category_name: cat1 观察方法1' )
        # cat1  分析2
	        p1 <-train %>%
                        group_by(cat1, item_condition_id) %>%
                        summarise(count=length(train_id)) %>%
                        ggplot(aes(x = item_condition_id, y = cat1, fill = count/1000)) +geom_tile() +
                            scale_fill_gradient(low = 'lightblue', high = 'cyan4') +
                            labs(x = 'Condition', y = '', fill = 'Number of items (000s)', title = 'cat1: Item count by category and condition') +
               	            theme_bw() +  theme(legend.position = 'bottom')
	        p2 <-train %>%
		        group_by(cat1, item_condition_id) %>%
		        summarise(median_price=median(price)) %>%
		        ggplot(aes(x = item_condition_id, y = cat1, fill = median_price)) +
			    geom_tile() + scale_fill_gradient(low = 'lightblue', high = 'cyan4') +
			    labs(x = 'Condition', y = '', fill = 'median_price', title = 'cat1: Item price by category and condition') +
			    theme_bw() + theme(legend.position = 'bottom', axis.text.y = element_blank())
	        grid.arrange(p1, p2, ncol = 2)
        # cat2  分析
            ss<- train  %>% group_by(cat2) %>%summarise(median=median(price)) %>% arrange(desc(median)) %>% head(15)
            train %>%  filter(cat2 %in% ss$cat2) %>% select(c("price","cat1","cat2","category_name")) %>%
	        ggplot(aes(x = cat2, y = log(price+1))) + stat_boxplot(geom = "errorbar") + 
		geom_boxplot(fill = 'cyan2', color = 'darkgrey') + coord_flip()

# 5:Variable Analysis:item_despription :产品分描述
        train['desclength'] = str_length(train$item_description)
        train$desclength[train$item_description == 'No description yet']<- NA
        cor(train$price,train$desc_length,use='complete.obs')
   
# 以下为部分文本分析内容,等待学习
corpus = Corpus(VectorSource(train$item_description))   #将要分析的变量加载到适当的格式中。
corpus = tm_map(corpus, tolower)          # 小写所有单词
corpus = tm_map(corpus, removePunctuation)  # 删除标点符号
corpus = tm_map(corpus, removeWords, stopwords("english"))  #去停用词
dataframe <- data.frame(text=sapply(corpus, identity),stringsAsFactors=F)    #转换为数据框
train$item_description = dataframe$text    #附加到原数据中

            
  • 0
    点赞
  • 1
    收藏
    觉得还不错? 一键收藏
  • 0
    评论

“相关推荐”对你有帮助么?

  • 非常没帮助
  • 没帮助
  • 一般
  • 有帮助
  • 非常有帮助
提交
评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值