2x4 Lattice Barchart 在 R 中最低限度? [英] 2x4 Lattice Barchart minimally in R?

问题描述

两个不同测量会话的两个数据文件:ECG 和 B ECG.每个数据文件包含男性和女性.我想在 R 中最低限度地做 2 列 x 4 行 Lattice Barchart，其中以下是界面的草图.我可以做 2x2 条形图，请参阅下面的代码.肯定有一些比手动添加越来越多的行到代码末尾更简单的方法，这很难控制.

 ECG B.ECG女 女窦到达/AHB地高辛呋塞米心电图 B.ECG男 男窦到达/AHB地高辛呋塞米

数据心电图.csv

女 Nij,N11,N22,N33,N44,N21,N31,N32,N123窦，1.0,0.0,0.0,0.0,0.0,0.0,12.0,0.0Arr/AHB,1.0,0.0,0.0,0.1,0.0,0.0,20.9,0.0地高辛 arr,1.0,0.0,0.0,0.2,0.0,0.0,10.8,0.0呋塞米 arr,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,,,,,,,,,男 Nij,N11,N22,N33,N44,N21,N31,N32,N123窦，1.0,0.0,0.0,0.0,0.0,0.0,4.0,0.0Arr/AHB,1.0,0.0,0.0,0.0,0.0,0.0,24.0,0.0地高辛 arr,1.0,0.0,0.0,0.0,0.0,0.0,11.0,0.0呋塞米 arr,1.0,0.0,0.0,0.0,0.0,0.0,3.0,0.0

数据 b.ecg.csv

女 Nij,N11,N22,N33,N44,N21,N31,N32,N123窦，1.0,0.2,0.2,0.0,0.0,0.0,11.7,0.0Arr/AHB,1.2,0.0,1.8,3.8,0.0,0.0,15.1,0.1地高辛 arr,0.5,0.2,0.0,1.0,0.0,0.0,4.3,0.0呋塞米 arr,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,,,,,,,,,男 Nij,N11,N22,N33,N44,N21,N31,N32,N123窦，1.0,0.0,0.0,0.0,0.0,0.0,4.0,0.0Arr/AHB,1.0,3.2,0.0,4.3,0.0,0.0,16.5,0.0地高辛 arr,1.0,0.0,0.7,0.8,0.0,0.0,9.5,0.0呋塞米 arr,1.0,0.0,0.0,0.0,0.0,0.0,3.0,0.0

可以做 2x2 条形图但很难扩展到 2 col x 4 行条形图的代码，大约 1) 读取数据，和 2) 应用格状条形图

library("gridExtra")图书馆(格子")图书馆(重塑2")data.n <- read.csv("ecg.csv", sep=",", header = TRUE)[1:2,1:7]rownames(data.n) <- read.csv("ecg.csv", sep=",", header = TRUE)[1:2,1]data.n.female <- read.csv("ecg.csv", sep=",", header = TRUE)[1:2,1:7]rownames(data.n.female) <- read.csv("ecg.csv", sep=",", header = TRUE)[1:2,1]data.n.male <- read.csv("ecg.csv", sep=",", header = TRUE)[1:2,1:7]rownames(data.n.male) <- read.csv("ecg.csv", sep=",", header = TRUE)[1:2,1]data.b <- read.csv("b.ecg.csv", sep=",", header = TRUE)[1:2,1:7]rownames(data.b) <- read.csv("b.ecg.csv", sep=",", header = TRUE)[1:2,1]data.b.female <- read.csv("b.ecg.csv", sep=",", header = TRUE)[1:2,1:7]rownames(data.b.female) <- read.csv("b.ecg.csv", sep=",", header = TRUE)[1:2,1]data.b.male <- read.csv("b.ecg.csv", sep=",", header = TRUE)[1:2,1:7]rownames(data.b.male) <- read.csv("b.ecg.csv", sep=",", header = TRUE)[1:2,1]# https://stackoverflow.com/a/40693458/54964#1data.n[] <- lapply(data.n, function(x) as.numeric(as.character(x)))data.n$type <-心电图"data.n$ID <- rownames(data.n)data.b[] <- lapply(data.b, function(x) as.numeric(as.character(x)))data.b$type <- "b ecg"data.b$ID <- rownames(data.b)数据 <- rbind(data.n[names(data.b)], data.b)# 排列数据进行绘图dat.m <- 融化(dat)条形图(变量~值|ID，组=类型，数据=dat.m，auto.key=list(space='right'),原点=0)#2data.n.female[] <- lapply(data.n.female, function(x) as.numeric(as.character(x)))data.n.female$gender <-女性"data.n.female$ID <- rownames(data.n.female)data.n.male[] <- lapply(data.n.male, function(x) as.numeric(as.character(x)))data.n.male$gender <- "男性"data.n.male$ID <- rownames(data.n.male)data.b.female[] <- lapply(data.b.female, function(x) as.numeric(as.character(x)))data.b.female$gender <-女性"data.b.female$ID <- rownames(data.b.female)data.b.male[] <- lapply(data.b.male, function(x) as.numeric(as.character(x)))data.b.male$gender <-男性"data.b.male$ID <- rownames(data.b.male)dat.2 <- rbind(data.n.female[names(data.n.male)],data.b.female[names(data.b.male)],数据男，数据.b.男性)dat.2$type <- rep(c("ECG", "B ECG"), each=2)dat.2.m <-melt(dat.2, id=c("ID", "gender", "type"))条形图(变量~值|ID+类型，组=性别，数据=dat.2.m，auto.key=list(space='right')，原点=0)

图.1 输出 2x2 Lattice 条形图代码

在

以及用于轻松复制粘贴的完整代码这里.

Two data files of two different measurement sessions: ECG and B ECG. Each data file contains male and female. I want to do 2 column x 4 row Lattice Barchart minimally in R where the following is a draft of the interface. I can do 2x2 barchart, see code below. There must be some more minimal way than manually just adding more and more lines to the end of the code, which is difficult to control.

                     ECG    B.ECG
                     female female
  Sinus
  Arr/AHB
  Digoxin arr
  Furosemide arr
                     ECG    B.ECG
                     male   male
  Sinus
  Arr/AHB
  Digoxin arr
  Furosemide arr

Data ecg.csv

female Nij,N11,N22,N33,N44,N21,N31,N32,N123
Sinus,1.0,0.0,0.0,0.0,0.0,0.0,12.0,0.0
Arr/AHB,1.0,0.0,0.0,0.1,0.0,0.0,20.9,0.0
Digoxin arr,1.0,0.0,0.0,0.2,0.0,0.0,10.8,0.0
Furosemide arr,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0
,,,,,,,,
male Nij,N11,N22,N33,N44,N21,N31,N32,N123
Sinus,1.0,0.0,0.0,0.0,0.0,0.0,4.0,0.0
Arr/AHB,1.0,0.0,0.0,0.0,0.0,0.0,24.0,0.0
Digoxin arr,1.0,0.0,0.0,0.0,0.0,0.0,11.0,0.0
Furosemide arr,1.0,0.0,0.0,0.0,0.0,0.0,3.0,0.0

Data b.ecg.csv

female Nij,N11,N22,N33,N44,N21,N31,N32,N123
Sinus,1.0,0.2,0.2,0.0,0.0,0.0,11.7,0.0
Arr/AHB,1.2,0.0,1.8,3.8,0.0,0.0,15.1,0.1
Digoxin arr,0.5,0.2,0.0,1.0,0.0,0.0,4.3,0.0
Furosemide arr,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0
,,,,,,,,
male Nij,N11,N22,N33,N44,N21,N31,N32,N123
Sinus,1.0,0.0,0.0,0.0,0.0,0.0,4.0,0.0
Arr/AHB,1.0,3.2,0.0,4.3,0.0,0.0,16.5,0.0
Digoxin arr,1.0,0.0,0.7,0.8,0.0,0.0,9.5,0.0
Furosemide arr,1.0,0.0,0.0,0.0,0.0,0.0,3.0,0.0

Code which can do 2x2 barchart but difficult to expand to 2 col x 4 row barchart about 1) read data, and 2) apply Lattice barchart

library("gridExtra")
library("lattice")
library("reshape2")

data.n <- read.csv("ecg.csv", sep=",", header = TRUE)[1:2,1:7] 
rownames(data.n) <- read.csv("ecg.csv", sep=",", header = TRUE)[1:2,1] 
data.n.female <- read.csv("ecg.csv", sep=",", header = TRUE)[1:2,1:7] 
rownames(data.n.female) <- read.csv("ecg.csv", sep=",", header = TRUE)[1:2,1] 
data.n.male <- read.csv("ecg.csv", sep=",", header = TRUE)[1:2,1:7] 
rownames(data.n.male) <- read.csv("ecg.csv", sep=",", header = TRUE)[1:2,1] 

data.b <- read.csv("b.ecg.csv", sep=",", header = TRUE)[1:2,1:7] 
rownames(data.b) <- read.csv("b.ecg.csv", sep=",", header = TRUE)[1:2,1] 
data.b.female <- read.csv("b.ecg.csv", sep=",", header = TRUE)[1:2,1:7] 
rownames(data.b.female) <- read.csv("b.ecg.csv", sep=",", header = TRUE)[1:2,1] 
data.b.male <- read.csv("b.ecg.csv", sep=",", header = TRUE)[1:2,1:7] 
rownames(data.b.male) <- read.csv("b.ecg.csv", sep=",", header = TRUE)[1:2,1] 

# https://stackoverflow.com/a/40693458/54964
#1
data.n[] <- lapply(data.n, function(x) as.numeric(as.character(x)))
data.n$type <- "ecg"
data.n$ID <- rownames(data.n)

data.b[] <- lapply(data.b, function(x) as.numeric(as.character(x)))
data.b$type <- "b ecg"
data.b$ID <- rownames(data.b)

dat <- rbind(data.n[names(data.b)], data.b)
# Arrange data for plotting
dat.m <- melt(dat)

barchart(variable ~ value|ID, groups=type, data=dat.m,
                               auto.key=list(space='right'), 
                   origin=0
)

#2
data.n.female[] <- lapply(data.n.female, function(x) as.numeric(as.character(x)))
data.n.female$gender <- "female"
data.n.female$ID <- rownames(data.n.female)

data.n.male[] <- lapply(data.n.male, function(x) as.numeric(as.character(x)))
data.n.male$gender <- "male"
data.n.male$ID <- rownames(data.n.male)

data.b.female[] <- lapply(data.b.female, function(x) as.numeric(as.character(x)))
data.b.female$gender <- "female"
data.b.female$ID <- rownames(data.b.female)

data.b.male[] <- lapply(data.b.male, function(x) as.numeric(as.character(x)))
data.b.male$gender <- "male"
data.b.male$ID <- rownames(data.b.male)

dat.2 <- rbind(data.n.female[names(data.n.male)], 
  data.b.female[names(data.b.male)], 
  data.n.male, 
  data.b.male) 
dat.2$type <- rep(c("ECG", "B ECG"), each=2) 
dat.2.m <- melt(dat.2, id=c("ID", "gender", "type")) 
barchart(variable ~ value|ID+type, groups=gender, data=dat.2.m, auto.key=list(space='right'), 
  origin=0) 

Fig. 1 Output of 2x2 Lattice barchart code

Troubleshooting the answer here for my system

Output with the code 1 in the answer

Using male.Nij, gender, group as id variables Error in
layout_base(data, rows, drop = drop) : At least one layer must contain
all variables used for facetting Calls: <Anonymous> ...
facet_train_layout.grid -> layout_grid -> layout_base Execution halted

Output 2 with the code

Error in +geom_bar(stat = "identity", position = position_dodge()) : 
  invalid argument to unary operator
Execution halted

# Code
datm$male.Nij <- factor(datm$male.Nij, levels=lvs)
ggplot(datm, aes(variable, value, fill=gender)) 
  + geom_bar(stat="identity", position = position_dodge()) 
  + facet_grid(male.Nij ~ group) 
#  + facet_grid(factor(male.Nij, levels=lvs) ~ group) 
  + coord_flip()

System info

> library(ggplot2)
> sessionInfo()
R version 3.3.2 (2016-10-31)
Platform: x86_64-pc-linux-gnu (64-bit)
Running under: Debian GNU/Linux 8 (jessie)

locale:
 [1] LC_CTYPE=en_US.UTF-8       LC_NUMERIC=C              
 [3] LC_TIME=en_US.UTF-8        LC_COLLATE=en_US.UTF-8    
 [5] LC_MONETARY=en_US.UTF-8    LC_MESSAGES=en_US.UTF-8   
 [7] LC_PAPER=en_US.UTF-8       LC_NAME=C                 
 [9] LC_ADDRESS=C               LC_TELEPHONE=C            
[11] LC_MEASUREMENT=en_US.UTF-8 LC_IDENTIFICATION=C       

attached base packages:
[1] stats     graphics  grDevices utils     datasets  methods   base     

other attached packages:
[1] ggplot2_2.1.0

loaded via a namespace (and not attached):
[1] colorspace_1.3-0 scales_0.4.1     plyr_1.8.4       gtable_0.2.0    
[5] Rcpp_0.12.7      grid_3.3.2       munsell_0.4.3   

We noticed there is some differences in the handling + by ggplot2 versions. Final line to get the code work in the described system

ggplot(datm, aes(variable, value, fill=gender)) + geom_bar(stat="identity", position = position_dodge()) + facet_grid(male.Nij ~ group)

R: 3.3.2 backports
OS: Debian 8.5

解决方案

I think the best approach is to combine the data, and reshape for plotting

# Your data
# ECG
fem <- read.csv( text=
"female Nij,N11,N22,N33,N44,N21,N31,N32,N123
Sinus,1.0,0.0,0.0,0.0,0.0,0.0,12.0,0.0
Arr/AHB,1.0,0.0,0.0,0.1,0.0,0.0,20.9,0.0
Digoxin arr,1.0,0.0,0.0,0.2,0.0,0.0,10.8,0.0
Furosemide arr,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0")

male <- read.csv( text=
"male Nij,N11,N22,N33,N44,N21,N31,N32,N123
Sinus,1.0,0.0,0.0,0.0,0.0,0.0,4.0,0.0
Arr/AHB,1.0,0.0,0.0,0.0,0.0,0.0,24.0,0.0
Digoxin arr,1.0,0.0,0.0,0.0,0.0,0.0,11.0,0.0
Furosemide arr,1.0,0.0,0.0,0.0,0.0,0.0,3.0,0.0")

# Add gender grouping variable
fem$gender <- "female"
male$gender <- "male"
fem$group <- male$group <- "ECG"

# ECG  b
fem2 <- read.csv( text=
"female Nij,N11,N22,N33,N44,N21,N31,N32,N123
Sinus,1.0,0.2,0.2,0.0,0.0,0.0,11.7,0.0
Arr/AHB,1.2,0.0,1.8,3.8,0.0,0.0,15.1,0.1
Digoxin arr,0.5,0.2,0.0,1.0,0.0,0.0,4.3,0.0
Furosemide arr,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0")

male2 <- read.csv( text=
"male Nij,N11,N22,N33,N44,N21,N31,N32,N123
Sinus,1.0,0.0,0.0,0.0,0.0,0.0,4.0,0.0
Arr/AHB,1.0,3.2,0.0,4.3,0.0,0.0,16.5,0.0
Digoxin arr,1.0,0.0,0.7,0.8,0.0,0.0,9.5,0.0
Furosemide arr,1.0,0.0,0.0,0.0,0.0,0.0,3.0,0.0")

fem2$gender <- "female"
male2$gender <- "male"
fem2$group <- male2$group <- "ECG b"

Combine data and reshape

# you will need to check they are in the right order
dat <- rbind(setNames(fem, names(male)), male, 
             setNames(fem2, names(male)), male2)

# reshape data for plotting
library(reshape2)
datm <- melt(dat)

Lattice plot

library(lattice)

lvs = unique(dat$male.Nij) # for ordering facets    
barchart(variable ~ value|group + factor(male.Nij, levels=lvs), groups=gender, 
              data=datm, auto.key=list(space='right'), origin=0)

ggplot2 plot

library(ggplot2) # v2.1.0.9001

ggplot(datm, aes(variable, value, fill=gender)) + 
  geom_bar(stat="identity", position = position_dodge()) +
  facet_grid(factor(male.Nij, levels=lvs) ~ group) +
      coord_flip()

For earlier ggplot2 (v2.1.0) versions you may need to set the factor levels outside of facet_grid

datm$male.Nij <- factor(datm$male.Nij, levels=lvs)

 ggplot(datm, aes(variable, value, fill=gender)) + 
        geom_bar(stat="identity", position = position_dodge()) + 
        facet_grid(male.Nij ~ group) + 
        coord_flip()

and the full code for easy copy-pasting here.

这篇关于2x4 Lattice Barchart 在 R 中最低限度?的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！