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

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

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

shiny server環境構築(ubuntu16.04)

職場のみんなでshinyアプリが使えるようにshiny server環境を構築してみたいと思います。

www.rstudio.com

今回も練習用にUbuntu仮想マシンを用意しました。

まずR、shiny、shiny-server等インストールしましょう。

$ sudo apt-get -y install r-base
$ sudo su - \
-c "R -e \"install.packages('shiny', repos='https://cran.rstudio.com/')\""
$ sudo apt-get install gdebi-core
$ wget https://download3.rstudio.org/ubuntu-12.04/x86_64/shiny-server-1.5.3.838-amd64.deb
$ sudo gdebi shiny-server-1.5.3.838-amd64.deb

これでインストールは終了です。
ブラウザにlocalhost:3838と入力してみましょう。
f:id:r_beginner:20170427203415j:plain
こんな画面がでれば上手くいっていると思います。

rmarkdown packageもインストールしておきましょう。

$ sudo su - -c "R -e \"install.packages('rmarkdown', repos='http://cran.rstudio.com/')\""

ブラウザにhttp://localhost:3838/sample-apps/rmd/と入力すると、
f:id:r_beginner:20170427205401j:plain
上手く見えたでしょうか。

今度は自作shinyアプリを、動かしてみましょう。
f:id:r_beginner:20170427221723j:plain
/srv/shiny-server/sample-apps以下に自作ファイルを起きます。hello,rmdフォルダはサンプルで、もともとあるものです。
ここにsample0427フォルダを作成します。

ユーザーをrootグループに入れておきます。

$ sudo gpasswd -a <username> root

あとは作成したshinyファイルを入れるだけです。

$ mkdir sample0427
$ gedit ui.R
$ gedit server.R

でshinyファイルを作成しました。
ブラウザでlocalhost:3838/sample-apps/sample0427と入力してみましたが、エラーで動いていないようです。

$ sudo systemctl status shiny-server
$ sudo systemctl restart shiny-server

serverは動いているようですし、再起動してみましたが、うまくブラウザから見えない…

$ sudo chmod 777 ui.R
$ sudo chmod 777 server.R
$ sudo systemctl restart shiny-server

権限与えてみましたが、ダメ

パッケージが入っていない?ggplot2 packageを入れてみましょう。

$ sudo su - -c "R -e \"install.packages('ggplot2', repos='http://cran.rstudio.com/')\""

f:id:r_beginner:20170427213211j:plain

今度は上手く表示されました。パッケージが入っていないだけだったのですが、気づくのに少し時間がかかりました。とりあえずこれで自作アプリがshiny-serverで動く環境ができました。あとは時間のある時に、設定ファイルの勉強をしておけば良いかな。


参考

OpenDolphin(オープンソース電子カルテ)とRstudioの接続

r-beginner.hatenadiary.jp

以前ブログで、OpenDolphin(電子カルテ)とORCA(日医レセコン)の環境構築について書いたところ、OpenDolphinデータベースを二次利用できるのかコメントをいただきました。

実際OpenDolphinで電子カルテを運用されている方の参考にもなるかもしれないので、仮想マシンでの環境構築とRstudioでの接続までを書いておきます。

いつも通りUbuntu仮想マシン(Ubuntu1404)を用意します。

インストール用のスクリプトは上記ブログ内のものとほぼ同じですが、OpenDolphinのDockerコンテナで使用しているPostgreSQLと、ORCAPostgreSQLのポートがぶつからないように、Docker runするときにPort(5433)を指定しています(通常は5432)。RstudioもクライアントPCにインストールするのが面倒なので、Dockerコンテナで入れちゃいます。

Ubuntuは固定IPに変更しておいた方がベターです。
端末から(Ctrl+Alt+T)。ファイル名は何でもよいですが、とりあえずdorca.shでシェルスクリプト用ファイルを作成します。

$ gedit dorca.sh

エディターが開いたら、下記スクリプトをコピペして、保存してください。

#!bin/sh
printf "password: "
read password

# install ORCA
echo "$password" | sudo -S wget -q https://ftp.orca.med.or.jp/pub/ubuntu/archive.key
sudo apt-key add archive.key
sudo wget -q -O \
/etc/apt/sources.list.d/jma-receipt-trusty48.list \
https://ftp.orca.med.or.jp/pub/ubuntu/jma-receipt-trusty48.list
sudo apt-get update
sudo apt-get -y dist-upgrade
echo "$password" | sudo -S apt-get install -y jma-receipt
wget https://ftp.orca.med.or.jp/pub/data/receipt/outline/update/claim_update.tar.gz
tar xvzf claim_update.tar.gz
sudo bash claim_update.sh
sudo jma-setup
sudo service jma-receipt start
sudo apt-get install -y panda-client2

# install OpenDolphin
sudo apt-get update
sudo apt-get install curl
sudo curl -sSL https://get.docker.com/|sh
sudo service docker start
sudo docker pull dolphindev/postgres
sudo docker pull dolphindev/wildfly

sudo docker run --name dolphin-db -p 5433:5432 -d dolphindev/postgres
sudo docker run --name dolphin-server --link dolphin-db:ds -p 8080:8080 -d dolphindev/wildfly
sudo docker run -d --name=rstudio -p 8787:8787  rocker/hadleyverse 

sudo service jma-receipt stop
sudo gedit /etc/postgresql/9.3/main/postgresql.conf
sudo gedit /etc/postgresql/9.3/main/pg_hba.conf 
sudo service postgresql stop 
sudo service postgresql start
sudo dpkg-reconfigure jma-receipt 
sudo service jma-receipt start
sudo ufw disable

# ORCApasswordの設定
sudo -u orca /usr/lib/jma-receipt/bin/passwd_store.sh

あとは、シェルスクリプトを実行するだけです。

$ sh dorca.sh

うちの通信環境とPCスペックだと、シェルスクリプトの実行時間は35分程度です。
途中ORCAの設定等の入力を求められますが、上記サイトに書いてある通り入力してください。

では今回のポイントのOpenDolphinとRstudioの接続です。
Rstudio serverはDockerコンテナで動いているので、仮想マシン(Ubuntu)のIPアドレスとポートをクライアントPCのブラウザーに入力します。
例)192.168.244.211:8787

f:id:r_beginner:20170303182547p:plain

UsernameとPasswordは共にrstudioです。
これでRstudio severに接続できます。
次にRstudioで新規ファイルを作成。

下記コードをコピペして、一行ずつ実行してみてください。

install.packages("RPostgreSQL")
library("RPostgreSQL")
library("dplyr")

con <- dbConnect(dbDriver("PostgreSQL"), 
                 host="192.168.244.211",  # 自分の環境のIPアドレスを入力
                 port="5433",
                 user= "postgres", 
                 dbname="dolphin",
                 password="postgres")
dbGetInfo(con)
dbListTables(con)
dbListFields(con, "d_stamp")
dbReadTable(con, "d_facility")
res <- dbSendQuery(con, "select * from demo_patient;") 
dbFetch(res) 
dbDisconnect(con)

dbConnectで接続オブジェクトを作って、dbListTablesでテーブルを確認したり

f:id:r_beginner:20170303203529j:plain

dbListFieldsでカラムを見たり

f:id:r_beginner:20170303203625j:plain

dbReadTableでテーブルを読み込んだり

f:id:r_beginner:20170303203700j:plain

ORCAから患者登録をして、OpenDolphinでカルテに書き込んで、Rstudioで実際にデータベースを確認してみると、いろいろアイデアが浮かんでくるかと思います。
楽しんでみてください。



参考サイト

DICOMserver構築②~Conquest・postgreSQL on Ubuntu16.04

以前DockerImageを使って、簡単なDICOMserver構築をブログにアップしましたが、今回は一つ一つコマンド入力しながらインストールして、データベースもPostgreSQLに変更してみます。

今回も仮想マシン(Ubuntu64bit 16.04LTS)上にサーバー構築します。
画像サーバーなので固定IPにしておきましょう。

基本は、下記サイトのインストール用ZIPファイル内にあるlinuxmanual.pdfに従って操作すれば問題ありません。
Conquest DICOM software
f:id:r_beginner:20170218215602j:plain
ちなみにpdfのマニュアルを見るときは、ZIPファイルの解凍先フォルダで

$ evince linuxmanual.pdf

です。

ではインストールを始めましょう。

sudo apt-get update
sudo apt-get  install g++ 
sudo apt-get -y install apache2 
sudo a2enmod cgi
sudo service apache2 restart

まず作業フォルダを作り、移動します。

mkdir conquest
cd conquest

つぎにPostgreSQLをインストールします。スーパーユーザーでデータベース(conquest)を作成します。

sudo apt-get -y install libpq-dev 
sudo apt-get -y install postgresql
sudo su                      # become superuser 
su – postgres                               # become postgres user 
psql                                        # set the password to postgres 
\password 
postgres 
postgres 
\q 
createdb conquest                           # create database conquest 
psql -l                                     # confirm database
exit 
exit

coquestフォルダーにZIPファイルを落としてきて、解凍し、コンパイルします。

cd conquest
wget http://ingenium.home.xs4all.nl/dicomserver/dicomserver1419.zip
unzip dicomserver1419.zip
chmod 777 maklinux
./maklinux         # compile and install web access 

f:id:r_beginner:20170219080202j:plain
2を選びPostgreSQLを選択します。

エラー出ますが無視。
f:id:r_beginner:20170218223303j:plain

conquestフォルダーで、

./dgate -v -r  # regenerate the database 
./dgate -v     # run the server 

ここもいろいろ言われますが…
f:id:r_beginner:20170218223557j:plain
f:id:r_beginner:20170218223612j:plain

これでサーバーは構築されています。ブラウザのアドレスバーに' http://localhost/cgi-bin/dgate?mode=top 'と入力すると。
f:id:r_beginner:20170218223816j:plain

次にクライアントのKPACSに接続するための設定です。

端末から、Ctrl+Cでサーバーを止めて、conquestフォルダを覗いてみます。

postgres@ubuntu:~/conquest$ ls -a

f:id:r_beginner:20170218224051j:plain

acrnema.mapが設定ファイルです。

gedit acrnema.map

f:id:r_beginner:20170218224245j:plain
KPServer(KPACS)のアドレスとポートを入力して、保存します。

./dgate -v

ブラウザで確認。
f:id:r_beginner:20170219080728j:plain

設定が反映されます。

クライアント側の設定も忘れずに。
f:id:r_beginner:20170218224541j:plain

これでKPACSとConquestが接続されているはずです。

Rstudio shortcut keys for writing code (Windows/Linux)


Introduction

To write code quickly like vim or emacs, it is better to use shortcuts. In this blog, I will explain shortcuts that I like and use frequently. For other shortcut keys which I don’t introduce ,please refer to the following site.


Transition

  • Move cursor to start of line : Home
  • Move cursor to end of line : End
  • Jump to word : Ctrl + Right/Left

Select Word

  • Ctrl + Shift + Right/Left

f:id:r_beginner:20170209180343g:plain


Select Line

  • Alt + Shift + Right/Left

f:id:r_beginner:20170211075438g:plain


Select All

  • Ctrl + A

f:id:r_beginner:20170211083124g:plain


Cut,Copy,Paste

  • Ctrl + X
  • Ctrl + C
  • Ctrl + V

Delete Line

  • Ctrl + D f:id:r_beginner:20170209180452g:plain

Yank line up to cursor/ after cursor

  • Ctrl + U/K f:id:r_beginner:20170209180523g:plain

Move Lines Up/Down

  • Alt + Up/Down f:id:r_beginner:20170209180654g:plain

Copy Lines Up/Down

  • Shift + Alt + Up/Down f:id:r_beginner:20170209180758g:plain

Ubdo,Redo

  • Ctrl + Z (e.g. after Ctrl+D)
  • Ctrl + Shift +Z f:id:r_beginner:20170211083654g:plain

(Un)Comment lines

  • Ctrl + Shift + C f:id:r_beginner:20170209180935g:plain

Insert ‘<-’ , ‘%>%’

  • Alt + -
  • Ctrl + Shift + M f:id:r_beginner:20170209181019g:plain

Reindent lines

  • Ctrl + I f:id:r_beginner:20170209181059g:plain

Select and Replace

  • Ctrl + Shift + Right/Left
  • Ctrl + Shift + Alt + M (Select -> Replace) f:id:r_beginner:20170211084018g:plain

Find and Replace

  • Ctrl + F
  • Ctrl + Shift + Alt + M (Find -> Replace) f:id:r_beginner:20170211084231g:plain

Find in Files

  • Ctrl + Shift + F

Add New Cursor Above/Below

  • Ctrl + Alt + :arrow_up:/:arrow_down: f:id:r_beginner:20170210081059g:plain

Reference

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

今回は、患者マスターデータを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アニメーションとか…。

電子カルテのサンプルデータ①

ここ2年ぐらい電子カルテについての話をする機会が何度かありました。ブログのタイトルにもあるようにR言語SQLデータベースからデータを抽出し、可視化したり、簡単な統計処理をしたりしました。電子カルテデータの二次利用について興味を持ってくれる医師もいますが、当院のデータベースを用いた話なのでコードをそのまま流用することができず、実際に自分の施設でデータを抽出するところまではいたらないようです。

R言語SQLデータベースについては、過去のブログで簡単な環境構築ついて触れておりますし、ネットの情報も非常に豊富なのでSQLデータベースを触ったり、R言語で前処理したり、グラフを描いたり、統計処理するのは可能かと思います。ただ電子カルテデータを用いた処理の練習は、自分の施設の電子カルテサーバーへのアクセス権の問題や、練習用のサンプルデータが無いこともあり、非常に難しい状況です。

逆に、電子カルテで用いられるようなSQLデータベースにサンプルデータをいれて提供できれば、実際の運用をR言語でシュミレーションできるので、R言語SQL言語の習得にも力が入るのではないでしょうか?

これから少しずつ仮想の医療データを作成し、SQLサーバーに落とし込んでいきたいと思います。R言語の習得やデータの前処理、統計処理の勉強に役に立てば幸いです。

ggplot2で人口ピラミッドを描く

まずはサンプルデータを落としてきます。

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

よく見る患者マスターは、こんなデータ構成かと思います。(下記はコンピューターでランダムに作成されたデータです)

> df %>% tail()
     facility_code    id        name            kana gender
995        1234567 10995   金田 彩華   かねだ あやか     女
996        1234567 10996     藤森 兼   ふじもり けん     男
997        1234567 10997   木村 誠一 きむら せいいち     男
998        1234567 10998     足立 優     あだち ゆう     女
999        1234567 10999   小堀 一輝   こほり かずき     男
1000       1234567 11000 阿久津 一代   あくつ かずよ     女
         birth address
995  1948/6/19  茨城県
996  1956/1/24  岐阜県
997   1961/8/2  沖縄県
998  1984/7/13  愛知県
999  1978/4/30  岐阜県
1000  1968/9/5  岩手県
>

年齢が必要なので、誕生日から年齢を計算します。性別も文字列を変更しておきます(性別データも電子カルテメーカー毎にまちまちなので下記コードで…)。

# birthベクトルから年齢計算
make.age <- function(birth){
  df <- NULL
  for(i in 1:length(birth)){
    df[i] <- (length(seq(as.Date(birth[i]), Sys.Date(), "year"))-1)
  }
  df
}
df$age <- make.age(df$birth)

# 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")

いちど確認。

> df %>% tail()
     facility_code    id        name            kana gender
995        1234567 10995   金田 彩華   かねだ あやか female
996        1234567 10996     藤森 兼   ふじもり けん   male
997        1234567 10997   木村 誠一 きむら せいいち   male
998        1234567 10998     足立 優     あだち ゆう female
999        1234567 10999   小堀 一輝   こほり かずき   male
1000       1234567 11000 阿久津 一代   あくつ かずよ female
         birth address age
995  1948/6/19  茨城県  68
996  1956/1/24  岐阜県  60
997   1961/8/2  沖縄県  55
998  1984/7/13  愛知県  32
999  1978/4/30  岐阜県  38
1000  1968/9/5  岩手県  48
>

年齢も、性別文字列変更もできてますね。
必要なデータのみtempにいれて、まず集計。

df[,c("gender","age")]->temp
result <- tapply(temp$age,temp$gender, hist, breaks=seq(0,100,5))

結果はこんな感じで返します。

> result
$female
$breaks
 [1]   0   5  10  15  20  25  30  35  40  45  50  55  60  65
[15]  70  75  80  85  90  95 100

$counts
 [1]  0  0  0  7 56 43 50 45 43 45 33 41 38 34 33 47  0  0  0
[20]  0

$density
 [1] 0.000000000 0.000000000 0.000000000 0.002718447
 [5] 0.021747573 0.016699029 0.019417476 0.017475728
 [9] 0.016699029 0.017475728 0.012815534 0.015922330
[13] 0.014757282 0.013203883 0.012815534 0.018252427
[17] 0.000000000 0.000000000 0.000000000 0.000000000

$mids
 [1]  2.5  7.5 12.5 17.5 22.5 27.5 32.5 37.5 42.5 47.5 52.5
[12] 57.5 62.5 67.5 72.5 77.5 82.5 87.5 92.5 97.5

$xname
[1] "X[[i]]"

$equidist
[1] TRUE

attr(,"class")
[1] "histogram"

$male
$breaks
 [1]   0   5  10  15  20  25  30  35  40  45  50  55  60  65
[15]  70  75  80  85  90  95 100

$counts
 [1]  0  0  0  8 42 43 35 43 32 38 40 44 47 39 35 39  0  0  0
[20]  0

$density
 [1] 0.000000000 0.000000000 0.000000000 0.003298969
 [5] 0.017319588 0.017731959 0.014432990 0.017731959
 [9] 0.013195876 0.015670103 0.016494845 0.018144330
[13] 0.019381443 0.016082474 0.014432990 0.016082474
[17] 0.000000000 0.000000000 0.000000000 0.000000000

$mids
 [1]  2.5  7.5 12.5 17.5 22.5 27.5 32.5 37.5 42.5 47.5 52.5
[12] 57.5 62.5 67.5 72.5 77.5 82.5 87.5 92.5 97.5

$xname
[1] "X[[i]]"

$equidist
[1] TRUE

attr(,"class")
[1] "histogram"

> 

必要なのは、result$(性別)$breaksとresult$(性別)$countsなので、取り出してデータフレームを作成します。
breaksは最後のデータが不要なので削除。カテゴリーの順序はlevelsで指定しておかないと後で順番がおかしくなるかも…
男女別に作ってrbindで結合。

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)

できたデータはこんな感じ。

> temp_all
   category counts gender
1       0 -      0   male
2       5 -      0   male
3      10 -      0   male
4      15 -      8   male
5      20 -     42   male
6      25 -     43   male
7      30 -     35   male
8      35 -     43   male
9      40 -     32   male
10     45 -     38   male
11     50 -     40   male
12     55 -     44   male
13     60 -     47   male
14     65 -     39   male
15     70 -     35   male
16     75 -     39   male
17     80 -      0   male
18     85 -      0   male
19     90 -      0   male
20     95 -      0   male
21      0 -      0 female
22      5 -      0 female
23     10 -      0 female
24     15 -     -7 female
25     20 -    -56 female
26     25 -    -43 female
27     30 -    -50 female
28     35 -    -45 female
29     40 -    -43 female
30     45 -    -45 female
31     50 -    -33 female
32     55 -    -41 female
33     60 -    -38 female
34     65 -    -34 female
35     70 -    -33 female
36     75 -    -47 female
37     80 -      0 female
38     85 -      0 female
39     90 -      0 female
40     95 -      0 female
> 

女性のカウント数に-1をかけているのは、あとでggplotで作図するためです。

brks <- seq(-60, 60, 20)
lbls = paste0(as.character(c(seq(60, 0, -20), seq(20, 60, 20))))

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"))

f:id:r_beginner:20170115152512j:plain

サンプルデータは適当に作った生年月日データなので、実際の分布とは大きく異なりますが、作図のイメージはできたかと思います。
時間があったら、ちゃんとしたサンプルデータに変更します。

〈追記〉
総務省統計局に年齢各性別人口(平成26年)のデータがありましたので、それからサンプリングして、20000人分の性別、年齢データを作ってみます。
ホームページのエクセルファイルから年齢別の人口を取り出し、CSVファイルにしてありますので、読み込んでみてください。

url <- getURL("https://raw.githubusercontent.com/Algo1970/EHR_data/master/Population_in_Japan.csv")
df <- read.csv(text = url, header = TRUE)

データの途中を確認してみます。

> df[40:50,]
   age  male female
40  39   954    928
41  40 1,006    979
42  41 1,022    998
43  42 1,004    977
44  43   976    955
45  44   948    928
46  45   931    917
47  46   910    898
48  47   907    894
49  48   707    702
50  49   874    867
> 

先程作ったデータと似ていますが、数字にカンマが入っています。これはマズイです。

df$male <- df$male %>% as.character() %>% gsub(",","",.) %>% as.numeric()
df$female <- df$female %>% as.character() %>% gsub(",","",.) %>% as.numeric()

gsub関数でカンマを外してから数値に変換します。
つぎに年齢ごと、性別ごとの確率を求めて、新しいカラムを作成します。

df$male.ratio <- round(df$male/sum(df$male),6)
df$female.ratio <- round(df$female/sum(df$female),6)

新しい確率カラムを確認してみます。

> df %>% head()
  age male female male.ratio female.ratio
1   0  524    496   0.008480     0.007604
2   1  533    508   0.008626     0.007788
3   2  534    508   0.008642     0.007788
4   3  548    519   0.008868     0.007956
5   4  534    509   0.008642     0.007803
6   5  534    510   0.008642     0.007818
> 

ちゃんとできていますね。
きれいなピラミッドが見たいので、10000人ずつサンプルと取ってみます。

sample(df$age,size=10000,replace = T,df$male.ratio) -> male.age
sample(df$age,size=10000,replace = T,df$female.ratio) -> female.age
male.df <- data.frame(gender=rep("male",length(male.age)),age=male.age)
female.df <- data.frame(gender=rep("female",length(female.age)),age=female.age)
temp <- rbind(male.df,female.df)

先ほどと同じ形のデータフレームができているか確認しましょう。

> temp %>% tail()
      gender age
19995 female  41
19996 female   0
19997 female   4
19998 female  38
19999 female  45
20000 female   5
>

大丈夫です。あとは先程と同じながれで、データを整形してプロットします。

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)
brks <- seq(-600, 600, 200)
lbls = paste0(as.character(c(seq(600, 0, -200), seq(200, 600, 200))))
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"))

f:id:r_beginner:20170115180915j:plain
こんどは美しい人口ピラミッドが作成されました。


参考