I have created a facet plot using ggplot which has 4 rows and 1 column with this code:
ggplot(data=c, aes(x=Time, y=X.mean, fill = Site, width=.1)) +
geom_bar(stat="identity", position=position_dodge(), width=0.5,colour="black", show_guide=FALSE) +
ylab(NULL) + xlab(NULL) +
geom_errorbar(aes(ymax= X.Passes.sd, ymin= 0),
size = 0.7, width = 0.3,position = position_dodge(0.9))+
scale_fill_manual(values=c("cadetblue2", "royalblue1", "mediumseagreen", "green4")) +
scale_y_continuous(breaks=number_ticks(12), expand = c(0, 0), limits=c(0,20)) +
scale_x_discrete(expand = c(0, 0), limits=c("17:00","18:00","19:00","20:00","21:00","22:00","23:00","00:00","01:00","02:00","03:00","04:00", "05:00", "06:00")) +
facet_wrap(~ Site, ncol=1,nrow=4)+
theme_bw() +
theme(strip.text.x = element_text(size=18))+
theme(axis.title.y=element_text(size = 18)) +
theme(panel.grid.minor=element_blank(), panel.grid.major=element_blank())+
theme(axis.text.x=element_text(angle = 45, hjust=1, vjust=1, size = 18))+
theme(axis.text.y=element_text(size = 18))+
theme(panel.border = element_blank())+
theme(axis.line = element_line(color = 'black'))+
theme(axis.title.y=element_text(vjust=0.3, size=20))+
theme(strip.background = element_rect(colour="white", fill="white"))+
theme(legend.position = "none")
The issue I have is that only the bottom plot has a solid black line on the x-axis. The 3 plots above do not have this line and only have a dashed line for each data point.
Does anyone know how I can put a solid line on the x-axis for all of these plots?
Thanks
Jon
Edit 1: Data
Date Site Passes
02/11/2013 RM1 85
03/11/2013 RM1 254
04/11/2013 RM1 636
05/11/2013 RM1 610
06/11/2013 RM1 408
07/11/2013 RM1 293
08/11/2013 RM1 388
09/11/2013 RM1 513
10/11/2013 RM1 190
11/11/2013 RM1 333
12/11/2013 RM1 264
13/11/2013 RM1 261
14/11/2013 RM1 364
15/11/2013 RM1 1
16/11/2013 RM1 238
17/11/2013 RM1 149
18/11/2013 RM1 242
19/11/2013 RM1 225
20/11/2013 RM1 196
21/11/2013 RM1 68
22/11/2013 RM1 292
23/11/2013 RM1 159
24/11/2013 RM1 65
25/11/2013 RM1 166
26/11/2013 RM1 44
27/11/2013 RM1 0
28/11/2013 RM1 56
29/11/2013 RM1 378
30/11/2013 RM1 34
01/12/2013 RM1 43
02/12/2013 RM1 518
03/12/2013 RM1 286
04/12/2013 RM1 175
05/12/2013 RM1 169
06/12/2013 RM1 138
07/12/2013 RM1 445
08/12/2013 RM1 1153
09/12/2013 RM1 616
10/12/2013 RM1 1
02/11/2013 RM2 1
03/11/2013 RM2 30
04/11/2013 RM2 210
05/11/2013 RM2 47
06/11/2013 RM2 8
07/11/2013 RM2 66
08/11/2013 RM2 3
09/11/2013 RM2 7
10/11/2013 RM2 4
11/11/2013 RM2 13
12/11/2013 RM2 16
13/11/2013 RM2 31
14/11/2013 RM2 4
15/11/2013 RM2 0
16/11/2013 RM2 9
17/11/2013 RM2 24
18/11/2013 RM2 5
19/11/2013 RM2 47
20/11/2013 RM2 12
21/11/2013 RM2 3
22/11/2013 RM2 43
23/11/2013 RM2 8
24/11/2013 RM2 15
25/11/2013 RM2 26
26/11/2013 RM2 2
27/11/2013 RM2 0
28/11/2013 RM2 0
29/11/2013 RM2 9
30/11/2013 RM2 2
01/12/2013 RM2 1
02/12/2013 RM2 45
03/12/2013 RM2 26
04/12/2013 RM2 6
05/12/2013 RM2 8
06/12/2013 RM2 0
07/12/2013 RM2 0
08/12/2013 RM2 0
09/12/2013 RM2 0
10/12/2013 RM2 0
03/11/2013 RM3 14
04/11/2013 RM3 100
05/11/2013 RM3 22
06/11/2013 RM3 6
07/11/2013 RM3 35
08/11/2013 RM3 12
09/11/2013 RM3 30
10/11/2013 RM3 33
11/11/2013 RM3 3
12/11/2013 RM3 40
13/11/2013 RM3 88
14/11/2013 RM3 5
15/11/2013 RM3 10
16/11/2013 RM3 10
17/11/2013 RM3 13
18/11/2013 RM3 13
19/11/2013 RM3 20
20/11/2013 RM3 12
21/11/2013 RM3 3
22/11/2013 RM3 31
23/11/2013 RM3 1
24/11/2013 RM3 23
25/11/2013 RM3 11
26/11/2013 RM3 2
27/11/2013 RM3 0
28/11/2013 RM3 1
29/11/2013 RM3 23
30/11/2013 RM3 0
01/12/2013 RM3 0
02/12/2013 RM3 9
03/12/2013 RM3 19
04/12/2013 RM3 6
05/12/2013 RM3 8
06/12/2013 RM3 1
07/12/2013 RM3 1
08/12/2013 RM3 35
09/12/2013 RM3 7
10/12/2013 RM3 0
04/11/2013 RM4 371
05/11/2013 RM4 110
06/11/2013 RM4 36
07/11/2013 RM4 55
08/11/2013 RM4 45
09/11/2013 RM4 44
10/11/2013 RM4 10
11/11/2013 RM4 27
12/11/2013 RM4 86
13/11/2013 RM4 116
14/11/2013 RM4 55
15/11/2013 RM4 0
16/11/2013 RM4 95
17/11/2013 RM4 28
18/11/2013 RM4 50
19/11/2013 RM4 69
20/11/2013 RM4 51
You might have found a solution already, but I've always just included the line geom_hline(yintercept=0) to add the x-axis origin line to my plots. Its a serious hack, but it also provides you some aesthetic control, and I haven't found a better work around.
Hard to tell without being able to produce your plot but does using scales = "free_x" in your facet wrap call solve the problem?
For example:
facet_wrap(~ Site, ncol=1,nrow=4, scales = "free_x")
Might be late to the party, but my solution for this is replacing ggplot2::facet_wrap by lemon::facet_rep_wrap.
Related
I have this data from an r package, where X is the dataset with all the data
library(ISLR)
data("Hitters")
X=Hitters
head(X)
here is one part of the data:
AtBat Hits HmRun Runs RBI Walks Years CAtBat CHits CHmRun CRuns CRBI CWalks League Division PutOuts Assists Errors Salary NewLeague
-Andy Allanson 293 66 1 30 29 14 1 293 66 1 30 29 14 A E 446 33 20 NA A
-Alan Ashby 315 81 7 24 38 39 14 3449 835 69 321 414 375 N W 632 43 10 475.0 N
-Alvin Davis 479 130 18 66 72 76 3 1624 457 63 224 266 263 A W 880 82 14 480.0 A
-Andre Dawson 496 141 20 65 78 37 11 5628 1575 225 828 838 354 N E 200 11 3 500.0 N
-Andres Galarraga 321 87 10 39 42 30 2 396 101 12 48 46 33 N E 805 40 4 91.5 N
-Alfredo Griffin 594 169 4 74 51 35 11 4408 1133 19 501 336 194 A W 282 421 25 750.0 A
I want to convert all the columns and the rows with non numeric values to zero, is there any simple way to do this.
I found here an example how to remove the rows for one column just but for more I have to do it for every column manually.
Is in r any function that does this for all columns and rows?
To remove non-numeric columns, perhaps something like this?
df %>%
select(which(sapply(., is.numeric)))
# AtBat Hits HmRun Runs RBI Walks Years CAtBat CHits CHmRun
#-Andy Allanson 293 66 1 30 29 14 1 293 66 1
#-Alan Ashby 315 81 7 24 38 39 14 3449 835 69
#-Alvin Davis 479 130 18 66 72 76 3 1624 457 63
#-Andre Dawson 496 141 20 65 78 37 11 5628 1575 225
#-Andres Galarraga 321 87 10 39 42 30 2 396 101 12
#-Alfredo Griffin 594 169 4 74 51 35 11 4408 1133 19
# CRuns CRBI CWalks PutOuts Assists Errors Salary
#-Andy Allanson 30 29 14 446 33 20 NA
#-Alan Ashby 321 414 375 632 43 10 475.0
#-Alvin Davis 224 266 263 880 82 14 480.0
#-Andre Dawson 828 838 354 200 11 3 500.0
#-Andres Galarraga 48 46 33 805 40 4 91.5
#-Alfredo Griffin 501 336 194 282 421 25 750.0
or
df %>%
select(-which(sapply(., function(x) is.character(x) | is.factor(x))))
Or much neater (thanks to #AntoniosK):
df %>% select_if(is.numeric)
Update
To additionally replace NAs with 0, you can do
df %>% select_if(is.numeric) %>% replace(is.na(.), 0)
# AtBat Hits HmRun Runs RBI Walks Years CAtBat CHits CHmRun
#-Andy Allanson 293 66 1 30 29 14 1 293 66 1
#-Alan Ashby 315 81 7 24 38 39 14 3449 835 69
#-Alvin Davis 479 130 18 66 72 76 3 1624 457 63
#-Andre Dawson 496 141 20 65 78 37 11 5628 1575 225
#-Andres Galarraga 321 87 10 39 42 30 2 396 101 12
#-Alfredo Griffin 594 169 4 74 51 35 11 4408 1133 19
# CRuns CRBI CWalks PutOuts Assists Errors Salary
#-Andy Allanson 30 29 14 446 33 20 0.0
#-Alan Ashby 321 414 375 632 43 10 475.0
#-Alvin Davis 224 266 263 880 82 14 480.0
#-Andre Dawson 828 838 354 200 11 3 500.0
#-Andres Galarraga 48 46 33 805 40 4 91.5
#-Alfredo Griffin 501 336 194 282 421 25 750.0
library(ISLR)
data("Hitters")
d = head(Hitters)
library(dplyr)
d %>%
mutate_if(function(x) !is.numeric(x), function(x) 0) %>% # if column is non numeric add zeros
mutate_all(function(x) ifelse(is.na(x), 0, x)) # if there is an NA element replace it with 0
# AtBat Hits HmRun Runs RBI Walks Years CAtBat CHits CHmRun CRuns CRBI CWalks League Division PutOuts Assists Errors Salary NewLeague
# 1 293 66 1 30 29 14 1 293 66 1 30 29 14 0 0 446 33 20 0.0 0
# 2 315 81 7 24 38 39 14 3449 835 69 321 414 375 0 0 632 43 10 475.0 0
# 3 479 130 18 66 72 76 3 1624 457 63 224 266 263 0 0 880 82 14 480.0 0
# 4 496 141 20 65 78 37 11 5628 1575 225 828 838 354 0 0 200 11 3 500.0 0
# 5 321 87 10 39 42 30 2 396 101 12 48 46 33 0 0 805 40 4 91.5 0
# 6 594 169 4 74 51 35 11 4408 1133 19 501 336 194 0 0 282 421 25 750.0 0
If you want to avoid function(x) you can use this
d %>%
mutate_if(Negate(is.numeric), ~0) %>%
mutate_all(~ifelse(is.na(.), 0, .))
You can get the numeric columns with sapply/inherits.
X <- Hitters
inx <- sapply(X, inherits, c("integer", "numeric"))
Y <- X[inx]
Then, it wouldn't make much sense to remove the rows with non-numeric entries, they were already removed, but you could do
inx <- apply(Y, 1, function(y) all(inherits(y, c("integer", "numeric"))))
Y[inx, ]
Using the data.frame below (Source: http://eric.univ-lyon2.fr/~ricco/tanagra/fichiers/en_Tanagra_PLSR_Software_Comparison.pdf)
Data
df <- read.table(text = c("
diesel twodoors sportsstyle wheelbase length width height curbweight enginesize horsepower horse_per_weight conscity price symboling
0 1 0 97 172 66 56 2209 109 85 0.0385 8.7 7975 2
0 0 0 100 177 66 54 2337 109 102 0.0436 9.8 13950 2
0 0 0 116 203 72 57 3740 234 155 0.0414 14.7 34184 -1
0 1 1 103 184 68 52 3016 171 161 0.0534 12.4 15998 3
0 0 0 101 177 65 54 2765 164 121 0.0438 11.2 21105 0
0 1 0 90 169 65 52 2756 194 207 0.0751 13.8 34028 3
1 0 0 105 175 66 54 2700 134 72 0.0267 7.6 18344 0
0 0 0 108 187 68 57 3020 120 97 0.0321 12.4 11900 0
0 0 1 94 157 64 51 1967 90 68 0.0346 7.6 6229 1
0 1 0 95 169 64 53 2265 98 112 0.0494 9.0 9298 1
1 0 0 96 166 64 53 2275 110 56 0.0246 6.9 7898 0
0 1 0 100 177 66 53 2507 136 110 0.0439 12.4 15250 2
0 1 1 94 157 64 51 1876 90 68 0.0362 6.4 5572 1
0 0 0 95 170 64 54 2024 97 69 0.0341 7.6 7349 1
0 1 1 95 171 66 52 2823 152 154 0.0546 12.4 16500 1
0 0 0 103 175 65 60 2535 122 88 0.0347 9.8 8921 -1
0 0 0 113 200 70 53 4066 258 176 0.0433 15.7 32250 0
0 0 0 95 165 64 55 1938 97 69 0.0356 7.6 6849 1
1 0 0 97 172 66 56 2319 97 68 0.0293 6.4 9495 2
0 0 0 97 172 66 56 2275 109 85 0.0374 8.7 8495 2"), header = T)
and this
Code
library(pls)
Y <- as.matrix(df[,14])
X <- as.matrix(df[,1:11])
df.pls <- mvr(Y ~ X, ncomp = 3, method = "oscorespls", scale = T)
plot(df.pls, "biplot")
I got this
Biplot
Any help to plot the pls biplot using ggplot2 will be appreciated?
#Read data
df <- read.table(text = c("
diesel twodoors sportsstyle wheelbase length width height curbweight enginesize horsepower horse_per_weight conscity price symboling
0 1 0 97 172 66 56 2209 109 85 0.0385 8.7 7975 2
0 0 0 100 177 66 54 2337 109 102 0.0436 9.8 13950 2
0 0 0 116 203 72 57 3740 234 155 0.0414 14.7 34184 -1
0 1 1 103 184 68 52 3016 171 161 0.0534 12.4 15998 3
0 0 0 101 177 65 54 2765 164 121 0.0438 11.2 21105 0
0 1 0 90 169 65 52 2756 194 207 0.0751 13.8 34028 3
1 0 0 105 175 66 54 2700 134 72 0.0267 7.6 18344 0
0 0 0 108 187 68 57 3020 120 97 0.0321 12.4 11900 0
0 0 1 94 157 64 51 1967 90 68 0.0346 7.6 6229 1
0 1 0 95 169 64 53 2265 98 112 0.0494 9.0 9298 1
1 0 0 96 166 64 53 2275 110 56 0.0246 6.9 7898 0
0 1 0 100 177 66 53 2507 136 110 0.0439 12.4 15250 2
0 1 1 94 157 64 51 1876 90 68 0.0362 6.4 5572 1
0 0 0 95 170 64 54 2024 97 69 0.0341 7.6 7349 1
0 1 1 95 171 66 52 2823 152 154 0.0546 12.4 16500 1
0 0 0 103 175 65 60 2535 122 88 0.0347 9.8 8921 -1
0 0 0 113 200 70 53 4066 258 176 0.0433 15.7 32250 0
0 0 0 95 165 64 55 1938 97 69 0.0356 7.6 6849 1
1 0 0 97 172 66 56 2319 97 68 0.0293 6.4 9495 2
0 0 0 97 172 66 56 2275 109 85 0.0374 8.7 8495 2"), header = T)
#Run OP's code
library(pls)
library(ggplot2)
Y <- as.matrix(df[,14])
X <- as.matrix(df[,1:11])
df.pls <- mvr(Y ~ X, ncomp = 3, method = "oscorespls", scale = T)
#Extract information from mvr object
df2<-df.pls$scores
comp1a<-df2[,1]
comp2a<-df2[,2]
df2<-as.data.frame(cbind(comp1a, comp2a))
df1<-df.pls$loadings
comp1<-df1[,1]
comp2<-df1[,2]
names<-df1[,0]
df1<-as.data.frame(cbind(names, comp1, comp2))
#Generate two plots and overlay
#Plot 1
p1<-ggplot(data=df1, aes(comp1,comp2))+
ylab("")+xlab("")+ggtitle("X scores and X Loadings")+
theme_bw() + theme(panel.border = element_rect(colour = "black", fill=NA, size=1),panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
axis.line = element_line(colour = "black"))+
geom_text(aes(label=rownames(df1)), color="red")+
scale_x_continuous(breaks = c(-0.6,-0.4,-0.2,0,0.2,0.4,0.6))+
scale_y_continuous(breaks = c(-0.6,-0.4,-0.2,0,0.2,0.4,0.6))+
coord_fixed(ylim=c(-0.6, 0.6),xlim=c(-0.6, 0.6))+
theme(axis.ticks = element_line(colour = "red")) +
theme(axis.text.y=element_text(angle = 90, hjust = 0.65)) +
theme(axis.text.y = element_text(margin=margin(10,10,10,5,"pt")))
#Plot 2
p2<-ggplot(data=df2, aes(comp1a,comp2a))+
ylab("Comp 2")+xlab("Comp 1")+ggtitle("X scores and X Loadings")+
theme_bw() + theme(panel.border = element_rect(colour = "black", fill=NA, size=1),
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
axis.line = element_line(colour = "black"))+
geom_text(aes(label=rownames(df2)))+
xlim(-4,4)+ylim(-4,4)+
scale_y_continuous(breaks = c(-4,-2,0,2))+
coord_cartesian(ylim=c(-4, 4))+
scale_x_continuous(breaks = c(-4,-2,0,2)) +
theme(plot.title = element_text(face="bold"))+
theme(axis.text.y=element_text(angle = 90, hjust = 0.65))
#Function to overlay plots in order to get two graphs with different axes on same plot
library(grid)
library(gtable)
ggplot_dual_axis = function(plot1, plot2, which.axis = "x") {
# Update plot with transparent panel
plot2 = plot2 + theme(panel.background = element_rect(fill = NA))
grid.newpage()
# Increase right margin if which.axis == "y"
if(which.axis == "y") plot1 = plot1 + theme(plot.margin = unit(c(0.7, 1.5, 0.4, 0.4), "cm"))
# Extract gtable
g1 = ggplot_gtable(ggplot_build(plot1))
g2 = ggplot_gtable(ggplot_build(plot2))
# Overlap the panel of the second plot on that of the first
pp = c(subset(g1$layout, name == "panel", se = t:r))
g = gtable_add_grob(g1, g2$grobs[[which(g2$layout$name=="panel")]], pp$t, pp$l, pp$b, pp$l)
# Steal axis from second plot and modify
axis.lab = ifelse(which.axis == "x", "axis-b", "axis-l")
ia = which(g2$layout$name == axis.lab)
ga = g2$grobs[[ia]]
ax = ga$children[[2]]
# Switch position of ticks and labels
if(which.axis == "x") ax$heights = rev(ax$heights) else ax$widths = rev(ax$widths)
ax$grobs = rev(ax$grobs)
if(which.axis == "x")
ax$grobs[[2]]$y = ax$grobs[[2]]$y - unit(1, "npc") + unit(0.15, "cm") else
ax$grobs[[1]]$x = ax$grobs[[1]]$x - unit(1, "npc") + unit(0.15, "cm")
# Modify existing row to be tall enough for axis
if(which.axis == "x") g$heights[[2]] = g$heights[g2$layout[ia,]$t]
# Add new row or column for axis label
if(which.axis == "x") {
g = gtable_add_grob(g, ax, 2, 4, 2, 4)
g = gtable_add_rows(g, g2$heights[1], 1)
g = gtable_add_grob(g, g2$grob[[6]], 2, 4, 2, 4)
} else {
g = gtable_add_cols(g, g2$widths[g2$layout[ia, ]$l], length(g$widths) - 1)
g = gtable_add_grob(g, ax, pp$t, length(g$widths) - 1, pp$b)
g = gtable_add_grob(g, g2$grob[[7]], pp$t, length(g$widths), pp$b - 1)
}
# Draw it
grid.draw(g)
}
#Run function on individual plots
ggplot_dual_axis(p2, p1, "y")
Using the data.frame below (Source: http://eric.univ-lyon2.fr/~ricco/tanagra/fichiers/en_Tanagra_PLSR_Software_Comparison.pdf)
Data
df <- read.table(text = c("
diesel twodoors sportsstyle wheelbase length width height curbweight enginesize horsepower horse_per_weight conscity price symboling
0 1 0 97 172 66 56 2209 109 85 0.0385 8.7 7975 2
0 0 0 100 177 66 54 2337 109 102 0.0436 9.8 13950 2
0 0 0 116 203 72 57 3740 234 155 0.0414 14.7 34184 -1
0 1 1 103 184 68 52 3016 171 161 0.0534 12.4 15998 3
0 0 0 101 177 65 54 2765 164 121 0.0438 11.2 21105 0
0 1 0 90 169 65 52 2756 194 207 0.0751 13.8 34028 3
1 0 0 105 175 66 54 2700 134 72 0.0267 7.6 18344 0
0 0 0 108 187 68 57 3020 120 97 0.0321 12.4 11900 0
0 0 1 94 157 64 51 1967 90 68 0.0346 7.6 6229 1
0 1 0 95 169 64 53 2265 98 112 0.0494 9.0 9298 1
1 0 0 96 166 64 53 2275 110 56 0.0246 6.9 7898 0
0 1 0 100 177 66 53 2507 136 110 0.0439 12.4 15250 2
0 1 1 94 157 64 51 1876 90 68 0.0362 6.4 5572 1
0 0 0 95 170 64 54 2024 97 69 0.0341 7.6 7349 1
0 1 1 95 171 66 52 2823 152 154 0.0546 12.4 16500 1
0 0 0 103 175 65 60 2535 122 88 0.0347 9.8 8921 -1
0 0 0 113 200 70 53 4066 258 176 0.0433 15.7 32250 0
0 0 0 95 165 64 55 1938 97 69 0.0356 7.6 6849 1
1 0 0 97 172 66 56 2319 97 68 0.0293 6.4 9495 2
0 0 0 97 172 66 56 2275 109 85 0.0374 8.7 8495 2"), header = T)
and this
Code
library(plsdepot)
df.plsdepot = plsreg1(df[, 1:11], df[, 14, drop = FALSE], comps = 3)
plot(df.plsdepot, comps = c(1, 2))
I got this
Result
The dependent (y) variable here is symboling, like price, is function of all other independent variables for the cars (diesel, twodoors, sportsstyle, wheelbase, length, width, height, curbweight, enginesize,horsepower, horse_per_weight)
Question
Any help to create the plot above using ggplot2 but with arrows instead of lines similar to this plot will be highly appreciated?
df <- read.table(text = c("
diesel twodoors sportsstyle wheelbase length width height curbweight enginesize horsepower horse_per_weight conscity price symboling
0 1 0 97 172 66 56 2209 109 85 0.0385 8.7 7975 2
0 0 0 100 177 66 54 2337 109 102 0.0436 9.8 13950 2
0 0 0 116 203 72 57 3740 234 155 0.0414 14.7 34184 -1
0 1 1 103 184 68 52 3016 171 161 0.0534 12.4 15998 3
0 0 0 101 177 65 54 2765 164 121 0.0438 11.2 21105 0
0 1 0 90 169 65 52 2756 194 207 0.0751 13.8 34028 3
1 0 0 105 175 66 54 2700 134 72 0.0267 7.6 18344 0
0 0 0 108 187 68 57 3020 120 97 0.0321 12.4 11900 0
0 0 1 94 157 64 51 1967 90 68 0.0346 7.6 6229 1
0 1 0 95 169 64 53 2265 98 112 0.0494 9.0 9298 1
1 0 0 96 166 64 53 2275 110 56 0.0246 6.9 7898 0
0 1 0 100 177 66 53 2507 136 110 0.0439 12.4 15250 2
0 1 1 94 157 64 51 1876 90 68 0.0362 6.4 5572 1
0 0 0 95 170 64 54 2024 97 69 0.0341 7.6 7349 1
0 1 1 95 171 66 52 2823 152 154 0.0546 12.4 16500 1
0 0 0 103 175 65 60 2535 122 88 0.0347 9.8 8921 -1
0 0 0 113 200 70 53 4066 258 176 0.0433 15.7 32250 0
0 0 0 95 165 64 55 1938 97 69 0.0356 7.6 6849 1
1 0 0 97 172 66 56 2319 97 68 0.0293 6.4 9495 2
0 0 0 97 172 66 56 2275 109 85 0.0374 8.7 8495 2"), header = T)
library(plsdepot)
library(ggplot2)
df.plsdepot = plsreg1(df[, 1:11], df[, 14, drop = FALSE], comps = 3)
data<-df.plsdepot$cor.xyt
data<-as.data.frame(data)
#Function to draw circle
circleFun <- function(center = c(0,0),diameter = 1, npoints = 100){
r = diameter / 2
tt <- seq(0,2*pi,length.out = npoints)
xx <- center[1] + r * cos(tt)
yy <- center[2] + r * sin(tt)
return(data.frame(x = xx, y = yy))
}
dat <- circleFun(c(0,0),2,npoints = 100)
ggplot(data=data, aes(t1,t2))+
ylab("")+xlab("")+ggtitle("Circle of Correlations ")+
theme_bw() +geom_text(aes(label=rownames(data),
colour=ifelse(rownames(data)!='symboling', 'orange','blue')))+
scale_color_manual(values=c("orange","#6baed6"))+
scale_x_continuous(breaks = c(-1,-0.5,0,0.5,1))+
scale_y_continuous(breaks = c(-1,-0.5,0,0.5,1))+
coord_fixed(ylim=c(-1, 1),xlim=c(-1, 1))+xlab("axis 1")+
ylab("axis 2")+ theme(axis.line.x = element_line(color="darkgrey"),
axis.line.y = element_line(color="darkgrey"))+
geom_path(data=dat,aes(x,y), colour = "darkgrey")+
theme(legend.title=element_blank())+
theme(axis.ticks = element_line(colour = "grey"))+
theme(axis.title = element_text(colour = "darkgrey"))+
theme(axis.text = element_text(color="darkgrey"))+
theme(legend.position='none')+
theme(plot.title = element_text(color="#737373")) +
theme(panel.grid.minor = element_blank()) +
annotate("segment",x=0, y=0, xend= 0.60, yend= 0.20, color="orange",
arrow=arrow(length=unit(0.3,"cm")))+
annotate("segment",x=0, y=0, xend= -0.25, yend= -0.35, color="#6baed6",
alpha=0.3,arrow=arrow(length=unit(0.3,"cm")))+
annotate("segment",x=0, y=0, xend= 0.45, yend= 0.75, color="#6baed6",
alpha=0.3,arrow=arrow(length=unit(0.3,"cm")))+
annotate("segment",x=0, y=0, xend= 0.37 , yend=-0.02, color="#6baed6",
alpha=0.3,arrow=arrow(length=unit(0.3,"cm")))+
annotate("segment",x=0, y=0, xend= -0.80, yend= 0.30, color="#6baed6",
alpha=0.3,arrow=arrow(length=unit(0.3,"cm")))+
annotate("segment",x=0, y=0, xend= -0.75, yend= 0.60, color="#6baed6",
alpha=0.3,arrow=arrow(length=unit(0.3,"cm")))+
annotate("segment",x=0, y=0, xend= -0.67, yend= 0.60, color="#6baed6",
alpha=0.3,arrow=arrow(length=unit(0.3,"cm")))+
annotate("segment",x=0, y=0, xend= -0.59, yend= -0.13, color="#6baed6",
alpha=0.3,arrow=arrow(length=unit(0.3,"cm")))+
annotate("segment",x=0, y=0, xend= -0.59, yend= 0.70, color="#6baed6",
alpha=0.3,arrow=arrow(length=unit(0.3,"cm")))+
annotate("segment",x=0, y=0, xend= -0.39, yend= 0.80, color="#6baed6",
alpha=0.3,arrow=arrow(length=unit(0.3,"cm")))+
annotate("segment",x=0, y=0, xend= 0.04, yend= 0.93, color="#6baed6",
alpha=0.3,arrow=arrow(length=unit(0.3,"cm")))+
annotate("segment",x=0, y=0, xend= 0.70, yend= 0.40, color="#6baed6",
alpha=0.3,arrow=arrow(length=unit(0.3,"cm")))
I am trying to create a line graph with error regions (instead of error bars). This is my data:
data <- read.table(text = "
Water_mass Time Abundance Mean sd Upper Lower
1 FRONT 1 265 281.75000 54.524459 336.27446 227.22554
2 FRONT 1 359 281.75000 54.524459 336.27446 227.22554
3 FRONT 1 272 281.75000 54.524459 336.27446 227.22554
4 FRONT 1 231 281.75000 54.524459 336.27446 227.22554
5 FRONT 188 40 57.80000 19.227584 77.02758 38.57242
6 FRONT 188 57 57.80000 19.227584 77.02758 38.57242
7 FRONT 188 38 57.80000 19.227584 77.02758 38.57242
8 FRONT 188 73 57.80000 19.227584 77.02758 38.57242
9 FRONT 188 81 57.80000 19.227584 77.02758 38.57242
10 FRONT 353 131 346.25000 253.898109 600.14811 92.35189
11 FRONT 353 622 346.25000 253.898109 600.14811 92.35189
12 FRONT 353 502 346.25000 253.898109 600.14811 92.35189
13 FRONT 353 130 346.25000 253.898109 600.14811 92.35189
14 FRONT 434 38 47.50000 13.435029 60.93503 34.06497
15 FRONT 434 57 47.50000 13.435029 60.93503 34.06497
16 FRONT 476 52 49.50000 3.535534 53.03553 45.96447
17 FRONT 476 47 49.50000 3.535534 53.03553 45.96447
18 NW 1 232 232.00000 NA NA NA
19 NW 154 140 138.50000 2.121320 140.62132 136.37868
20 NW 154 137 138.50000 2.121320 140.62132 136.37868
21 NW 188 252 253.00000 1.414214 254.41421 251.58579
22 NW 188 254 253.00000 1.414214 254.41421 251.58579
23 NW 353 3846 1957.50000 2670.742313 4628.24231 -713.24231
24 NW 353 69 1957.50000 2670.742313 4628.24231 -713.24231
25 NW 434 162 181.75000 80.748065 262.49806 101.00194
26 NW 434 93 181.75000 80.748065 262.49806 101.00194
27 NW 434 184 181.75000 80.748065 262.49806 101.00194
28 NW 434 288 181.75000 80.748065 262.49806 101.00194
29 NW 476 149 181.00000 45.254834 226.25483 135.74517
30 NW 476 213 181.00000 45.254834 226.25483 135.74517
31 SAW 1 143 147.16667 13.717386 160.88405 133.44928
32 SAW 1 137 147.16667 13.717386 160.88405 133.44928
33 SAW 1 170 147.16667 13.717386 160.88405 133.44928
34 SAW 1 149 147.16667 13.717386 160.88405 133.44928
35 SAW 1 153 147.16667 13.717386 160.88405 133.44928
36 SAW 1 131 147.16667 13.717386 160.88405 133.44928
37 SAW 154 79 61.66667 11.269428 72.93609 50.39724
38 SAW 154 65 61.66667 11.269428 72.93609 50.39724
39 SAW 154 52 61.66667 11.269428 72.93609 50.39724
40 SAW 154 48 61.66667 11.269428 72.93609 50.39724
41 SAW 154 74 61.66667 11.269428 72.93609 50.39724
42 SAW 154 52 61.66667 11.269428 72.93609 50.39724
43 SAW 154 51 61.66667 11.269428 72.93609 50.39724
44 SAW 154 69 61.66667 11.269428 72.93609 50.39724
45 SAW 154 65 61.66667 11.269428 72.93609 50.39724
46 SAW 188 68 55.50000 9.327379 64.82738 46.17262
47 SAW 188 47 55.50000 9.327379 64.82738 46.17262
48 SAW 188 57 55.50000 9.327379 64.82738 46.17262
49 SAW 188 50 55.50000 9.327379 64.82738 46.17262
50 SAW 353 868 696.60000 229.660184 926.26018 466.93982
51 SAW 353 728 696.60000 229.660184 926.26018 466.93982
52 SAW 353 354 696.60000 229.660184 926.26018 466.93982
53 SAW 353 930 696.60000 229.660184 926.26018 466.93982
54 SAW 353 603 696.60000 229.660184 926.26018 466.93982
55 SAW 434 31 31.57143 6.106203 37.67763 25.46523
56 SAW 434 33 31.57143 6.106203 37.67763 25.46523
57 SAW 434 19 31.57143 6.106203 37.67763 25.46523
58 SAW 434 30 31.57143 6.106203 37.67763 25.46523
59 SAW 434 35 31.57143 6.106203 37.67763 25.46523
60 SAW 434 36 31.57143 6.106203 37.67763 25.46523
61 SAW 434 37 31.57143 6.106203 37.67763 25.46523
62 SAW 476 96 60.75000 24.185050 84.93505 36.56495
63 SAW 476 54 60.75000 24.185050 84.93505 36.56495
64 SAW 476 41 60.75000 24.185050 84.93505 36.56495
65 SAW 476 52 60.75000 24.185050 84.93505 36.56495
66 STW 1 194 177.66667 20.256686 197.92335 157.40998
67 STW 1 184 177.66667 20.256686 197.92335 157.40998
68 STW 1 155 177.66667 20.256686 197.92335 157.40998
69 STW 154 44 49.66667 6.658328 56.32499 43.00834
70 STW 154 57 49.66667 6.658328 56.32499 43.00834
71 STW 154 48 49.66667 6.658328 56.32499 43.00834
72 STW 188 185 101.33333 72.500575 173.83391 28.83276
73 STW 188 57 101.33333 72.500575 173.83391 28.83276
74 STW 188 62 101.33333 72.500575 173.83391 28.83276
75 STW 353 2846 3367.66667 890.594371 4258.26104 2477.07230
76 STW 353 2861 3367.66667 890.594371 4258.26104 2477.07230
77 STW 353 4396 3367.66667 890.594371 4258.26104 2477.07230
78 STW 434 73 54.50000 26.162951 80.66295 28.33705
79 STW 434 36 54.50000 26.162951 80.66295 28.33705
80 STW 476 100 135.20000 31.523007 166.72301 103.67699
81 STW 476 115 135.20000 31.523007 166.72301 103.67699
82 STW 476 180 135.20000 31.523007 166.72301 103.67699
83 STW 476 129 135.20000 31.523007 166.72301 103.67699
84 STW 476 152 135.20000 31.523007 166.72301 103.67699
", header = TRUE)
Using this code, I am able to create a graph that is similar to what I want:
ggplot(data,aes(x=Time,y=Abundance,col=Water_mass))+ geom_point() + ylab("Abundance")+ xlab("Time (days)") +
theme_bw() +
theme(axis.line = element_line(colour = "black"),
panel.grid.major = element_blank(),
panel.border = element_rect(colour = "lightgray", fill=NA),
panel.background = element_blank())+
theme(strip.background = element_blank()) +
labs(colour="Water mass") +
geom_point(size=3) +
scale_y_continuous(limit=c(0,NA),oob=squish) +
geom_ribbon(aes(ymin = b$Lower, ymax = b$Upper, fill = b$Water_mass), data= b, alpha = 0.2, show.legend = FALSE, colour=NA)+
geom_line(aes(y=Mean, colour=Water_mass), data= b, size=1.5)
However, I would prefer it if the lines were smoothed. I was able to smooth the mean, but not the confidence regions:
ggplot(data,aes(x=Time,y=Abundance,col=Water_mass))+ geom_point() +
ylab("Abundance")+ xlab("Time (days)") +
theme_bw() +
theme(axis.line = element_line(colour = "black"),
panel.grid.major = element_blank(),
panel.border = element_rect(colour = "lightgray", fill=NA),
panel.background = element_blank())+
theme(strip.background = element_blank()) +
labs(colour="Water mass") +
geom_point(size=3) +
scale_y_continuous(limit=c(0,NA),oob=squish) +
geom_ribbon(aes(ymin = b$Lower, ymax = b$Upper, fill = b$Water_mass), data= b, alpha = 0.2, show.legend = FALSE, colour=NA)+
stat_smooth(se=F, size=1.5)
Is it possible to smooth the confidence regions too?
I have also tried this, which looks the way I want, except that it shows 95% confidence intervals for the mean, instead of some measure of spread of the data:
ggplot(data,aes(x=Time,y=Abundance,col=Water_mass))+ geom_point() + ylab("Abundance")+ xlab("Time (days)") +
theme_bw() +
theme(axis.line = element_line(colour = "black"),
panel.grid.major = element_blank(),
panel.border = element_rect(colour = "lightgray", fill=NA),
panel.background = element_blank())+
theme(strip.background = element_blank()) +
labs(colour="Water mass") + geom_point(size=3) +
geom_smooth(method="auto", se=TRUE, fullrange=FALSE, level=0.95, aes(fill = Water_mass), show.legend = FALSE) +
scale_y_continuous(limit=c(0,NA),oob=squish)
I would like to add legends for two geom_line and a geom_point at the same time, but the legends were not align to each other. So how to align the two legends and adjust legend positions? Thank you in advance!
My data:
df1:
x1 y1
1 0
2 0
3 0
4 0
5 0
6 0
7 0
8 0
9 0
10 0
11 0
12 0
13 0
14 0
15 0
16 0
17 0
18 0
19 0
20 0
21 0
22 0
23 9.2
24 18.5
25 27.6
26 36.8
27 46.1
28 54.2
29 63.4
30 72.6
31 81.7
32 88.9
33 93
34 99.1
35 105.4
36 110
37 118.3
38 128.2
39 138
40 146.9
41 155.1
42 162.5
43 165.7
44 169.2
45 174.2
46 176.3
47 183.8
48 187.8
49 194.2
50 200.7
51 203.4
52 204.7
53 209.5
54 214.5
55 219.6
56 224.1
57 228.5
58 232.8
59 237
60 239.5
61 242.7
62 243.1
63 244.6
64 245
65 246.6
66 248.6
67 251
68 253
69 255
70 256.7
71 256.7
df2:
x2 y2
24 0.006525
32 0.072525
39 0.120025
46 0.1601418
53 0.1972939
60 0.2226233
68 0.2312895
df3:
x3 y3
1 0
2 0
3 0
4 0
5 0
6 0
7 0
8 0
9 0
10 0
11 0
12 0
13 0
14 0
15 0
16 0
17 0
18 0
19 0
20 0
21 0
22 0
23 10.9
24 14.8
25 19.6
26 25.6
27 31.4
28 38.5
29 47.1
30 56.9
31 64.7
32 71
33 77
34 84.7
35 92.5
36 98.8
37 108.2
38 118.8
39 126.9
40 134.3
41 141.1
42 147.2
43 149.9
44 152.8
45 157
46 158.7
47 164.9
48 168.3
49 173.6
50 179
51 181.3
52 182.3
53 186.3
54 190.4
55 194.7
56 198.5
57 202.1
58 205.7
59 209.2
60 211.3
61 213.9
62 214.3
63 215.6
64 215.9
65 217.2
66 218.9
67 220.9
68 222.5
69 224.2
70 225.7
71 225.7
My code:
library("ggplot2")
library("reshape2")
library("gridExtra")
p <- ggplot() +
geom_line(data=df1, aes(x= x1, y= y1, linetype= "aa"))+
geom_point(data=df2, aes(x= x2, y= y2, shape="bbbbbbb"))+
geom_line(data=df3, aes(x= x3, y= y3, linetype= "cc"))+
scale_shape_manual(name="",
labels=c("bbbbbbb"),
values = c(21) )+
scale_linetype_manual(name="",
labels=c("aa","cc"),
values=c("solid", "dashed")) +
ylab("y")+
xlab("x")+
theme_bw()+
theme(panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
legend.justification = c(0, 1),
legend.position=c(0, 1))
My plot:
Thank you guys for attention. I have find a solution to the problem, I adopted the idea from this post.
library("ggplot2")
library("reshape2")
library("gridExtra")
library("gtable")
p <- ggplot() +
geom_line(data=df1, aes(x= x1, y= y1, linetype= "aa"))+
geom_point(data=df2, aes(x= x2, y= y2, shape="bbbbbbb"))+
geom_line(data=df3, aes(x= x3, y= y3, linetype= "cc"))+
# discard errorbar here.
scale_shape_manual(name=NULL,
labels=c("bbbbbbb"),
values = c(21) )+
scale_linetype_manual(name=NULL,
labels=c("aa","cc"),
values=c("solid", "dashed")) +
ylab("y")+
xlab("x")+
theme_bw()+
theme(panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
legend.position=c(0, 1),
legend.justification=c(0,1),
legend.margin=unit(0,"cm"),
legend.box="vertical",
legend.box.just = "left",
legend.key.size=unit(1,"lines"),
legend.text.align=0,
legend.key = element_blank(),
legend.title = element_blank(),
legend.background=element_blank())
data <- ggplot_build(p)
gtable <- ggplot_gtable(data)
lbox <- which(sapply(gtable$grobs, paste) == "gtable[guide-box]")
guide <- gtable$grobs[[lbox]]
gtable$grobs[[lbox]]$heights <- unit.c(guide$heights[1:2],
unit(-.8,"cm"),
guide$heights[2:3])
# Plotting
g<-grid.draw(gtable)