Related
The Y axis labels are offset
The Y axis labels from 100 to the top are aligned to the right, while from 90 to the bottom are aligned to the left. I've looked at many paramaters and I couldn't find one to be causing this. Also, I haven't found anyone else with this same issue.
Here's my code:
test <- ggplot(data,
aes(x=Month, y=Value, color=Name, group=Name, fill=Name))+
geom_line(size=3)+
geom_point(size=5)+
scale_color_manual(values=c("#FBE785","#0F5F00","#FFC300","#1BFFAA"))+
ylab ("")+
xlab ("")+
labs(caption = paste("Fonte: Fred e IBGE.")) +
scale_x_date(date_labels = "%b/%y", breaks = "6 month", expand=c(0,0))+
coord_cartesian(clip = "off")+
theme_minimal() +
guides(fill=guide_legend())+
theme(panel.background = element_rect(fill= "#122929",color = "#122929"),
plot.background = element_rect(fill = "#122929"),
panel.grid.major = element_line(color = "#4D4B55", size =0.1),
panel.grid.minor = element_line(color= "#4D4B55", size =0.1),
panel.grid = element_blank(),
axis.text.y = element_text(vjust = 1, hjust=-1),
axis.text.x = element_text(vjust = -1, hjust=0),
legend.title = element_blank(),
legend.position = "bottom",
legend.key.width = unit(1.5, "cm"),
plot.caption = element_text(family = "Abel",vjust = -1, hjust = 0,colour="#4D4B55", size= 30),
text = element_text(family = "Abel", color = "#4D4B55",size = 35),
plot.margin = margin(1,1,1.5,1.2, "cm"))
ggsave("./test.png", width = 21, height = 15, dpi = 300)
PS: Not sharing the data itself because I guess that's not where the problem is.
Thanks!
Your text is misaligned because of your axis.text.y argument. Change hjust to 1 and it will be properly aligned. I have provided a minimal reproducible example below.
library(tidyverse)
Month <- rep(x = month.abb, times = 10)
Value <- sample(x = 10:120, size = 120, replace = TRUE)
Name <- sample(x = LETTERS[1:4], size = 120, replace = TRUE)
data <- data.frame(Month, Value, Name)
ggplot(data, aes(x = Month, y = Value, color = Name, group = Name, fill = Name)) +
geom_line(size = 1) + geom_point(size = 2) +
theme(axis.text.y = element_text(vjust = 1, hjust = 1)) # <- problem here
Image-radarchart
help! this is my df, Im trying to replicate the spiderplot o radarchart in the attachment
result <- data.frame(row.names = c("T1", "T2", "T3"), N = c(2.5, 2.2, 2.6),
P = c(0.15, 0.16, 0.14),
K = c(0.7, 1, 0.8),
Mg = c(0.20, 0.30, 0.32),
Ca = c(0.5, 0.3, 0.56),
S = c(0.22, 0.27, 0.28),
Cl = c(0.5, 0.58, 0.69)
)
max_min <- data.frame(
N = c(2.8, 2.4), P = c(0.18, 0.15), K = c(1.2, 0.9),
Mg = c(0.4, 0.25), Ca = c(0.75, 0.5), S = c(0.35, 0.25),
Cl = c(0.7, 0.5)
)
rownames(max_min) <- c("Max", "Min")
df <- rbind(max_min, result)
Just a brief background:
There are 10 cement plants producing two kinds of products (OPC, PPC) supplying material to d demand locations by road or by rail (which can be loaded in multiples of x tonnes) whose cost matrix is LC (rows - Source, columns - Demand destinations). Since the source is defined as a combination of plant, product, and transport mode while the constraint is at a plant product level - I came up with this hack to combine constraints accordingly
Below is the working code for the same.
library(ompr)
library(ompr.roi)
library(ROI.plugin.glpk)
library(listcomp)
is_connected <- function(i, j) {
LC[i, j] > 0
}
railroutes = grep(":W:",rownames(LC))
d = demand[demand$DPP %in% colnames(LC),"DEMAND"]
rakemultiplier = capacity[capacity$SOURCE %in% rownames(LC),"Multiplier"]
p1OPC = which(grepl(Plants[1],rNames)&grepl("OPC",rNames))
p2OPC = which(grepl(Plants[2],rNames)&grepl("OPC",rNames))
p3OPC = which(grepl(Plants[3],rNames)&grepl("OPC",rNames))
p4OPC = which(grepl(Plants[4],rNames)&grepl("OPC",rNames))
# p5OPC = which(grepl(Plants[5],rNames)&grepl("OPC",rNames))
# p6OPC = which(grepl(Plants[6],rNames)&grepl("OPC",rNames))
p7OPC = which(grepl(Plants[7],rNames)&grepl("OPC",rNames))
p8OPC = which(grepl(Plants[8],rNames)&grepl("OPC",rNames))
p9OPC = which(grepl(Plants[9],rNames)&grepl("OPC",rNames))
p10OPC = which(grepl(Plants[10],rNames)&grepl("OPC",rNames))
p1PPC = which(grepl(Plants[1],rNames)&grepl("PPC",rNames))
p2PPC = which(grepl(Plants[2],rNames)&grepl("PPC",rNames))
p3PPC = which(grepl(Plants[3],rNames)&grepl("PPC",rNames))
p4PPC = which(grepl(Plants[4],rNames)&grepl("PPC",rNames))
p5PPC = which(grepl(Plants[5],rNames)&grepl("PPC",rNames))
p6PPC = which(grepl(Plants[6],rNames)&grepl("PPC",rNames))
p7PPC = which(grepl(Plants[7],rNames)&grepl("PPC",rNames))
p8PPC = which(grepl(Plants[8],rNames)&grepl("PPC",rNames))
p9PPC = which(grepl(Plants[9],rNames)&grepl("PPC",rNames))
p10PPC = which(grepl(Plants[10],rNames)&grepl("PPC",rNames))
set.seed(40)
a = Sys.time()
model <- MIPModel() |>
add_variable(x[i, j], i = 1:nrow(LC), j = 1:ncol(LC), is_connected(i, j), lb = 0, type = "continuous") |>
add_variable(y[i], lb = 0, type = "integer", i = railroutes) |>
add_variable(z1[j],lb = 0,ub = pub,type = "continuous", j = 1:ncol(LC)) |>
add_variable(z2[j],lb = 0,ub = nub,type = "continuous", j = 1:ncol(LC)) |>
add_constraint(sum_over(x[i,j],i = 1:nrow(LC),is_connected(i, j))+z1[j]-z2[j] == d[j],j = 1:ncol(LC)) |>
add_constraint(sum_expr(x[i,j],j = 1:ncol(LC),is_connected(i,j))/rakemultiplier[i] == y[i], i = railroutes) |>
add_constraint(sum_expr(x[i,j],j = 1:ncol(LC),is_connected(i,j)) == y[i]*rakemultiplier[i], i = railroutes) |>
add_constraint(sum_over(x[i,j], i = p1OPC, j = 1:ncol(LC),is_connected(i,j)) <= 120000) |>
add_constraint(sum_over(x[i,j], i = p2OPC, j = 1:ncol(LC),is_connected(i,j)) <= 120000) |>
add_constraint(sum_over(x[i,j], i = p3OPC, j = 1:ncol(LC),is_connected(i,j)) <= 120000) |>
add_constraint(sum_over(x[i,j], i = p4OPC, j = 1:ncol(LC),is_connected(i,j)) <= 120000) |>
# add_constraint(sum_over(x[i,j], i = p5OPC, j = 1:ncol(LC),is_connected(i,j)) <= 0) |>
# add_constraint(sum_over(x[i,j], i = p6OPC, j = 1:ncol(LC),is_connected(i,j)) <= 0) |>
add_constraint(sum_over(x[i,j], i = p7OPC, j = 1:ncol(LC),is_connected(i,j)) <= 175000) |>
add_constraint(sum_over(x[i,j], i = p8OPC, j = 1:ncol(LC),is_connected(i,j)) <= 175000) |>
add_constraint(sum_over(x[i,j], i = p9OPC, j = 1:ncol(LC),is_connected(i,j)) <= 175000) |>
add_constraint(sum_over(x[i,j], i = p10OPC, j = 1:ncol(LC),is_connected(i,j)) <= 175000) |>
add_constraint(sum_over(x[i,j], i = p1PPC, j = 1:ncol(LC),is_connected(i,j)) <= 75000) |>
add_constraint(sum_over(x[i,j], i = p2PPC, j = 1:ncol(LC),is_connected(i,j)) <= 75000) |>
add_constraint(sum_over(x[i,j], i = p3PPC, j = 1:ncol(LC),is_connected(i,j)) <= 75000) |>
add_constraint(sum_over(x[i,j], i = p4PPC, j = 1:ncol(LC),is_connected(i,j)) <= 75000) |>
add_constraint(sum_over(x[i,j], i = p5PPC, j = 1:ncol(LC),is_connected(i,j)) <= 75000) |>
add_constraint(sum_over(x[i,j], i = p6PPC, j = 1:ncol(LC),is_connected(i,j)) <= 150000) |>
add_constraint(sum_over(x[i,j], i = p7PPC, j = 1:ncol(LC),is_connected(i,j)) <= 150000) |>
add_constraint(sum_over(x[i,j], i = p8PPC, j = 1:ncol(LC),is_connected(i,j)) <= 150000) |>
add_constraint(sum_over(x[i,j], i = p9PPC, j = 1:ncol(LC),is_connected(i,j)) <= 150000) |>
add_constraint(sum_over(x[i,j], i = p10PPC, j = 1:ncol(LC),is_connected(i,j)) <= 150000) |>
set_objective(sum_over(x[i,j]*LC[i,j]+z1[j]+z2[j],i = 1:nrow(LC),j = 1:ncol(LC),is_connected(i, j)) ,"min")
model
print(Sys.time() - a)
a = Sys.time()
solution1 = model %>% solve_model(with_ROI(solver = "glpk",verbose=T))
print(Sys.time() - a)
rm(a)
This works perfectly fine, but one thing I am unhappy about is the fact that this code has to be manually changed when the original data is subsetted. Also when there are some plants that don't produce a certain product, I have to comment on the code - i.e the corresponding rows are numerical(0) (check p5opc,p6opc)
Is there a clever way to combine these expressions into something scalable to x plants taking care of the commenting when the corresponding variable is numerical(0) thus making the code more readable?
I have created a ggplot graph with three lines. Each line represents a different column in a data frame and colored in a different color. For some reason, the colors in the final graph are not coordinated to the code.
The data frame:
Scenario 1 Scenario 2 Scenario 3 Years
0.0260 0.0340 0.0366 1
0.0424 0.0562 0.0696 2
0.0638 0.0878 0.1150 3
0.0848 0.1280 0.1578 4
0.1096 0.1680 0.2074 5
0.1336 0.2106 0.2568 6
This is the code:
ggplot(ext2, aes(x = Years))+
geom_line(aes(y = `Scenario 1`, color = "darkblue"))+
geom_line(aes(y = `Scenario 2`, color = "darkred"))+
geom_line(aes(y = `Scenario 3`, color = "darkgreen"))+
xlab("Years")+
ylab("Quasi - extinction probability")+
ggtitle("2 mature individuals")+
geom_segment(aes(x = 45,y = 0.5, xend = 45, yend = 1.1),linetype = "longdash")+
geom_segment(aes(x = 75,y = 0.2, xend = 75, yend = 0.5),linetype = "longdash")+
geom_segment(aes(x = 0,y = 0.5, xend = 100, yend = 0.5),linetype = "longdash")+
geom_segment(aes(x = 0,y = 0.2, xend = 100, yend = 0.2),linetype = "longdash")+
geom_text(x = 20, y = 0.80, label = "CE")+
geom_text(x = 40, y = 0.35, label = "EN")+
scale_colour_manual(values = c("darkblue", "darkred","darkgreen"), labels = c("Scenario 1","Scenario 2","Scenario 3"))+
theme(legend.title = element_blank())+
theme_minimal()
and this is the graph:
Click here to see graph
The problem is that what I defined as 'scenario 3' in the code is actually a representation of 'scenario 2' in the data frame. You can see it according to the values under scenario 2 in the data frame.
For ggplot, the data needs to be in long format before you plot. Then, you can make "Scenarios" (i.e., name) the group, so that you can manually color the individual lines (i.e., with scale_colour_manual).
library(tidyverse)
ext_long <- ext2 %>%
pivot_longer(!Years)
ggplot(ext_long, aes(x = Years, color = name)) +
geom_line(aes(y = value)) +
xlab("Years") +
ylab("Quasi - extinction probability") +
ggtitle("2 mature individuals") +
geom_segment(aes(
x = 45,
y = 0.5,
xend = 45,
yend = 1.1
), linetype = "longdash") +
geom_segment(aes(
x = 75,
y = 0.2,
xend = 75,
yend = 0.5
), linetype = "longdash") +
geom_segment(aes(
x = 0,
y = 0.5,
xend = 100,
yend = 0.5
), linetype = "longdash") +
geom_segment(aes(
x = 0,
y = 0.2,
xend = 100,
yend = 0.2
), linetype = "longdash") +
geom_text(x = 20, y = 0.80, label = "CE") +
geom_text(x = 40, y = 0.35, label = "EN") +
scale_colour_manual(
values = c("darkblue", "darkred", "darkgreen"),
labels = c("Scenario 1", "Scenario 2", "Scenario 3")
) +
theme(legend.title = element_blank()) +
theme_minimal()
Output (only have a small part of the data, which is the reason the lines do not extend across the graph)
Data
ext2 <- structure(
list(
Scenario.1 = c(0.026, 0.0424, 0.0638, 0.0848,
0.1096, 0.1336),
Scenario.2 = c(0.034, 0.0562, 0.0878, 0.128,
0.168, 0.2106),
Scenario.3 = c(0.0366, 0.0696, 0.115, 0.1578,
0.2074, 0.2568),
Years = 1:6
),
class = "data.frame",
row.names = c(NA,-6L)
)
I am trying to create a Kaplan-Meier plot with 95% confidence bands plus having the censored data in a table beneath it. I can create the plot, but not the table. I get the error message: Error in grid.draw(both) : object 'both' not found.
library(survival)
library(ggplot2)
library(GGally)
library(gtable)
data(lung)
sf.sex <- survfit(Surv(time, status) ~ sex, data = lung)
pl.sex <- ggsurv(sf.sex) +
geom_ribbon(aes(ymin=low,ymax=up,fill=group),alpha=0.3) +
guides(fill=guide_legend("sex"))
pl.sex
tbl <- ggplot(df_nums, aes(x = Time, y = factor(variable), colour = variable,+
label=value)) +
geom_text() +
theme_bw() +
theme(panel.grid.major = element_blank(),+
legend.position = "none",+
plot.background = element_blank(), +
panel.grid.major = element_blank(),+
panel.grid.minor = element_blank(),+
panel.border = element_blank(),+
legend.position="none",+
axis.line = element_blank(),+
axis.text.x = element_blank(),+
axis.text.y = element_text(size=15, face="bold", color = 'black'),+
axis.ticks=element_blank(),+
axis.title.x = element_blank(),+
axis.title.y = element_blank(),+
plot.title = element_blank()) +
scale_y_discrete(breaks=c("Group.A", "Group.B"), labels=c("Group A", "Group B"))
both = rbind(ggplotGrob(g), ggplotGrob(tbl), size="last")
panels <- both$layout$t[grep("panel", both$layout$name)]
both$heights[panels] <- list(unit(1,"null"), unit(2, "lines"))
both <- gtable_add_rows(both, heights = unit(1,"line"), 8)
both <- gtable_add_grob(both, textGrob("Number at risk", hjust=0, x=0), t=9, l=2, r=4)
grid.newpage()
grid.draw(both)
I solved the problem by using the Rcmdrplugin KMggplot2 The code is generated by the plugin after selecting the data and variables.
library(survival, pos=18)
data(lung, package="survival")
lung <- within(lung, {
sex <- factor(sex, labels=c('male','female'))
})
ggthemes_data <- ggthemes::ggthemes_data
require("ggplot2")
.df <- na.omit(data.frame(x = lung$time, y = lung$status, z = lung$sex))
.df <- .df[do.call(order, .df[, c("z", "x"), drop = FALSE]), , drop = FALSE]
.fit <- survival::survfit(survival::Surv(time = x, event = y, type = "right") ~ z,
.df)
.pval <- plyr::ddply(.df, plyr::.(),
function(x) {
data.frame(
x = 0, y = 0, df = 1,
chisq = survival::survdiff(
survival::Surv(time = x, event = y, type = "right") ~ z, x
)$chisq
)})
.pval$label <- paste0(
"paste(italic(p), \" = ",
signif(1 - pchisq(.pval$chisq, .pval$df), 3),
"\")"
)
.fit <- data.frame(x = .fit$time, y = .fit$surv, nrisk = .fit$n.risk, nevent =
.fit$n.event, ncensor= .fit$n.censor, upper = .fit$upper, lower = .fit$lower)
.df <- .df[!duplicated(.df[,c("x", "z")]), ]
.df <- .fit <- data.frame(.fit, .df[, c("z"), drop = FALSE])
.med <- plyr::ddply(.fit, plyr::.(z), function(x) {
data.frame(
median = min(subset(x, y < (0.5 + .Machine$double.eps^0.5))$x)
)})
.df <- .fit <- rbind(unique(data.frame(x = 0, y = 1, nrisk = NA, nevent = NA,
ncensor = NA, upper = 1, lower = 1, .df[, c("z"), drop = FALSE])), .fit)
.cens <- subset(.fit, ncensor == 1)
.tmp1 <- data.frame(as.table(by(.df, .df[, c("z"), drop = FALSE], function(d)
max(d$nrisk, na.rm = TRUE))))
.tmp1$x <- 0
.nrisk <- .tmp1
for (i in 1:9) {.df <- subset(.fit, x < 100 * i); .tmp2 <-
data.frame(as.table(by(.df, .df[, c("z"), drop = FALSE], function(d) if
(all(is.na(d$nrisk))) NA else min(d$nrisk - d$nevent - d$ncensor, na.rm = TRUE))));
.tmp2$x <- 100 * i; .tmp2$Freq[is.na(.tmp2$Freq)] <- .tmp1$Freq[is.na(.tmp2$Freq)];
.tmp1 <- .tmp2; .nrisk <- rbind(.nrisk, .tmp2)}
.nrisk$y <- rep(seq(0.075, 0.025, -0.05), 10)
.plot <- ggplot(data = .fit, aes(x = x, y = y, colour = z)) +
RcmdrPlugin.KMggplot2::geom_stepribbon(data = .fit, aes(x = x, ymin = lower, ymax =
upper, fill = z), alpha = 0.25, colour = "transparent", show.legend = FALSE, kmplot
= TRUE) + geom_step(size = 1.5) +
geom_linerange(data = .cens, aes(x = x, ymin = y,
ymax = y + 0.02), size = 1.5) +
geom_text(data = .pval, aes(y = y, x = x, label =
label), colour = "black", hjust = 0, vjust = -0.5, parse = TRUE, show.legend =
FALSE, size = 14 * 0.282, family = "sans") +
geom_vline(data = .med, aes(xintercept
= median), colour = "black", lty = 2) + scale_x_continuous(breaks = seq(0, 900, by
= 100), limits = c(0, 900)) +
scale_y_continuous(limits = c(0, 1), expand = c(0.01,0)) + scale_colour_brewer(palette = "Set1") + scale_fill_brewer(palette = "Set1") +
xlab("Time from entry") + ylab("Proportion of survival") + labs(colour = "sex") +
ggthemes::theme_calc(base_size = 14, base_family = "sans") + theme(legend.position
= c(1, 1), legend.justification = c(1, 1))
.nrisk$y <- ((.nrisk$y - 0.025) / (max(.nrisk$y) - 0.025) + 0.5) * 0.5
.plot2 <- ggplot(data = .nrisk, aes(x = x, y = y, label = Freq, colour = z)) +
geom_text(size = 14 * 0.282, family = "sans") + scale_x_continuous(breaks = seq(0,900, by = 100), limits = c(0, 900)) +
scale_y_continuous(limits = c(0, 1)) +
scale_colour_brewer(palette = "Set1") + ylab("Proportion of survival") +
RcmdrPlugin.KMggplot2::theme_natrisk(ggthemes::theme_calc, 14, "sans")
.plot3 <- ggplot(data = subset(.nrisk, x == 0), aes(x = x, y = y, label = z, colour = z)) +
geom_text(hjust = 0, size = 14 * 0.282, family = "sans") +
scale_x_continuous(limits = c(-5, 5)) + scale_y_continuous(limits = c(0, 1)) +
scale_colour_brewer(palette = "Set1") +
RcmdrPlugin.KMggplot2::theme_natrisk21(ggthemes::theme_calc, 14, "sans")
.plotb <- ggplot(.df, aes(x = x, y = y)) + geom_blank() +
RcmdrPlugin.KMggplot2::theme_natriskbg(ggthemes::theme_calc, 14, "sans")
grid::grid.newpage(); grid::pushViewport(grid::viewport(layout =
grid::grid.layout(2, 2, heights = unit(c(1, 3), c("null", "lines")), widths =
unit(c(4, 1), c("lines", "null")))));
print(.plotb, vp =
grid::viewport(layout.pos.row = 1:2, layout.pos.col = 1:2));
print(.plot , vp =
grid::viewport(layout.pos.row = 1 , layout.pos.col = 1:2));
print(.plot2, vp =
grid::viewport(layout.pos.row = 2 , layout.pos.col = 1:2));
print(.plot3, vp =
grid::viewport(layout.pos.row = 2 , layout.pos.col = 1 ));
.plot <- recordPlot()
print(.plot)
Here's a start (code below)
I guess you can create the table need and replace it by the random.table
# install.packages("ggplot2", dependencies = TRUE)
# install.packages("RGraphics", dependencies = TRUE)
# install.packages("gridExtra", dependencies = TRUE)
# install.packages("survival", dependencies = TRUE)
require(ggplot2)
library(RGraphics)
library(gridExtra)
library(survival)
# Plot
data(lung)
sf.sex <- survfit(Surv(time, status) ~ sex, data = lung)
pl.sex <- ggsurv(sf.sex) +
geom_ribbon(aes(ymin=low,ymax=up,fill=group),alpha=0.3) +
guides(fill=guide_legend("sex"))
# Table
random.table <- data.frame("CL 95"=rnorm(5),n=runif(5,1,3))
pl.table <- tableGrob(random.table)
# Arrange the plots on the same page
grid.arrange(pl.sex, pl.table, ncol=1)