読者です 読者をやめる 読者になる 読者になる

R言語による電子カルテデータの二次利用

~R言語初心者がデータ処理を楽しめるように基本的内容中心のサイトです~

電子カルテのサンプルデータ② ~患者マスター~

今回は、患者マスターデータをMySQLに入れて、SQLの練習をしてみます。

[準備するもの]

  • R
  • Rstudio

インストールの仕方が分からなければ下記を参考にしてください。
r-beginner.hatenadiary.jp

まずは、MySQLと接続し、電子カルテ用データベース(ここではEHR)を作成します。
いくつかデータベースがあるので、USE EHRでデータベースを選択します。

library(RMySQL) 
con <- dbConnect(MySQL(), host="[IP address]", port=3306, dbname="mysql", user="root", password="mysql") 
dbGetQuery(con,"CREATE DATABASE EHR;")  # databaseの作成
dbGetQuery(con,"USE EHR;")        # databaseを選択

次に患者マスターを入れるテーブルを作成します。

dbGetQuery(con,"create table pt_master(facility_code int,id int,name char(40),kana char(40),gender char(20),birth char(20),address varchar(120));") 

患者マスターのサンプルデータをread.csvで読み込み、データフレームに入れておきます。(あらかじめcsvファイルを落としておいて、LOAD DATA INFILEの方が良いのかな…。)

library(RCurl)
# This is not actual patient data.
url <- getURL("https://raw.githubusercontent.com/Algo1970/EHR_data/master/pt_master_samplev2.csv")
df <- read.csv(text = url, header = TRUE)

データを確認

> df %>% tail()
     facility_code    id        name            kana
995        1234567 10995   金田 彩華   かねだ あやか
996        1234567 10996     藤森 兼   ふじもり けん
997        1234567 10997   木村 誠一 きむら せいいち
998        1234567 10998     足立 優     あだち ゆう
999        1234567 10999   小堀 一輝   こほり かずき
1000       1234567 11000 阿久津 一代   あくつ かずよ
     gender      birth address
995  female 1941-11-28  茨城県
996    male 1971-08-18  岐阜県
997    male 2016-01-13  沖縄県
998  female 1984-12-31  愛知県
999    male 2002-04-06  岐阜県
1000 female 1954-11-30  岩手県
> 

このdataframeを先程作成したpt_masterテーブルにinsertします。
また使うかもしれないので、pt_masterにinsertする関数を作っておいて、for文まわします。

into.ptmaster <- function(facility_code,id, name, kana, gender,birth,address){
  query3 <- sprintf("insert into pt_master (facility_code,id, name, kana, gender,birth,address) values (%s,%s,'%s','%s','%s','%s','%s');",
                    facility_code,id, name, kana, gender,birth,address)
  dbGetQuery(con,query3)
}
for (i in 1:nrow(df)){
  into.ptmaster(df$facility_code[i],df$id[i], df$name[i], df$kana[i], df$gender[i],df$birth[i],df$address[i])
}

確認してみましょう。

> dbGetQuery(con,"SELECT * FROM pt_master;") %>% tail()
     facility_code    id        name            kana
995        1234567 10995   金田 彩華   かねだ あやか
996        1234567 10996     藤森 兼   ふじもり けん
997        1234567 10997   木村 誠一 きむら せいいち
998        1234567 10998     足立 優     あだち ゆう
999        1234567 10999   小堀 一輝   こほり かずき
1000       1234567 11000 阿久津 一代   あくつ かずよ
     gender      birth address
995  female 1941-11-28  茨城県
996    male 1971-08-18  岐阜県
997    male 2016-01-13  沖縄県
998  female 1984-12-31  愛知県
999    male 2002-04-06  岐阜県
1000 female 1954-11-30  岩手県
> 

先程のデータフレームがpt_masterに入っています。準備は整いました。
以前ブログに書いた、人口ピラミッドのグラフを関数化しておきましたので、第一引数にpt_masterを読み込んだデータフレーム、第二引数にx軸の最大値を入力すると

make.pyramid <- function(df,x.max=40){
  # genderを変更
  df$gender <-as.character(df$gender) 
  df$gender[df$gender %in% c("m","male","M","Male","MALE","男","男性")] <- c("male")
  df$gender[df$gender %in% c("f","female","F","Female","FEMALE","女","女性")] <- c("female")
  # birthから年齢計算
  make.age <- function(birth){
    df <- NULL
    for(i in 1:length(birth)){
      df[i] <- (length(seq(as.Date(as.character(birth[i])), Sys.Date(), "year"))-1)
    }
    df
  }
  df$age <- make.age(df$birth)
  # 必要なカラムのみ取り出し
  df[,c("gender","age")]->temp
  result <- tapply(temp$age,temp$gender, hist, breaks=seq(0,100,5))
  paste(result$male$breaks,"-")->category
  category[1:(length(category)-1)]->category
  category <- factor(category,levels = category)
  temp_male <- data.frame(category=category,
                          counts=result$male$counts,
                          gender=rep("male",length(result$male$counts)))
  temp_female <- data.frame(category=category,
                            counts=result$female$counts*(-1),
                            gender=rep("female",length(result$female$counts)))
  temp_all <- rbind(temp_male,temp_female)
  # x軸範囲指定
  brks <- seq(-1*x.max, x.max, round(x.max/2,-1))
  lbls <- gsub("-","",as.character(brks))
  # plot
  ggplot(temp_all, aes(x = category, y = counts, fill = gender)) +   
    geom_bar(stat = "identity", width = .8) +   
    scale_y_continuous(breaks = brks,labels = lbls) + 
    coord_flip() +  
    labs(title="Population pyramid") +
    theme_tufte() +  
    theme(text=element_text(size=12, family="Comic Sans MS"), 
          plot.title = element_text(hjust = .5), 
          axis.ticks = element_blank()) +   
    scale_fill_manual(values=c("#9999CC","#CC6666"))
}

df <- dbGetQuery(con,"SELECT * FROM pt_master;")
make.pyramid(df,50) # 人口ピラミッドプロット関数

dbDisconnect(con) # 終わったらconnectionは切りましょう 

f:id:r_beginner:20170122145129j:plain

人口ピラミッド書くのがとても簡単になりました。データフレームの性別カラム名をgender、生年月日カラムをbirthにしておけば、他社の電子カルテデータでもいけそうです。

今後病名テーブルを追加する予定ですので、テーブルを結合すれば、疾患毎の人口ピラミッドを作成することも可能です。
経時的にピラミッドの形状がどう変わるか、可視化するのも面白いですね。GIFアニメーションとか…。