实战数据科学|2从R和数据开始的代码

专题介绍：R是一种广泛用于数据分析和统计计算的强大语言，于上世纪90年代开始发展起来。得益于全世界众多爱好者的无尽努力，大家继而开发出了一种基于R但优于R基本文本编辑器的R Studio（用户的界面体验更好）。也正是由于全世界越来越多的数据科学社区和用户对R包的慷慨贡献，让R语言在全球范围内越来越流行。其中一些R包，例如MASS，SparkR， ggplot2，使数据操作,可视化和计算功能越来越强大。R是用于统计分析、绘图的语言和操作环境。R是属于GNU系统的一个自由、免费、源代码开放的软件，它是一个用于统计计算和统计制图的优秀工具。R作为一种统计分析软件，是集统计分析与图形显示于一体的。它可以运行于UNIX、Windows和Macintosh的操作系统上，而且嵌入了一个非常方便实用的帮助系统，相比于其他统计分析软件，R的学术性开发比较早，适合生物学和医学等学术学科的科研人员使用。

点击上方蓝字关注我，一起学习R语言

这本书籍我给大家准备好了。公众号后台回复“R实战数据科学”，获取资源的领取方式。

第二章从R和数据开始的代码

本文记录第二章从R和数据开始的代码。这些代码涵盖了R语言的基础知识，包括：向量，列表，数据框，函数等，R语言获取结构化数据的知识，例如从本地磁盘读取数据，从URL获取数据，从关系型数据库获取数据，以及利用dplyr包对数据做一些相应的处理工作等。

完整代码如下：

####################
#实战数据科学第二章R语言代码
#1) R语言基础知识
#2）R数据框结构
#3）R读取结构化数据
#4）R对数据做重编码工作
###################

# 1 生成一个序列
print(seq_len(25))

(x <- 5)

# 2 向量和列表
example_vector <- c(10, 20, 30)
example_list <- list(a = 10, b = 20, c = 30)

example_vector[1]
example_list[1]

example_vector[[2]]
example_list[[2]]

example_vector[c(FALSE, TRUE, TRUE)] 
example_list[c(FALSE, TRUE, TRUE)]

example_list$b  
example_list[["b"]]

# R语言自带函数
x <- 1:5
print(x)  

x <- cumsum(x)    
print(x)

# 字符串
nchar("a string")
nchar(c("a", "aa", "aaa", "aaaa"))

# 算术运算
1 + 2

# 数据框结构
d <- data.frame(x = c(1, NA, 3))
print(d)

# 数据框缺失值检查和重新赋值
d$x[is.na(d$x)] <- 0 
print(d)

d <- data.frame(x = 1, y = 2) 
d2 <- d 
print(d2)

d$x <- 5 
print(d)

data <- data.frame(revenue = c(2, 1, 2),     
                   sort_key = c("b", "c", "a"), 
                   stringsAsFactors = FALSE)
print(data)

# 引入临时变量.
. <- data                                      
. <- .[order(.$sort_key), , drop = FALSE]      
.$ordered_sum_revenue <- cumsum(.$revenue)
.$fraction_revenue_seen <- .$ordered_sum_revenue/sum(.$revenue)
result <- .                                    

print(result)


# 使用dplyr包简化操作
library(dplyr)
library(magrittr)
result <- data %>%
  arrange(., sort_key) %>%
  mutate(., ordered_sum_revenue = cumsum(revenue)) %>%
  mutate(., fraction_revenue_seen = ordered_sum_revenue/sum(revenue))
print(result)

# 数据框变量的增加
d <- data.frame(col1 = c(1, 2, 3), col2 = c(-1, 0, 1))
d$col3 <- d$col1 + d$col2
print(d)

# 数据读取
uciCar <- read.table(                
  'car.data.csv',                   
  sep = ',',                         
  header = TRUE,                    
  stringsAsFactor = TRUE             
)

View(uciCar) 

# 数据框常用的函数
class(uciCar)
summary(uciCar)
dim(uciCar)

# 德国银行数据集
d <- read.table('german.data', sep=' ',
                stringsAsFactors = FALSE, header = FALSE)
colnames(d)

# 变量重命名
colnames(d) <- c('Status_of_existing_checking_account', 'Duration_in_month',
                 'Credit_history', 'Purpose', 'Credit_amount', 'Savings_account_bonds', 
                 'Present_employment_since',
                 'Installment_rate_in_percentage_of_disposable_income',
                 'Personal_status_and_sex', 'Other_debtors_guarantors',
                 'Present_residence_since', 'Property', 'Age_in_years',
                 'Other_installment_plans', 'Housing',
                 'Number_of_existing_credits_at_this_bank', 'Job',
                 'Number_of_people_being_liable_to_provide_maintenance_for',
                 'Telephone', 'foreign_worker', 'Good_Loan')
str(d)

source("mapping.R")                       
for(ci in colnames(d)) {                      
  if(is.character(d[[ci]])) {
    d[[ci]] <- as.factor(mapping[d[[ci]]])   
  }
}

d <- readRDS("creditdata.RDS") 
# 列联表分析
table(d$Purpose, d$Good_Loan) 

# 获取数据库的表数据
library("DBI")
library("dplyr")                                    
library("rquery")

dlist <- readRDS("PUMSsample.RDS")                    
db <- dbConnect(RSQLite::SQLite(), ":memory:")       
dbWriteTable(db, "dpus", as.data.frame(dlist$ss16pus))  
dbWriteTable(db, "dhus", as.data.frame(dlist$ss16hus))
rm(list = "dlist")                                   

dbGetQuery(db, "SELECT * FROM dpus LIMIT 5")              

dpus <- tbl(db, "dpus")                          
dhus <- tbl(db, "dhus")

print(dpus)                                               
glimpse(dpus)

View(rsummary(db, "dpus"))  


dpus <- dbReadTable(db, "dpus")                                   

dpus <- dpus[, c("AGEP", "COW", "ESR",  "PERNP", 
                 "PINCP","SCHL", "SEX", "WKHP")]    

for(ci in c("AGEP", "PERNP", "PINCP", "WKHP")) {     
  dpus[[ci]] <- as.numeric(dpus[[ci]])
}

dpus$COW <- strtrim(dpus$COW, 50)                                    

str(dpus)  


target_emp_levs <- c(                                          
  "Employee of a private for-profit company or busine",
  "Employee of a private not-for-profit, tax-exempt, ",
  "Federal government employee",                    
  "Local government employee (city, county, etc.)",   
  "Self-employed in own incorporated business, profes",
  "Self-employed in own not incorporated business, pr",
  "State government employee")


complete <- complete.cases(dpus)                                

stdworker <- with(dpus,                                         
                  (PINCP>1000) & 
                    (ESR=="Civilian employed, at work") & 
                    (PINCP<=250000) & 
                    (PERNP>1000) & (PERNP<=250000) & 
                    (WKHP>=30) & 
                    (AGEP>=18) & (AGEP<=65) & 
                    (COW %in% target_emp_levs))

dpus <- dpus[complete & stdworker, , drop = FALSE]               

no_advanced_degree <- is.na(dpus$SCHL) |                      
  (!(dpus$SCHL %in% c("Associate's degree",
                      "Bachelor's degree",
                      "Doctorate degree",
                      "Master's degree",
                      "Professional degree beyond a bachelor's degree")))
dpus$SCHL[no_advanced_degree] <- "No Advanced Degree"

dpus$SCHL <- relevel(factor(dpus$SCHL),                      
                     "No Advanced Degree")                
dpus$COW <- relevel(factor(dpus$COW), 
                    target_emp_levs[[1]])
dpus$ESR <- relevel(factor(dpus$ESR), 
                    "Civilian employed, at work")
dpus$SEX <- relevel(factor(dpus$SEX), 
                    "Male")

saveRDS(dpus, "dpus_std_employee.RDS")                            

summary(dpus)        


levels(dpus$SCHL) 
head(dpus$SCHL) 
str(dpus$SCHL)  

d <- cbind(                                                          
  data.frame(SCHL = as.character(dpus$SCHL),                         
             stringsAsFactors = FALSE),
  model.matrix(~SCHL, dpus)                                          
)
d$'(Intercept)' <- NULL                                          
str(d)    

table(schooling = dpus$SCHL, sex = dpus$SEX)  
tapply(                                                    
  dpus$PINCP,                                         
  list(dpus$SCHL, dpus$SEX),                          
  FUN = mean                                          
)

library("dplyr")

dpus %>%
  group_by(., SCHL, SEX)  %>%
  summarize(.,
            count = n(),
            mean_income = mean(PINCP)) %>%
  ungroup(.) %>%
  arrange(., SCHL, SEX)

# 数据可视化
WVPlots::ScatterHist(
  dpus, "AGEP", "PINCP",
  "Expected income (PINCP) as function age (AGEP)",
  smoothmethod = "lm",
  point_alpha = 0.025)