I've been trying to plot different exponential decay curves on to one graph. Initially I thought this would be rather be easy but it is turning out to be rather frustrating.
What I want to get:
nlsplot(k_data_nls, model = 6, start = c(a= 603.3, b= -0.03812), xlab = "hours", ylab = "copies")
nlsplot(r4, model=6, start=c(a=25.5487,b=-0.5723), xlab = "hours", ylab = "copies")
Here is some additional code for the data:
df4 <- data.frame(hours=c(0,1,3,5,12,24,48,96,168,336,504,720), copies=c(603.3,406,588,393.27,458.47,501.67,767.53,444.13,340.6,298.47,61.42,51.6))
nlsfit(df4, model=6, start=c(a=603.3,b=-0.009955831526))
d4plot <- nlsplot(df4, model=6, start=c(a=603.3,b=-0.009955831526))
r4 <- data.frame(hours=c(0,1,3,5,12,24,48,96,168,336,504,720), copies=c(26,13.44,4.57,3.12,6.89,0.71,0.47,0.47,0,0,0.24,0.48))
nlsLM(copies ~ a*exp(b*hours), data=r4, start=list(a=26,b=-0.65986))
r4plot <- nlsplot(r4, model=6, start=c(a=25.5487,b=-0.5723))
Essentially I want to be able to get both of these plots on one graph. I'm new to R so I'm not too sure where I can go from here. Thank you !
I don't know if this is actually helpful because it's so specific, but this is how I would do it (with ggplot2). First, you need data for the function you want to plot. Take the x for all the values you want to display and apply your function with your coefficients to the data. You need to have data points, not just a function, to plot data.
df_simulated <- data.frame("x" = rep(1:100, 2),
"class"= rep(c("DNA", "RNA"), each = 100))
df_simulated$y <- c(1683.7 * exp(-0.103 * 1:100), # DNA
578.7455 * exp(-0.156 * 1:100)) # RNA
However, since I never used the packages you used, I don't know how to extract the values from the models, so I took the values in your example plot. It's important that the "simulated" values for both groups are within one dataframe, and that you have a column which attributes the points to the respective group (RNA or DNA). At least it's easier if you do it like this. Then you need a data frame with your actual observations for the dots. I invented data again:
df_observed <- data.frame("x" = c(12, 13, 25, 26, 50, 51),
"y" = c(500, 50, 250, 25, 0, 5),
"class" = rep(c("DNA", "RNA"), 3))
Then you can create the plot. With color=class you specify that the data points will be grouped by "class" and will be colored accordingly. ("apple" and "banana" are just dummy words to demonstrate linebreaks)
ggplot() +
geom_line(data = df_simulated, aes(x = x, y = y, color = class), size = 1, linetype = "dashed") +
geom_point(data = df_observed, aes(x = x, y = y, color = class), size = 4, pch = 1) +
annotate("text", x = 50, y = 1250, label = "DNA\napple", color = "tomato", hjust = 0) +
annotate("text", x = 50, y = 750, label ="RNA\nbanana", color = "steelblue", hjust = 0) +
ggtitle(expression(~italic("Styela clava")~"(isolated)")) +
ylab("COI copies per 1ml") +
xlab("Time since removal of organisms (hours)") +
theme_classic() +
theme(legend.position = "none") +
scale_color_manual(values = c("DNA" = "tomato", "RNA" = "steelblue"))
This is the output:
First note that R squared is normally used for linear models and not for nonlinear models so the use of this statistic is suspect here; however, below we show it anyways since it seems that is what was asked for. A different goodness of fit measurement that is often used is residual standard error. If fm is the fitted model from nls then sigma(fm) is the residual standard error. Smaller values are more favorable. summary(fm) also reports this value.
For each of df4 and r4 we use lm to get starting values (taking log of both sides we get a model that is linear in log(a) and b), run nls fits and get the coefficients.
Now plot the points and add the fitted lines and legend. (Note that in setting up the graph we use rbind which assumes that df4 and r4 have the same column names, which they do.)
Note that the data provided in the question is much different than that shown in the question's image.
The code below does not need starting values since it uses lm to get them, runs nls and automatically extracts whatever information is needed for the graph.
1) Classic graphics In this alternative no packages are used.
r2 <- function(fm, digits = 3) {
y <- fitted(fm) + resid(fm)
r2 <- 1 - deviance(fm) / sum((y - mean(y))^2)
if (is.numeric(digits)) r2 <- round(r2, digits)
r2
}
fo <- copies ~ a * exp(b * hours) # formula used in nls
# get nls fitted model and coefficients for df4
co_d0 <- coef(lm(log(copies) ~ hours, df4, subset = copies > 0))
fmd <- nls(fo, df4, start = list(a = exp(co_d0[[1]]), b = co_d0[[2]]))
co_d <- round(coef(fmd), 4)
# get nls fitted model and coefficients for r4
co_r0 <- coef(lm(log(copies) ~ hours, r4, subset = copies > 0))
fmr <- nls(fo, r4, start = list(a = exp(co_r0[[1]]), b = co_r0[[2]]))
co_r <- round(coef(fmr), 4)
both <- rbind(cbind(df4, col = "red"), cbind(r4, col = "blue"))
plot(both[1:2], col = both$col,
xlab = "Time since removal of organisms", ylab = "COI copies per 1ml",
main = "C)" ~ italic("Styela clava") ~ "(isolated)", adj = 0)
lines(fitted(fmd) ~ hours, df4, col = "red", lty = 2)
lines(fitted(fmr) ~ hours, r4, col = "blue", lty = 2)
legend <- c(bquote(DNA),
bquote(y == .(co_d[[1]]) * e ^ {.(co_d[[2]])*x}),
bquote(R^2 == .(r2(fmd))),
bquote(),
bquote(RNA),
bquote(y == .(co_r[[1]]) * e ^ {.(co_r[[2]])*x}),
bquote(R^2 == .(r2(fmr))))
legend("right", legend = as.expression(legend), bty = "n",
text.col = c("red", "red", "red", NA, "blue", "blue", "blue"))
2) ggplot2 This uses ggplot2 and gridtext. r2, fmd, fmr, co_d and co_r are all taken from (1). We use richtest_grob from gridtext to create a custom grob for the legend and pass it using annotate_custom.
library(gridtext)
library(ggplot2)
txt <- sprintf(
"<span style='color:red'>DNA
<br>y = %.3f*e<sup>%.3fx</sup>
<br>R<sup>2</sup> = %.3f</span>
<br><br><span style='color:blue'>RNA
<br>y = %.3f*e<sup>%.3fx</sup>
<br>R<sup>2</sup> = %.3f</span>",
co_d[[1]], co_d[[2]], r2(fmd), co_r[[1]], co_r[[2]], r2(fmr))
both2 <- rbind(cbind(df4, col = "red", fitted = fitted(fmd)),
cbind(r4, col = "blue", fitted = fitted(fmr)))
ggplot(both2, aes(hours, copies, col = I(col))) +
geom_point() +
geom_line(aes(y = fitted), linetype = 2) +
annotation_custom(richtext_grob(txt, hjust = 0)) +
theme(legend.position = "none") +
labs(x = "Time since removal of organisms", y = "COI copies per 1ml") +
ggtitle(("C)" ~ italic("Styela clava") ~ "(isolated)"))
3) lattice
This uses legend from (1) and both2 from (2). First create a plot for the data points. It will also contain the legend, axes and labels. Then add a layer for the fitted lines. main.settings specifies that the main title should be left justified and bold and is adapted from this page.
library(latticeExtra)
main.settings <- list(par.main.text = list(font = 2, just = "left",
x = grid::unit(25, "mm")))
xyplot(copies ~ hours, both2, col = both2$col,
xlab = "Time since removal of organisms", ylab = "COI copies per 1ml",
main = "C)" ~ italic("Styela clava") ~ "(isolated)", adj = 0,
key = list(text = list(as.expression(legend),
col = c("red", "red", "red", NA, "blue", "blue", "blue")),
x = 0.65, y = 0.65, columns = 1),
par.settings = main.settings) +
as.layer(xyplot(fitted ~ hours, both2, groups = col, type = "l", lty = 2))
Simplifying and trying to make my error reproducible, my code is the following, it generates a histogram and set x axis and y axis afterwards:
set.seed(100)
dist <- data.frame(rnorm(200, sd = 300000))
histogram <- hist(dist$rnorm.200., col = "orange", breaks = 100, main = "VaR distribution", xlab = "P&L", axes = FALSE)
axis(1, at = seq(min(dist), max(dist), length = 7))
labels(formatC(seq(min(dist$rnorm.200.)/1000000, max(dist$rnorm.200.)/1000000, length = 7), format = "d", digits = 0))
axis(2, at = seq(from = 0, to = max(histogram$counts), by = 5))
labels(formatC(seq(from = 0, to = max(histogram$counts), by = 5), format = "d"))
The command to set labels on axis y works, but the x axis labels command doesn't, which is the following:
axis(1, at = seq(min(dist), max(dist), length = 7))
labels(formatC(seq(min(dist$rnorm.200.)/1000000, max(dist$rnorm.200.)/1000000, length = 7), format = "d", digits = 0))
instead of getting a sequence of 7 values of dist$norm.200. divided by 1000000 and without decimals, I get the default values set by histogram() function.
Could anyone help me?
Edition: Neither the y axis labels command nor x works, I thank it did in my original code because it matched causally.
you should use labels as an argument of the axis() function, not as a separate function. Something like this:
set.seed(100)
dist <- data.frame(rnorm(200, sd = 300000))
histogram <- hist(dist$rnorm.200., col = "orange", breaks = 100, main = "VaR distribution", xlab = "P&L", axes = FALSE)
axis(1, at = seq(min(dist), max(dist), length = 7), labels = formatC(seq(min(dist$rnorm.200.)/1000000, max(dist$rnorm.200.)/1000000, length = 7), format = "d", digits = 0))
axis(2, at = seq(from = 0, to = max(histogram$counts), by = 5), labels = (formatC(seq(from = 0, to = max(histogram$counts), by = 5), format = "d")))
Also, you should realize formatC(seq(min(dist$rnorm.200.)/1000000, max(dist$rnorm.200.)/1000000, length = 7), format = "d", digits = 0) only returns zeroes, so perhaps you'd like to give some more attention towards what these labels actually should be. (Perhaps divide by 100000 instead?)
Here is a ggplot2 approach. I myself find the code to be more readible, an so: easier to maintain.
set.seed(100)
dist <- data.frame(rnorm(200, sd = 300000))
library(ggplot2)
ggplot(dist, aes( x = dist[,1] ) ) +
geom_histogram( bins = 100, color = "black", fill = "orange" ) +
scale_x_continuous( labels = function(x){x / 100000} ) +
labs( title = "VaR distribution",
x = "P&L",
y = "Frequency" )
This question already has answers here:
How to overlay density plots in R?
(8 answers)
Closed 4 years ago.
I have the following data set
set.seed(1)
startdate <- as.Date('2000-01-01')
enddate <- as.Date('2000-01-10')
Data <- data.frame(id = rep((1:1000),10),
group = rep(c("0","1"), 25),
IV = sample(1:100),
DV = sample(c("1", "0"), 10, replace = TRUE),
date = as.Date(
sample(as.numeric(start_date):
as.numeric(end_date), 1000,
replace = T), origin = '1970-01-01'))
I want to get two density plots for multiple groups (here, group = 1 and group = 0) and a vertical line on a defined point.
How do I do this?
To get the density plots and the line, do (description see in code comments)
Data$date_f <- as.factor(Data$date) # date as factor
Data$date_i <- as.integer(Data$date_f) # date as int
Data$date <- Data$date_i[!is.na(Data$date_i)] # excl missing
# date by group
date_1 <- Data$date_i[Data$group == "1"] # date group 1
date_2 <- Data$date_i[Data$group == "0"] # date group 2
# exclude missing
date_1 <- date_1[!is.na(date_1)]
date_2 <- date_2[!is.na(date_2)]
#View(date_i)
#plot
plot(density(date_1), xaxt='n', xlab = 'Date', lwd = 2.5, ylab = 'Density', main = 'Density and Line', las=1, col = "black", lty = 1) # line and labels
lines(density(date_2), col = 'blue', lwd = 2.5, lty = 1) # other line, repeat for each group
abline(v= 8, col='black', lwd = 1.5, lty = 1) # vertical line
tx=seq(min(date_1), max(date_1), by = 2) #labels
lb=levels(Data$date_f)[tx] #insert labels
axis(side = 1,at=tx,labels=lb, las=0.2) #insert axis
I have a matrix with three variables Row = Time, column = Date and the third variable Money which its value is an intersection of rows and columns. e.g. For Time = 5 and Date = 10, Money is 12 and for Time = 6 and Date = 15, Money is 15. I would like to draw the value of Money for the intersection of x_axis = Time and Y_axis = Date.
How to place Money in below?
plot.new()
matplot(Time,Date, type = "p", lty = 1:5, lwd = 1, lend = par("lend"),col = 1,
pch = 17 , xlab = "Time", ylab = "Date", xlim = range(0,40), ylim = range (0,120))
I think you could use geom_raster if you convert your data to a data.frame first:
ggplot(data, aes(Time, Date)) +
geom_raster(aes(fill = Money))
See more on this here: http://docs.ggplot2.org/current/geom_tile.html
edit:
see with random data here:
time <- c(1:100)
date <- c(1:100)
data <- expand.grid(TIME = time, DATE = date)
data$MONEY <- runif(1:10000, 0, 10)
ggplot(data, aes(TIME, DATE)) +
geom_raster(aes(fill = MONEY), interpolate = F)
I wanna make a scatter plot with connecting lines for different groups and different individuals. I make panels conditioned by my group variable and groups conditioned by my individual variables. Now, I would like to add legend inside each panels(see the code below). In the plots, I would like to have legends of individuals for GRP==1 in the first panel, GRP==2 in the second panel, so on so forth. All the legends are located in the upper left corner of the panel they belong to. How shall I code?
library(lattice)
mydata <- data.frame(ID = rep(1: 20, each = 10),
GRP = rep(1: 4, each = 50),
x = rep(0: 9, 20))
mydata$y <- 1.2 * mydata$GRP * mydata$x +
rnorm(nrow(mydata), sd = mydata$GRP)
xyplot(y~ x | factor(GRP), data = mydata,
groups = ID,
type = "b",
as.table = T,
layout = c(2, 2),
panel = panel.superpose,
panel.groups = function (x, y, ...) {
panel.xyplot(x, y, ...)
}
)
Try something like this. Note that the subset command comes in the data statement in xyplot. This is on purpose. If you call subset as an xyplot argument, then the plots would have shown all 20 labels in each plot.
library(lattice)
mydata <- data.frame(ID = rep(1:20, each = 10), GRP = rep(1:4, each = 50), x = rep(0:9, 20))
mydata$y <- 1.2 * mydata$GRP * mydata$x + rnorm(nrow(mydata), sd = mydata$GRP)
i=1; j=1
for(grp in 1:4) {
a <- xyplot(y~x|factor(GRP), data=subset(mydata, GRP==grp),
groups = factor(ID),
type = "b",
auto.key=list(columns=4,space="inside")
)
print(a, split=c(i,j,2,2), more=T)
i=i+1; if(i>2){i=1;j=j+1} # basically, tell the plots which quadrant to go in
}