I have to plot constraints in R and it's very new to me. Please could someone give me some help.
x1 + 2*x2 <= 100
3x1 + x2 <= 75
Many thanks
Update:
You can use geom_polygon to shade the constraint sets. With linear constraints, the edges of the constraint set are easy to compute.
library(ggplot2)
ggplot(data_frame(x = c(0, 100)), aes(x = x)) +
stat_function(fun = function(x) {(100 - x)/2}, aes(color = "Function 1")) +
stat_function(fun = function(x) {(75 - 3*x) }, aes(color = "Function 2")) +
theme_bw() +
scale_color_discrete(name = "Function") +
geom_polygon(
data = data_frame(
x = c(0, 0, 100, Inf),
y = c(0, 50, 0, 0)
),
aes(
x = x, y = y, fill = "Constraint 1"
),
inherit.aes = FALSE, alpha = 0.4
) +
geom_polygon(
data = data_frame(
x = c(0, 0, 25, Inf),
y = c(0, 75, 0, 0)
),
aes(
x = x, y = y, fill = "Constraint 2"
),
inherit.aes = FALSE, alpha = 0.4
) +
scale_fill_discrete(name = "Constraint Set") +
scale_y_continuous(limits = c(0, 100))
This gives:
Use stat_function. Here is a simple example:
ggplot(data_frame(x = c(0, 100)), aes(x = x)) +
stat_function(fun = function(x) {(100 - x)/2}, aes(color = "Function 1")) +
stat_function(fun = function(x) {(75 - 3*x) }, aes(color = "Function 2")) +
theme_bw() +
scale_color_discrete(name = "Function")
There are some enhancements that you can make, like shading the area under the constraint, and to add labels to the constraint lines.
Related
I have created a random walk plot using ggplot2 (code below). I wondered if it would be possible to use the gganimate package so that the random walk process (the black line in the plot) gradually appears but stops once it touches the grey horizontal dashed line.
set.seed(3344)
create_random_walk <- function(number=500){
data.frame(x = rnorm(number),
rown = c(1:500)) %>%
mutate(xt = cumsum(x))
}
randomwalkdata <- rbind(mutate(create_random_walk(), run = 1))
p <- ggplot(randomwalkdata, aes(x = rown, y = xt)) +
geom_line() +
labs(x = '\nTime (arbitrary value)', y = 'Evidence accumulation\n') +
theme_classic()
p + geom_segment(aes(x = 0.5, xend = 500, y = 25, yend = 25, linetype = 2), colour = "grey", size = 1, show.legend = FALSE) +
scale_linetype_identity()
Can anybody help?
library(gganimate); library(dplyr)
animate(
ggplot(randomwalkdata |> filter(cumsum(lag(xt, default = 0) >= 25) == 0),
aes(x = rown, y = xt)) +
geom_line() +
geom_point(data = . %>% filter(rown == max(rown)),
size = 10, shape = 21, color = "red", stroke = 2) +
labs(x = '\nTime (arbitrary value)', y = 'Evidence accumulation\n') +
theme_classic() +
annotate("segment", x = 0.5, xend = 500, y = 25, yend = 25, linetype = 2,
colour = "grey", linewidth = 1) +
scale_linetype_identity() +
transition_reveal(rown),
end_pause = 20, width = 600)
I can't seem to arrange the order of legend items when using the new_scale_color() feature of the ggnewscale package. Here's a minimal example:
n <- 10
sd_res <- 1
beta0 <- 0
beta1 <- 1
x <- runif(n, 0, 10)
y <- beta0 + beta1*x + rnorm(n, 0, sd_res)
dat <- data.frame(x,y)
ggplot() + theme_minimal() + labs(x = '', y = '') +
geom_abline(aes(color = 'x', linetype = 'x', slope = 1, intercept = 0)) +
geom_abline(aes(color = 'y', linetype = 'y', slope = 2, intercept = 0)) +
scale_color_manual(name = '', values = c('x' = 'orange', 'y' = 'black')) +
scale_linetype_manual(name = '', values = c('x' = 1, 'y' = 2)) +
new_scale_color() +
geom_point(data=dat, aes(x=x, y=y, shape = 'z', size = 'z', color = 'z'), alpha = 1) +
scale_size_manual(name = '', values = c('z' = 1.5)) +
scale_shape_manual(name = '', values = c('z' = 16)) +
scale_color_manual(name = '', values = c('z' = 'black')) +
theme(legend.position = 'bottom')
What I'd like is for the z-item to appear before the x- and y-items in the legend.
You could use guides with guide_legend and specify the order of your aes. Here I set the order of your "z" to 1 which will set it as the first legend like this:
n <- 10
sd_res <- 1
beta0 <- 0
beta1 <- 1
x <- runif(n, 0, 10)
y <- beta0 + beta1*x + rnorm(n, 0, sd_res)
dat <- data.frame(x,y)
library(ggplot2)
library(ggnewscale)
p <- ggplot() + theme_minimal() + labs(x = '', y = '') +
geom_abline(aes(color = 'x', linetype = 'x', slope = 1, intercept = 0)) +
geom_abline(aes(color = 'y', linetype = 'y', slope = 2, intercept = 0)) +
scale_color_manual(name = '', values = c('x' = 'orange', 'y' = 'black')) +
scale_linetype_manual(name = '', values = c('x' = 1, 'y' = 2)) +
new_scale_color() +
geom_point(data=dat, aes(x=x, y=y, shape = 'z', size = 'z', color = 'z'), alpha = 1) +
scale_size_manual(name = '', values = c('z' = 1.5)) +
scale_shape_manual(name = '', values = c('z' = 16)) +
scale_color_manual(name = '', values = c('z' = 'black')) +
theme(legend.position = 'bottom') +
guides(size = guide_legend(order = 1),
color = guide_legend(order = 1),
shape = guide_legend(order = 1))
p
Created on 2022-08-26 with reprex v2.0.2
When using ggnewscale, I don't recommend using guides() to define guides, since the name of the aesthetics change internally. It's better to use the guide argument of the scale_ function
Example from ggnewscale documentation:
library(ggplot2)
library(ggnewscale)
# Equivalent to melt(volcano)
topography <- expand.grid(x = 1:nrow(volcano),
y = 1:ncol(volcano))
topography$z <- c(volcano)
# point measurements of something at a few locations
set.seed(42)
measurements <- data.frame(x = runif(30, 1, 80),
y = runif(30, 1, 60),
thing = rnorm(30))
ggplot(mapping = aes(x, y)) +
geom_contour(data = topography, aes(z = z, color = stat(level))) +
# Color scale for topography
scale_color_viridis_c(option = "D",
guide = guide_colorbar(order = 2)) +
# geoms below will use another color scale
new_scale_color() +
geom_point(data = measurements, size = 3, aes(color = thing)) +
# Color scale applied to geoms added after new_scale_color()
scale_color_viridis_c(option = "A",
guide = guide_colorbar(order = 8))
Created on 2022-08-26 by the reprex package (v2.0.1)
I am trying to reproduce this kind of Figure, with two densities, a first one pointing upwards and a second one pointing downwards. I would also like to have some blank space between the two densities.
Here is the code I am currently using.
library(hrbrthemes)
library(tidyverse)
library(RWiener)
# generating data
df <- rwiener(n = 1e2, alpha = 2, tau = 0.3, beta = 0.5, delta = 0.5)
df %>%
ggplot(aes(x = q) ) +
geom_density(
data = . %>% filter(resp == "upper"),
aes(y = ..density..),
colour = "steelblue", fill = "steelblue",
outline.type = "upper", alpha = 0.8, adjust = 1, trim = TRUE
) +
geom_density(
data = . %>% filter(resp == "lower"),
aes(y = -..density..), colour = "orangered", fill = "orangered",
outline.type = "upper", alpha = 0.8, adjust = 1, trim = TRUE
) +
# stimulus onset
geom_vline(xintercept = 0, lty = 1, col = "grey") +
annotate(
geom = "text",
x = 0, y = 0,
# hjust = 0,
vjust = -1,
size = 3, angle = 90,
label = "stimulus onset"
) +
# aesthetics
theme_ipsum_rc(base_size = 12) +
theme(axis.text.y = element_blank() ) +
labs(x = "Reaction time (in seconds)", y = "") +
xlim(0, NA)
Which results in something like...
How could I add some vertical space between the two densities to reproduce the above Figure?
If you want to try without faceting, you're probably best to just plot the densities as polygons with adjusted y values according to your desired spacing:
s <- 0.25 # set to change size of the space
ud <- density(df$q[df$resp == "upper"])
ld <- density(df$q[df$resp == "lower"])
x <- c(ud$x[1], ud$x, ud$x[length(ud$x)],
ld$x[1], ld$x, ld$x[length(ld$x)])
y <- c(s, ud$y + s, s, -s, -ld$y - s, -s)
df2 <- data.frame(x = x, y = y,
resp = rep(c("upper", "lower"), each = length(ud$x) + 2))
df2 %>%
ggplot(aes(x = x, y = y, fill = resp, color = resp) ) +
geom_polygon(alpha = 0.8) +
scale_fill_manual(values = c("steelblue", "orangered")) +
scale_color_manual(values = c("steelblue", "orangered"), guide = guide_none()) +
geom_vline(xintercept = 0, lty = 1, col = "grey") +
annotate(
geom = "text",
x = 0, y = 0,
# hjust = 0,
vjust = -1,
size = 3, angle = 90,
label = "stimulus onset"
) +
# aesthetics
theme_ipsum_rc(base_size = 12) +
theme(axis.text.y = element_blank() ) +
labs(x = "Reaction time (in seconds)", y = "")
you can try facetting
set.seed(123)
q=rbeta(100, 0.25, 1)
df_dens =data.frame(gr=1,
x=density(df$q)$x,
y=density(df$q)$y)
df_dens <- rbind(df_dens,
data.frame(gr=2,
x=density(df$q)$x,
y=-density(df$q)$y))
ggplot(df_dens, aes(x, y, fill = factor(gr))) +
scale_x_continuous(limits = c(0,1)) +
geom_area(show.legend = F) +
facet_wrap(~gr, nrow = 2, scales = "free_y") +
theme_minimal() +
theme(strip.background = element_blank(),
strip.text.x = element_blank(),
axis.text.y = element_blank(),
axis.title.y = element_blank())
The space between both plots can be increased using panel.spacing = unit(20, "mm"). Instead of facet_grid you can also try facet_grid(gr~., scales = "free_y")
I'm trying to plot a histogram with ggplot2.
I wrote a simple code for this in R
dnorm.count <- function(x, mean = 0, sd = 1, log = FALSE, n = 1, binwidth = 1){
n * binwidth * dnorm(x = x, mean = mean, sd = sd, log = log)
}
mtcars %>%
ggplot(aes(x = mpg)) +
geom_histogram(bins =60,color = "white", fill = "#9FE367",boundary = 0.5) +
geom_vline(aes(xintercept = mean(mpg)),
linetype="dashed",
size = 1.6,
color = "#FF0000")+
geom_text(aes(label = ..count..), stat= "count",vjust = -0.6)+
stat_function(fun = dnorm.count, color = "#6D67E3",
args = list(mean= mean(mtcars$mpg),
sd = sd(mtcars$mpg),
n = nrow(mtcars)),
lwd = 1.2) +
scale_y_continuous(labels = comma, name = "Frequency") +
scale_x_continuous(breaks=seq(0,max(mtcars$mpg)))+
geom_text(aes(label = paste0("mean = ", round(mean(mtcars$mpg), 2)),
x = mean(mtcars$mpg)*1.2,
y = mean(mtcars$mpg)/5))+
geom_vline(aes(xintercept = sd(mpg)), linetype="dashed",size = 1.6, color = "#FF0000")
What I got is this!
The question is how do I Plot the histogram similar to this
using ggplot2 and is it possible to convert the code to R function?
Edit: For the better explanation of what I'm trying to do:
I wanna create a Histogram exactly the same as the one attached for reference using ggplot2 and then I wanna create a function for the same to reduce the coding. Use any package+ggplot2 you like. The histograms should have lines depicting the standard deviation & mean like the one in reference. If possible depict the standard deviation in the plot as the reference image, that's what I'm trying to achieve.
If your question how to plot histograms like the one you attached in your last figure, this 9 lines of code produce a very similar result.
library(magrittr) ; library(ggplot2)
set.seed(42)
data <- rnorm(1e5)
p <- data %>%
as.data.frame() %>%
ggplot(., aes(x = data)) +
geom_histogram(fill = "white", col = "black", bins = 30 ) +
geom_density(aes( y = 0.3 *..count..)) +
labs(x = "Statistics", y = "Probability/Density") +
theme_bw() + theme(axis.text = element_blank())
You could use annotate() to add symbols or text and geom_segment to show the intervals on the plot like this:
p + annotate(x = sd(data)/2 , y = 8000, geom = "text", label = "σ", size = 10) +
annotate(x = sd(data) , y = 6000, geom = "text", label = "2σ", size = 10) +
annotate(x = sd(data)*1.5 , y = 4000, geom = "text", label = "3σ", size = 10) +
geom_segment(x = 0, xend = sd(data), y = 7500, yend = 7500) +
geom_segment(x = 0, xend = sd(data)*2, y = 5500, yend = 5500) +
geom_segment(x = 0, xend = sd(data)*3, y = 3500, yend = 3500)
This chunk of code would give you something like this:
I'm trying to learn R from scratch and I just delivered a college assignment for hypothesis testing a binomial distribution (proportion test for one sample) that I used R to solve and plot. But I ran into some problems.
My sample size is 130, success cases are 68.
H0: π = 50%
H1: π > 50
The is the code I used (plenty of copy-paste and trial/error)
library(ggplot2)
library(ggthemes)
library(scales)
#data
n = 130
p = 1/2
stdev = sqrt(n*p*(1-p))
mean_binon = n*p
cases = 68
ztest = (cases-mean_binon)/stdev
pvalor = pnorm(-abs(ztest))
zcrit = qnorm(0.975)
#normal curve
xvalues <- data.frame(x = c(-4, 4))
#first plots and lines
p1 <- ggplot(xvalues, aes(x = xvalues))
p2 <- p1 + stat_function(fun = dnorm) + xlim(c(-4, 4)) +
geom_vline(xintercept = ztest, linetype="solid", color="blue",
size=1) +
geom_vline(xintercept = zcrit, linetype="solid", color="red",
size=1)
#z area function
area_z <- function(x){
norm_z <- dnorm(x)
norm_z[x < ztest] <- NA
return(norm_z)
}
#critical z area function
area_zc <- function(x){
norm_zc <- dnorm(x)
norm_zc[x < zcrit] <- NA
return(norm_zc)
}
#area value
valor_area_z <- round(pnorm(4) - pnorm(ztest), 3)
valor_area_zc <- round(pnorm(4) - pnorm(zcrit), 3)
#final plot
p3 <- p2 + stat_function(fun = dnorm) +
stat_function(fun = area_z, geom = "area", fill = "blue", alpha = 0.3) +
geom_text(x = 1.13, y = 0.1, size = 5, fontface = "bold",
label = paste0(valor_area_z * 100, "%")) +
stat_function(fun = area_zc, geom = "area", fill = "red", alpha = 0.5) +
geom_text(x = 2.27, y = 0.015, size = 3, fontface = "bold",
label = paste0(valor_area_zc * 100, "%")) +
scale_x_continuous(breaks = c(-3:3)) +
labs(x = "\n z", y = "f(z) \n", title = "Distribuição Normal \n") +
theme_fivethirtyeight()
p3
Here's the plot
There is a gap between my geom_vline's and the shaded area. I'm not sure if I'm doing the wrong steps with my statistics or this is an R related problem. Maybe both? Sorry if this is elementary. I'm not good at both but I'm trying to improve.
A solution is to use the option xlim inside stat_function which defines the range of the function. You can also replace area_z and area_zc with dnorm.
p3 <- p2 + stat_function(fun = dnorm) +
stat_function(fun = dnorm, geom = "area", fill = "blue", alpha = 0.3,
xlim = c(ztest,zcrit)) +
geom_text(x = 1.13, y = 0.1, size = 5, fontface = "bold",
label = paste0(valor_area_z * 100, "%")) +
stat_function(fun = dnorm, geom = "area", fill = "red", alpha = 0.5,
xlim = c(zcrit,xvalues$x[2])) +
geom_text(x = 2.27, y = 0.015, size = 3, fontface = "bold",
label = paste0(valor_area_zc * 100, "%")) +
scale_x_continuous(breaks = c(-3:3)) +
labs(x = "\n z", y = "f(z) \n", title = "Distribuição Normal \n") +
theme_fivethirtyeight()
p3