• 主页
  • 课程

    关于课程

    • 课程归档
    • 成为一名讲师
    • 讲师信息
    同等学历教学

    同等学历教学

    免费
    阅读更多
  • 特色
    • 展示
    • 关于我们
    • 问答
  • 事件
  • 个性化
  • 博客
  • 联系
  • 站点资源
    有任何问题吗?
    (00) 123 456 789
    weinfoadmin@weinformatics.cn
    注册登录
    恒诺新知
    • 主页
    • 课程

      关于课程

      • 课程归档
      • 成为一名讲师
      • 讲师信息
      同等学历教学

      同等学历教学

      免费
      阅读更多
    • 特色
      • 展示
      • 关于我们
      • 问答
    • 事件
    • 个性化
    • 博客
    • 联系
    • 站点资源

      未分类

      • 首页
      • 博客
      • 未分类
      • 实战数据科学|2从R和数据开始的代码

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

      • 发布者 weinfoadmin
      • 分类 未分类
      • 日期 2021年9月9日
      • 评论 0评论

      专题介绍: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)

      ScatterHist的可视化效果,如下图所示:


      关于代码有什么问题或者想法,请留言。

      公众号后台回复“R实战数据科学”,获取实战数据科学书籍的领取方式。

      推荐阅读   


      1 R语言机器学习3本经典书籍集合本,提高你的R语言和机器学习能力!(可供下载)

      2 R数据分析和可视化培训课程书籍,5大模块,助你学习数据分析和挖掘技术(可供下载)

      3 R语言实战英文书籍,配套源代码,帮助你学习R语言!(可下载)


      推荐公众号:数据科学与人工智能

      数据科学与人工智能公众号推广Python语言,数据科学与人工智能的知识和信息。扫码下方二维码关注我,一起学习Python语言和数据科学与人工智能。



      依托【R语言】公众号,我创建了R语言群,群友们每天都会就R语言的主题进行交流和分享。需要加入R语言群的朋友,可以扫码加我的个人微信,请备注【姓名-入群】。我诚邀你加入群,大家相互学习和共同进步。


      请关注“恒诺新知”微信公众号,感谢“R语言“,”数据那些事儿“,”老俊俊的生信笔记“,”冷🈚️思“,“珞珈R”,“生信星球”的支持!

      • 分享:
      作者头像
      weinfoadmin

      上一篇文章

      R语言做数据可视化书籍,指导你做出更高质量的图形(可供下载)
      2021年9月9日

      下一篇文章

      R语言好书推荐:nn
      2021年9月9日

      你可能也喜欢

      2-1675088548
      lncRNA和miRNA生信分析系列讲座免费视频课和课件资源包,干货满满
      30 1月, 2023
      9-1675131201
      如何快速批量修改 Git 提交记录中的用户信息
      26 1月, 2023
      8-1678501786
      肿瘤细胞通过改变CD8+ T细胞中的丙酮酸利用和琥珀酸信号来调控抗肿瘤免疫应答。
      7 12月, 2022

      留言 取消回复

      要发表评论,您必须先登录。

      搜索

      分类

      • R语言
      • TCGA数据挖掘
      • 单细胞RNA-seq测序
      • 在线会议直播预告与回放
      • 数据分析那些事儿分类
      • 未分类
      • 生信星球
      • 老俊俊的生信笔记

      投稿培训

      免费

      alphafold2培训

      免费

      群晖配置培训

      免费

      最新博文

      Nature | 单细胞技术揭示衰老细胞与肌肉再生
      301月2023
      lncRNA和miRNA生信分析系列讲座免费视频课和课件资源包,干货满满
      301月2023
      如何快速批量修改 Git 提交记录中的用户信息
      261月2023
      logo-eduma-the-best-lms-wordpress-theme

      (00) 123 456 789

      weinfoadmin@weinformatics.cn

      恒诺新知

      • 关于我们
      • 博客
      • 联系
      • 成为一名讲师

      链接

      • 课程
      • 事件
      • 展示
      • 问答

      支持

      • 文档
      • 论坛
      • 语言包
      • 发行状态

      推荐

      • iHub汉语代码托管
      • iLAB耗材管理
      • WooCommerce
      • 丁香园论坛

      weinformatics 即 恒诺新知。ICP备案号:粤ICP备19129767号

      • 关于我们
      • 博客
      • 联系
      • 成为一名讲师

      要成为一名讲师吗?

      加入数以千计的演讲者获得100%课时费!

      现在开始

      用你的站点账户登录

      忘记密码?

      还不是会员? 现在注册

      注册新帐户

      已经拥有注册账户? 现在登录

      close
      会员购买 你还没有登录,请先登录
      • ¥99 VIP-1个月
      • ¥199 VIP-半年
      • ¥299 VIP-1年
      在线支付 激活码

      立即支付
      支付宝
      微信支付
      请使用 支付宝 或 微信 扫码支付
      登录
      注册|忘记密码?