1. 程式人生 > >【譯文】怎樣在R語言中使用SQL命令

【譯文】怎樣在R語言中使用SQL命令

bow all label 數據科學 eid tex 鏈接 方法 params

【譯文】怎樣在R語言中使用SQL命令


作者 Fisseha Berhane

對於有SQL背景的R語言學習者而言。sqldf是一個很實用的包,由於它使我們能在R中使用SQL命令。僅僅要掌握了主要的SQL技術。我們就能利用它們在R中操作數據框。關於sqldf包的很多其它信息,能夠參看cran。

在這篇文章中,我們將展示怎樣在R中利用SQL命令來連接、檢索、排序和篩選數據。

我們也將展示怎麽利用R語言的函數來實現這些功能。近期我在處理一些FDA(譯者註:食品及藥物管理局)的不良事件數據。這些數據很混亂:有缺失值。有反復記錄,有不同一時候間建立的數據集的可比性問題。不同數據集中變量名稱和數量也不統一(比方一個數據集裏叫sex,還有一個裏叫gender),還有疏忽錯誤等問題。但正因如此,這些數據對於數據科學家或者愛好者而言到是理想的練手對象。

本文使用的FDA不良事件數據能夠從公開渠道獲得,csv格式的數據表能夠從國家經濟研究局下載。通過R從國家經濟研究局的站點下載數據相對更easy,我建議你使用對應的R代碼來下載並探索數據。

不良事件數據集是以季度為發布周期,每一個季度的數據包括了人口信息、藥物/生物信息、不良事件詳情,結果和診斷情況等信息。

讓我們下載數據並使用SQL命令來連接、排序和篩選該數據集中包括的大量數據框。

載入R包

require(downloader)  
library(dplyr)
library(sqldf)
library(data.table)
library(ggplot2)
library(compare) library(plotrix)

主要的錯誤處理函數tryCatch()

我們將使用這個函數來處理下載的數據。由於數據以季度頻率發布,每年都會有四個觀測值(每年有四條記錄)。執行這個函數能自己主動下載數據,但假設某些季度數據從網上無法獲取(尚未發布)。該函數會返回一條錯誤信息表示無法找到數據集。

如今讓我們下載數據的壓縮包並將其解壓。

try.error = function(url)
{
  try_error = tryCatch(download(url,dest="data.zip"), error=function(e) e)
  if
(!inherits(try_error, "error")){ download(url,dest="data.zip") unzip ("data.zip") } else if (inherits(try_error, "error")){ cat(url,"not found\n") } }

下載不良事件數據

我們能夠得到自2004年起的FDA不良事件數據。本文將使用2013年以來發布的數據,我們將檢查截至當前時間的最新數據並下載。

> Sys.time() 函數會返回當前的日期和時間。

> data.table包中的year()函數會從之前返回的當前時間中提取年份信息。

我們將下載人口、藥物、診斷/指示,結果和反應(不良事件)數據。

year_start=2013
year_last=year(Sys.time())
for (i in year_start:year_last){
            j=c(1:4)
            for (m in j){
            url1<-paste0("http://www.nber.org/fda/faers/",i,"/demo",i,"q",m,".csv.zip")
            url2<-paste0("http://www.nber.org/fda/faers/",i,"/drug",i,"q",m,".csv.zip")
            url3<-paste0("http://www.nber.org/fda/faers/",i,"/reac",i,"q",m,".csv.zip")
            url4<-paste0("http://www.nber.org/fda/faers/",i,"/outc",i,"q",m,".csv.zip")
            url5<-paste0("http://www.nber.org/fda/faers/",i,"/indi",i,"q",m,".csv.zip")
           try.error(url1)
           try.error(url2)
           try.error(url3)
           try.error(url4)
           try.error(url5)     
            }
        }

http://www.nber.org/fda/faers/2015/demo2015q4.csv.zip not found
...
http://www.nber.org/fda/faers/2016/indi2016q4.csv.zip not found

依據上面的錯誤信息。截至成文時間(2016年3月13日)。我們最多能夠獲得2015年第三季度的不良事件數據。

> list.files()函數會字符串向量的形式返回當前工作文件夾下全部文件的名字。

> 我會使用正則表達式對各個數據集的類別進行篩選。

比方^demo.*.csv表示全部名字以demo開頭的csv文件。

filenames <- list.files(pattern="^demo.*.csv", full.names=TRUE)
cat(‘We have downloaded the following quarterly demography datasets‘)
filenames

我們已經下載了下列季度人口數據

"./demo2012q1.csv" "./demo2012q2.csv" "./demo2012q3.csv" "./demo2012q4.csv" "./demo2013q1.csv" "./demo2013q2.csv" "./demo2013q3.csv" "./demo2013q4.csv" "./demo2014q1.csv" "./demo2014q2.csv" "./demo2014q3.csv" "./demo2014q4.csv" "./demo2015q1.csv" "./demo2015q2.csv" "./demo2015q3.csv"

讓我們用data.table包中的fread()函數來讀入這些數據集,以人口數據為例:

demo=lapply(filenames,fread)

接著讓我們把它們轉換數據結構並合並成一個數據框:

demo_all=do.call(rbind,lapply(1:length(demo),function(i) select(as.data.frame(demo[i]),primaryid,caseid, age,age_cod,event_dt,sex,reporter_country)))
dim(demo_all)
       3554979   7 

我們看到人口數據有超過350萬行觀測(記錄)。

譯者註:以下的內容都是反復這個流程。能夠略過

如今讓我們合並全部的藥品數據

filenames <- list.files(pattern="^drug.*.csv", full.names=TRUE)
cat(‘We have downloaded the following quarterly drug datasets:\n‘)
filenames
drug=lapply(filenames,fread)
cat(‘\n‘)
cat(‘Variable names:\n‘)
names(drug[[1]])
drug_all=do.call(rbind,lapply(1:length(drug), function(i) select(as.data.frame(drug[i]),primaryid,caseid, drug_seq,drugname,route)))

我們已經下載了下列季度藥品數據集

"./drug2012q1.csv" "./drug2012q2.csv" "./drug2012q3.csv" "./drug2012q4.csv" "./drug2013q1.csv" "./drug2013q2.csv" "./drug2013q3.csv" "./drug2013q4.csv" "./drug2014q1.csv" "./drug2014q2.csv" "./drug2014q3.csv" "./drug2014q4.csv" "./drug2015q1.csv" "./drug2015q2.csv" "./drug2015q3.csv"

每張表中的變量名分別為:

"primaryid" "drug_seq" "role_cod" "drugname" "val_vbm" "route" "dose_vbm" "dechal" "rechal" "lot_num" "exp_dt" "exp_dt_num" "nda_num" 

合並全部的診斷/指示數據集

filenames <- list.files(pattern="^indi.*.csv", full.names=TRUE)
cat(‘We have downloaded the following quarterly diagnoses/indications datasets:\n‘)

filenames

indi=lapply(filenames,fread)

cat(‘\n‘)
cat(‘Variable names:\n‘)

names(indi[[15]])

indi_all=do.call(rbind,lapply(1:length(indi), function(i) select(as.data.frame(indi[i]),primaryid,caseid, indi_drug_seq,indi_pt)))

已經下載的數據集為:

"./indi2012q1.csv" "./indi2012q2.csv" "./indi2012q3.csv" "./indi2012q4.csv" "./indi2013q1.csv" "./indi2013q2.csv" "./indi2013q3.csv" "./indi2013q4.csv" "./indi2014q1.csv" "./indi2014q2.csv" "./indi2014q3.csv" "./indi2014q4.csv" "./indi2015q1.csv" "./indi2015q2.csv" "./indi2015q3.csv"

變量名為:

"primaryid" "caseid" "indi_drug_seq" "indi_pt" 

合並病人的結果數據:

filenames <- list.files(pattern="^outc.*.csv", full.names=TRUE)
cat(‘We have downloaded the following quarterly patient outcome datasets:\n‘)

filenames
outc_all=lapply(filenames,fread)

cat(‘\n‘)
cat(‘Variable names\n‘)

names(outc_all[[1]])
names(outc_all[[4]])
colnames(outc_all[[4]])=c("primaryid", "caseid", "outc_cod")
outc_all=do.call(rbind,lapply(1:length(outc_all), function(i) select(as.data.frame(outc_all[i]),primaryid,outc_cod)))

下載的數據集例如以下:

"./outc2012q1.csv" "./outc2012q2.csv" "./outc2012q3.csv" "./outc2012q4.csv" "./outc2013q1.csv" "./outc2013q2.csv" "./outc2013q3.csv" "./outc2013q4.csv" "./outc2014q1.csv" "./outc2014q2.csv" "./outc2014q3.csv" "./outc2014q4.csv" "./outc2015q1.csv" "./outc2015q2.csv" "./outc2015q3.csv" 

變量名:

"primaryid" "outc_cod" 
"primaryid" "caseid" "outc_code" 

最後來合並反應(不良事件)數據集(譯者註:這部分無聊地我要哭了)

filenames <- list.files(pattern="^reac.*.csv", full.names=TRUE)
cat(‘We have downloaded the following quarterly reaction (adverse event)  datasets:\n‘)

filenames
reac=lapply(filenames,fread)

cat(‘\n‘)
cat(‘Variable names:\n‘)
names(reac[[3]])

reac_all=do.call(rbind,lapply(1:length(indi), function(i) select(as.data.frame(reac[i]),primaryid,pt)))

下載的數據集有:

"./reac2012q1.csv" "./reac2012q2.csv" "./reac2012q3.csv" "./reac2012q4.csv" "./reac2013q1.csv" "./reac2013q2.csv" "./reac2013q3.csv" "./reac2013q4.csv" "./reac2014q1.csv" "./reac2014q2.csv" "./reac2014q3.csv" "./reac2014q4.csv" "./reac2015q1.csv" "./reac2015q2.csv" "./reac2015q3.csv"

變量名為:

"primaryid" "pt" 

讓我們看看不同的數據類型各有多少行

all=as.data.frame(list(Demography=nrow(demo_all),Drug=nrow(drug_all),
                   Indications=nrow(indi_all),Outcomes=nrow(outc_all),
                   Reactions=nrow(reac_all)))
row.names(all)=‘Number of rows‘
all

技術分享

SQL命令

記住sqldf包使用SQLite

COUNT

# SQL版本號
sqldf("SELECT COUNT(primaryid)as ‘Number of rows of Demography data‘
FROM demo_all;")

技術分享

# R版本號
nrow(demo_all)
3554979 

LIMIT命令(顯示前幾行)

#  SQL版本號
sqldf("SELECT *
FROM demo_all 
LIMIT 6;")

技術分享

# R版本號
head(demo_all,6)

技術分享

R1=head(demo_all,6)
SQL1 =sqldf("SELECT *
FROM demo_all 
LIMIT 6;")
all.equal(R1,SQL1)
TRUE

*譯者註:這部分代碼驗證了SQL命令和R代碼的等價性,下同。

WHERE命令

SQL2=sqldf("SELECT * FROM demo_all WHERE sex =‘F‘;")
R2 = filter(demo_all, sex=="F")
identical(SQL2, R2)
TRUE

SQL3=sqldf("SELECT * FROM demo_all WHERE age BETWEEN 20 AND 25;")
R3 = filter(demo_all, age >= 20 & age <= 25)
identical(SQL3, R3)
TRUE

GROUP BY 和 ORDER BY

# SQL版本號
sqldf("SELECT sex, COUNT(primaryid) as Total
FROM demo_all
WHERE sex IN (‘F‘,‘M‘,‘NS‘,‘UNK‘)
GROUP BY sex
ORDER BY Total DESC ;")

技術分享

# R版本號
demo_all %>% filter(sex %in%c(‘F‘,‘M‘,‘NS‘,‘UNK‘)) %>% group_by(sex) %>%
summarise(Total = n()) %>% arrange(desc(Total))

技術分享

SQL3 = sqldf("SELECT sex, COUNT(primaryid) as Total
FROM demo_all
GROUP BY sex
ORDER BY Total DESC ;")

R3 = demo_all%>%group_by(sex) %>%
        summarise(Total = n())%>%arrange(desc(Total))

compare(SQL3,R3, allowAll=TRUE)
TRUE
  dropped attributes

利用SQL命令進行數據清洗並繪制3D餅圖

SQL=sqldf("SELECT sex, COUNT(primaryid) as Total
FROM demo_all
WHERE sex IN (‘F‘,‘M‘,‘NS‘,‘UNK‘)
GROUP BY sex
ORDER BY Total DESC ;")
SQL$Total=as.numeric(SQL$Total
pie3D(SQL$Total, labels = SQL$sex,explode=0.1,col=rainbow(4),
   main="Pie Chart of adverse event reports by gender",cex.lab=0.5, cex.axis=0.5, cex.main=1,labelcex=1)

輸出的圖例如以下:

技術分享

Inner Join

讓我們把藥品數據和指數數據基於主id和藥品序列內連。

首先。我們要檢查下變量名,看看怎樣合並兩個數據集。

names(indi_all)
names(drug_all)

    "primaryid" "indi_drug_seq" "indi_pt" 
    "primaryid" "drug_seq" "drugname" "route" 

names(indi_all)=c("primaryid", "drug_seq", "indi_pt" ) # 使兩個數據集變量名一致
R4= merge(drug_all,indi_all, by = intersect(names(drug_all), names(indi_all))) # R版本號合並
R4=arrange(R3, primaryid,drug_seq,drugname,indi_pt) # R版本號排序
SQL4= sqldf("SELECT d.primaryid as primaryid, d.drug_seq as drug_seq, d.drugname as drugname,
                       d.route as route,i.indi_pt as indi_pt
                       FROM drug_all d
                       INNER JOIN indi_all i
                      ON d.primaryid= i.primaryid AND d.drug_seq=i.drug_seq
                      ORDER BY primaryid,drug_seq,drugname, i.indi_pt") # SQL版本號
compare(R4,SQL4,allowAll=TRUE)
TRUE # 兩種方法等價

R5 = merge(reac_all,outc_all,by=intersect(names(reac_all), names(outc_all)))
SQL5 =reac_outc_new4=sqldf("SELECT r.*, o.outc_cod as outc_cod
                     FROM reac_all r 
                     INNER JOIN outc_all o
                     ON r.primaryid=o.primaryid
                     ORDER BY r.primaryid,r.pt,o.outc_cod")

compare(R5,SQL5,allowAll = TRUE)
TRUE
# 繪制不同性別的年齡概率分布密度圖
ggplot(sqldf(‘SELECT age, sex
             FROM demo_all
             WHERE age between 0 AND 100 AND sex IN ("F","M")
             LIMIT 10000;‘), aes(x=age, fill = sex))+ geom_density(alpha = 0.6)

繪制出的圖例如以下:

技術分享

繪制不同結果的年齡年齡概率分布密度圖(譯者註:後面都是結果的可視化,可略過。原作者的耐心真好。

。。

ggplot(sqldf("SELECT d.age as age, o.outc_cod as outcome
                     FROM demo_all d
                     INNER JOIN outc_all o
                     ON d.primaryid=o.primaryid
                     WHERE d.age BETWEEN 20 AND 100
                     LIMIT 20000;"),aes(x=age, fill = outcome))+ geom_density(alpha = 0.6)

輸出例如以下:

技術分享

ggplot(sqldf("SELECT de.sex as sex, dr.route as route
                     FROM demo_all de
                     INNER JOIN drug_all dr
                     ON de.primaryid=dr.primaryid
                     WHERE de.sex IN (‘M‘,‘F‘) AND dr.route IN (‘ORAL‘,‘INTRAVENOUS‘,‘TOPICAL‘)
                     LIMIT 200000;"),aes(x=route, fill = sex))+ geom_bar(alpha=0.6)

輸出例如以下:

技術分享

ggplot(sqldf("SELECT d.sex as sex, o.outc_cod as outcome
                     FROM demo_all d
                     INNER JOIN outc_all o
                     ON d.primaryid=o.primaryid
                     WHERE d.age BETWEEN 20 AND 100 AND sex IN (‘F‘,‘M‘)
                     LIMIT 20000;"),aes(x=outcome,fill=sex))+ geom_bar(alpha = 0.6)

輸出例如以下(譯者註:哥們兒挺住,你就快看完了!。。):

技術分享

UNION ALL

demo1= demo_all[1:20000,]
demo2=demo_all[20001:40000,]
R6 <- rbind(demo1, demo2)
SQL6 <- sqldf("SELECT  * FROM demo1 UNION ALL SELECT * FROM demo2;")
compare(R6,SQL6, allowAll = TRUE)
TRUE

INTERSECT

R7 <- semi_join(demo1, demo2)
SQL7 <- sqldf("SELECT  * FROM demo1 INTERSECT SELECT * FROM demo2;")
compare(R7,SQL7, allowAll = TRUE)
TRUE

EXCEPT

R8 <- anti_join(demo1, demo2)
SQL8 <- sqldf("SELECT  * FROM demo1 EXCEPT SELECT * FROM demo2;")
compare(R8,SQL8, allowAll = TRUE)
TRUE

我們下篇文章再見!

假設你有不論什麽建議和意見,請在下方留言。

翻譯感悟:這篇文章的作者不厭其煩地演示了利用怎樣sqldf包在R中實現大部分經常使用的SQL命令,並將其結果和直接調用對應的R函數的結果做了對比。證明了二者的等價性。

我十分敬佩作者能走完這個及其枯燥的流程。

但我不想再翻譯第二篇這樣的風格的文章了。。

註:原文刊載於datascience+站點

鏈接:http://datascienceplus.com/performing-sql-selects-on-r-data-frames/

【譯文】怎樣在R語言中使用SQL命令