saving ggplot in a list gives me the same graph - r

I am trying to plot 12 different plots on a 3 by 4 grid. But,it only plots the last one 12 times. Can any one help me? I am so fed up with it. Thanks
library(ggplot2)
library(gridExtra)
pmax=0.85
K_min = 0.0017
T = seq(100,1200,by=100) ## ISIs
lambda =1/T
p=list()
for(i in (1:length(lambda))){
p[[i]]<-ggplot(data.frame(x = c(0, 1)), aes(x = x)) +
stat_function(fun = function (x) (lambda[i]*(1-(1-pmax))/K_min)*(1-x)^((lambda[i]/K_min)-1)*
(1-(1-pmax)*x)^-((lambda[i]/K_min)+1),colour = "dodgerblue3")+
scale_x_continuous(name = "Probability") +
scale_y_continuous(name = "Frequency") + theme_bw()
main <- grid.arrange(grobs=p,ncol=4)
}
This code produces the correct picture but I need to use ggplot since my other figures are in ggplot.
par( mfrow = c( 3, 4 ) )
for (i in (1:length(lambda))){
f <- function (x) ((lambda[i]*(1-(1-pmax))/K_min)*(1-x)^((lambda[i]/K_min)-1)*
(1-(1-pmax)*x)^-((lambda[i]/K_min)+1) )
curve(f,from=0, to=1, col = "violet",lwd=2,sub = paste0("ISI = ",round(1/lambda[i],3), ""),ylab="PDF",xlab="R")
}
Correct plot using curve:

ggplot objects created in a loop are evaluated at the end of the loop. Since all the ggplot objects in this case use data calculated with lambda[i], they get the same result based on the last i value (12). Here are two possible workarounds:
Workaround 1. Convert each ggplot object into a grob within the loop, & save that to the list:
for(i in (1:length(lambda))){
# code for generating each plot is unchanged
g <- ggplot(data.frame(x = c(0, 1)), aes(x = x)) +
stat_function(fun = function (x) (lambda[i]*(1-(1-pmax))/K_min)*(1-x)^((lambda[i]/K_min)-1)*
(1-(1-pmax)*x)^-((lambda[i]/K_min)+1),colour = "dodgerblue3")+
scale_x_continuous(name = "Probability") +
scale_y_continuous(name = "Frequency") + theme_bw()
p[[i]] <- ggplotGrob(g)
}
main <- grid.arrange(grobs=p, ncol=4)
Workaround 2. Put all the data in a data frame, & create a single ggplot with a facet for each ISI:
library(dplyr)
pmax = 0.85
K_min = 0.0017
ISI = seq(100, 1200, by = 100) # I changed this; using `T` as a name clashes with T from TRUE/FALSE
lambda = 1/ISI
df <- data.frame(
x = rep(seq(0, 1, length.out = 101), length(ISI)),
ISI = rep(ISI, each = 101),
l = rep(lambda, each = 101)
) %>%
mutate(y = (l * pmax / K_min) * (1-x) ^ ((l / K_min) - 1) *
(1 - (1 - pmax) * x)^-((l / K_min) + 1))
ggplot(data,
aes(x = x, y = y, group = 1)) +
geom_line(colour = "dodgerblue3") +
facet_wrap(~ISI, nrow = 3, scales = "free_y") +
labs(x = "Probability", y = "Frequency") +
theme_bw()

Related

Monte Carlo Sim in R plots STRAIGHTS

So I am getting started with Monte Carlo Sims, and went with this basic code to simulate Returns for a given portfolio. Well somehow a portion of the simulated returns always results in straight linear lines which are easy to see on the plotted graph. First I decreased the number of sims so you can see it clearer and I also played around with some other factors but they keep showing up. The rest of the output looks promising and "random".
Added the link to the image as my account is new and also the code, appreciate any help!:
library(quantmod)
library(ggplot2)
maxDate<- "2000-01-01"
tickers<-c("MSFT", "AAPL", "BRK-B")
getSymbols(tickers, from=maxDate)
Port.p<-na.omit(merge(Cl(AAPL),Cl(MSFT),Cl(`BRK-B`)))
Port.r<-ROC(Port.p, type = "discrete")[-1,]
stock_Price<- as.matrix(Port.p[,1:3])
stock_Returns <- as.matrix(Port.r[,1:3])
mc_rep = 50 # Number of Sims
training_days = 200
portfolio_Weights = c(0.5,0.3,0.2)
coVarMat = cov(stock_Returns)
miu = colMeans(stock_Returns)
Miu = matrix(rep(miu, training_days), nrow = 3)
portfolio_Returns_m = matrix(0, training_days, mc_rep)
set.seed(2000)
for (i in 1:mc_rep) {
Z = matrix ( rnorm( dim(stock_Returns)[2] * training_days ), ncol = training_days )
L = t( chol(coVarMat) )
daily_Returns = Miu + L %*% Z
portfolio_Returns_200 = cumprod( portfolio_Weights %*% daily_Returns + 1 )
portfolio_Returns_m[,i] = portfolio_Returns_200;
}
x_axis = rep(1:training_days, mc_rep)
y_axis = as.vector(portfolio_Returns_m-1)
plot_data = data.frame(x_axis, y_axis)
ggplot(data = plot_data, aes(x = x_axis, y = y_axis)) + geom_path(col = 'red', size = 0.1) +
xlab('Days') + ylab('Portfolio Returns') +
ggtitle('Simulated Portfolio Returns in 200 days')+
theme_bw() +
theme(plot.title = element_text(hjust = 0.5))
The lines are the 'return' from the end of each series to the beginning of the next. You can keep the lines separate by adding a grouping variable to your plotting data and using the group aesthetic to tell ggplot about it:
g <- rep(1:training_days, each = mc_rep)
plot_data = data.frame(x_axis, y_axis, g)
ggplot(data = plot_data, aes(x = x_axis, y = y_axis, group = g)) + ...

Using ggplot to draw a density function for various values of parameters

I am trying to plot a density function for various values of two parameters as follows:
f_bdsn<-function(x){
2*(1+delta1*x^2)*dnorm(x)*pnorm(alpha1*x)/(1+delta1)
}
alpha1<<-0
alpha1<<-0
group1=paste("alpha=",alpha1,", delta=",delta1)
p9 <- ggplot(data.frame(x = c(-4, 4)), aes(x = x)) +
stat_function(fun = f_bdsn, aes(colour = group1))
alpha1<<-0
delta1<<-6
group2=paste("alpha=",alpha1,", delta=",delta1)
p9 <-p9 + stat_function(fun = f_bdsn,
aes(colour = group2))
p9
I am confused why it does not work! It only draws the function for last values of the parameters.
I've had to make some changes to your original function. Basically, the alpha and delta values need to be parameterised and passed into when calling the function. Then using a for loop we can create as many groups as we want.
# Create Function which takes in an x value, a delta value and an alpha value
f_bdsn<-function(x, delta_input, alpha_input){
2*(1+delta_input*x^2)*dnorm(x)*pnorm(alpha_input*x)/(1+delta_input)
}
# Define the number of groups, alpha values and delta values
# Note the length of both alpha_values and delta_values are the same
n_groups <- 2
alpha_values <- c(0, 10)
delta_values <- c(6, 16)
# Create inital plot
plot <- ggplot(data.frame(x = c(-4, 4)), aes(x = x))
# Create a for loop to through each group
for (i in seq_len(n_groups)) {
# Define the group name
group_name <- paste("alpha=", alpha_values[i],", delta=", delta_values[i])
# Add the values to the main plot variable
plot <- plot +
stat_function(fun = f_bdsn, args = list(delta_input = delta_values[i],
alpha_input = alpha_values[i]),
aes(colour = group_name))
}
# Print Plot
plot
The problem is that the parameter values of ggplot for the most part are lazily evaulated. The values aren't actually evaluated until the plot is drawn. Since your function uses global variables, those values aren't resolved till plot time and at the time of the plot they will only have one value, not two different values. You can change this by creating a function generator. For example
f_gen <- function(alpha1, delta1) {
force(c(alpha1, delta1))
function(x){
2*(1+delta1*x^2)*dnorm(x)*pnorm(alpha1*x)/(1+delta1)
}}
alpha1 <- 0
delta1 <- 0
group1 <- paste("alpha=",alpha1,", delta=",delta1)
p9 <- ggplot(data.frame(x = c(-4, 4)), aes(x = x)) +
stat_function(fun = f_gen(alpha1,delta1), aes(colour = group1))
alpha1 <- 0
delta1 <- 6
group2 <- paste("alpha=",alpha1,", delta=",delta1)
p9 <- p9 +
stat_function(fun = f_gen(alpha1,delta1), aes(colour = group2))
p9
Here fgen is a function that returns a function with the parameters you desire.
You might even simplify that to
f_gen <- function(alpha1, delta1) {
force(c(alpha1, delta1))
function(x){
2*(1+delta1*x^2)*dnorm(x)*pnorm(alpha1*x)/(1+delta1)
}}
gname <- function(alpha1, delta1) paste("alpha=",alpha1,", delta=",delta1)
ggplot(data.frame(x = c(-4, 4)), aes(x = x)) +
stat_function(fun = f_gen(0,0), aes(colour = gname(0,0))) +
stat_function(fun = f_gen(0,6), aes(colour = gname(0,6))) +
labs(color="Params")

How to to print a plot based on function arguments in R?

I am trying to build a savings calculator. Eventually, I want to create an RShiny app, but before I do that, I want to make sure the code is perfect. Do what I want to do, I have to use three chunks, which are:
ks <- function (x) { number_format(accuracy = 1,
scale = 1/1000,
big.mark = ",")(x) }
savings <- function(years,apr,initial,investment) {
value <- numeric(years + 1)
value[1] <- initial
for (i in 1:years) value[i + 1] <- (value[i] + investment) * apr
data.frame(year = 0:years, value)
}
savings(45.02,1.07,45000,15000)
ggplot(data=savings(45,1.07,45000,15000),aes(x=year,y=value))+geom_line()+ scale_x_continuous(breaks = seq(0, 100, by = 5)) +
scale_y_continuous(labels = ks, breaks = seq(0, 400000000, by = 250000))+labs(x="Year",y="Value (thousands)")
I want to produce the ggplot as part of the "savings" function but I do not know how to integrate it.
You can save the dataframe in an object and use it in ggplot
library(ggplot2)
savings <- function(years,apr,initial,investment) {
value <- numeric(years + 1)
value[1] <- initial
for (i in 1:years) value[i + 1] <- (value[i] + investment) * apr
df <- data.frame(year = 0:years, value)
ggplot(data=df,aes(x=year,y=value))+ geom_line() +
scale_x_continuous(breaks = seq(0, 100, by = 5)) +
scale_y_continuous(labels = ks, breaks = seq(0, 400000000, by = 250000)) +
labs(x="Year",y="Value (thousands)")
}
savings(45.02,1.07,45000,15000)

gam plots with ggplot

I need to create some gam plots in ggplot. I can do them with the general plot function, but am unsure how to do with ggplot. Here is my code and plots with the regular plot function. I'm using the College data set from the ISLR package.
train.2 <- sample(dim(College)[1],2*dim(College)[1]/3)
train.college <- College[train.2,]
test.college <- College[-train.2,]
gam.college <- gam(Outstate~Private+s(Room.Board)+s(Personal)+s(PhD)+s(perc.alumni)+s(Expend)+s(Grad.Rate), data=train.college)
par(mfrow=c(2,2))
plot(gam.college, se=TRUE,col="blue")
See update below old answer.
Old answer:
There is an implementation of GAM plotting using ggplot2 in voxel library. Here is how you would go about it:
library(ISLR)
library(mgcv)
library(voxel)
library(tidyverse)
library(gridExtra)
data(College)
set.seed(1)
train.2 <- sample(dim(College)[1],2*dim(College)[1]/3)
train.college <- College[train.2,]
test.college <- College[-train.2,]
gam.college <- gam(Outstate~Private+s(Room.Board)+s(Personal)+s(PhD)+s(perc.alumni)+s(Expend)+s(Grad.Rate), data=train.college)
vars <- c("Room.Board", "Personal", "PhD", "perc.alumni","Expend", "Grad.Rate")
map(vars, function(x){
p <- plotGAM(gam.college, smooth.cov = x) #plot customization goes here
g <- ggplotGrob(p)
}) %>%
{grid.arrange(grobs = (.), ncol = 2, nrow = 3)}
after a bunch of errors: In plotGAM(gam.college, smooth.cov = x) :
There are one or more factors in the model fit, please consider plotting by group since plot might be unprecise
To compare to the plot.gam:
par(mfrow=c(2,3))
plot(gam.college, se=TRUE,col="blue")
You might also want to plot the observed values:
map(vars, function(x){
p <- plotGAM(gam.college, smooth.cov = x) +
geom_point(data = train.college, aes_string(y = "Outstate", x = x ), alpha = 0.2) +
geom_rug(data = train.college, aes_string(y = "Outstate", x = x ), alpha = 0.2)
g <- ggplotGrob(p)
}) %>%
{grid.arrange(grobs = (.), ncol = 3, nrow = 2)}
or per group (especially important if you used the by argument (interaction in gam).
map(vars, function(x){
p <- plotGAM(gam.college, smooth.cov = x, groupCovs = "Private") +
geom_point(data = train.college, aes_string(y = "Outstate", x = x, color= "Private"), alpha = 0.2) +
geom_rug(data = train.college, aes_string(y = "Outstate", x = x, color= "Private" ), alpha = 0.2) +
scale_color_manual("Private", values = c("#868686FF", "#0073C2FF")) +
theme(legend.position="none")
g <- ggplotGrob(p)
}) %>%
{grid.arrange(grobs = (.), ncol = 3, nrow = 2)}
Update, 08. Jan. 2020.
I currently think the package mgcViz offers superior functionality compared to the voxel::plotGAMfunction. An example using the above data set and models:
library(mgcViz)
viz <- getViz(gam.college)
print(plot(viz, allTerms = T), pages = 1)
plot customization is similar go ggplot2 syntax:
trt <- plot(viz, allTerms = T) +
l_points() +
l_fitLine(linetype = 1) +
l_ciLine(linetype = 3) +
l_ciBar() +
l_rug() +
theme_grey()
print(trt, pages = 1)
This vignette shows many more examples.

Equal spacing with multiple atop

I'm trying to create a legend in a ggplot2 graph with multiple lines and a parameter and value on each line. Since I have symbols as variables, this needs to be done with expression. To create new lines, I have used multiple atop commands, but this leads to uneven spacing in the final line. Please see my following example:
library(ggplot2)
N = 25
a = -5
b = 2
sigma = 1
x = runif(N, 0, 10)
y = a + x * b + rnorm(N, sd = sigma)
df = data.frame(x, y)
ggplot(df, aes(x, y)) +
geom_point() +
geom_label(aes(x = 1, y = max(y) - 2),
label = paste0("atop(atop(",
"textstyle(a == ", a, "),",
"textstyle(b == ", b, ")),",
"textstyle(sigma == ", sigma, "))"
), parse = TRUE
)
ggsave("plotmath_atop.png", width = 6, height = 4, scale = 1)
This gives the following plot:
As you can see, the spacing between the lines b=2 and \sigma=1 is noticeably larger than the spacing between the lines a=-5 and b=2.
Is there a way of using expression with multiple line breaks while still having even spacing between each line?
you could use gridExtra::tableGrob,
library(gridExtra)
library(grid)
table_label <- function(label, params=list()) {
params <- modifyList(list(hjust=0, x=0), params)
mytheme <- ttheme_minimal(padding=unit(c(1, 1), "mm"),
core = list(fg_params = params), parse=TRUE)
disect <- strsplit(label, "\\n")[[1]]
m <- as.matrix(disect)
tg <- tableGrob(m, theme=mytheme)
bg <- roundrectGrob(width = sum(tg$widths) + unit(3, "mm"), height = sum(tg$heights) + unit(3, "mm"))
grobTree(bg, tg)
}
txt <- 'a == -5\n
b == 2\n
sigma == 1'
library(ggplot2)
qplot(1:10,1:10) +
annotation_custom(table_label(txt), xmin=0, xmax=5, ymin=7.5)
A simple solution is to avoid the use of expressions, print the sigma letter using the unicode character \u03c3, and use \n for line breaking.
library(ggplot2)
N = 25
a = -5
b = 2
sigma = 1
df = data.frame(runif(N, 0, 10), a + x * b + rnorm(N, sd = sigma))
lab <- paste0("a = ", a, "\n",
"b = ", b, "\n",
"\u03c3 = ", sigma)
ggplot(df, aes(x, y)) +
geom_point() +
geom_label(aes(x = 1, y = max(y) - 2), label = lab, parse = FALSE)
ggsave("plot_multiline_label.png", width = 6, height = 4, scale = 1)

Resources