R中的2x4格子条形图最少？ [英] 2x4 Lattice Barchart minimally in R?
问题描述
两个不同测量会话的两个数据文件： ECG 和 B ECG 。
每个数据文件包含男性和女性。
我想在R中最少做2列x 4行的格线条形图，其中以下是界面的草稿。
我可以做2x2条形图，见下面的代码。
必须有一些比手动更简单的方法，只是在代码的末尾添加越来越多的行，这很难控制。
心电图B.ECG
女性女性
窦性动脉
动脉/ AHB
地高辛或
呋塞米和
ECG B.ECG
男性男性
窦性
Arr / AHB
Digoxin或
呋塞米
数据ecg.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.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
呋塞米，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.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
呋塞米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.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
呋塞米，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
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
速尿胺，1.0,0.0,0.0,0.0,0.0,0.0,3.0,0.0
可以做2×2条形图的代码，但难以扩展到2×4行条形图，有关1）读取数据， 2）申请格子条形图
$ p $ lt; code> 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）< - 读取.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）
＃安排绘制数据
dat.m< - melt（dat）
barchart （变量值| 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。女性$性别< - 女性
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.男性$ ID < - rownames（data.n.male）
data.b.female []< - lapply（data.b.female，function（x）as.numeric（as。字符（x）））
data.b.female $性别< - 女性
da ta.b.female $ ID< - rownames（data.b.female）
data.b.male []< - lapply（data.b.male，function（x）as。数字（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），每个= 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）
图。 1个2x2格子条形码输出
疑难解答答案
以及用于轻松复制粘贴的完整代码此处。
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.
这篇关于R中的2x4格子条形图最少？的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！
