How to make a graph for a given function in R - r

Suppose there is this function sqrt(x^2)+0.9*sqrt(3.3-x^2)*sin(30*pi*x) This function generate plot in the shape of a heart
Is there the way using ggplot2 reproduce this function to get a red heart as output?
Thanks you for your help.

A possible solution:
f <- function(x) sqrt(x^2)+0.9*sqrt(3.3-x^2)*sin(30*(pi)*x)
ggplot() +
xlim(-2, 2) +
geom_function(fun = f, color="red") +
theme(aspect.ratio=0.85)

Yet another solution. This one with the function's analytic expression.
library(ggplot2)
f <- function(x) abs(x)^(2/3)+0.9*sqrt(3.3-x^2)*sin(18*pi*x)
expr <- "y == abs(x)^frac(2, 3) + 0.9 * sqrt(3.3 - x^2) ~ sin(18 * pi * x)"
ggplot() +
geom_function(fun = f, xlim = c(-sqrt(3.3), sqrt(3.3)), n = 1e4, color = "red") +
annotate("text", x = 0, y = 3, colour = "white",
label = expr,
hjust = 0.5,
parse = TRUE) +
ylim(-2, 3.5) +
theme(
panel.background = element_rect(colour = "black", fill = "black"),
panel.grid = element_blank(),
aspect.ratio = 4/3
)
Created on 2022-03-26 by the reprex package (v2.0.1)

You will get better resolution if you directly calculate along a predefined sequence. Also, the formula is not quite right, so I have amended it:
heart <- function(x) abs(x)^(2/3) + 0.9 * sqrt(3.3 - x^2) * sin(18 * pi * x)
df <- data.frame(x = seq(-sqrt(3.3), sqrt(3.3), length = 3000),
y = heart(seq(-sqrt(3.3), sqrt(3.3), length = 3000)))
ggplot(df, aes(x, y)) +
geom_line(size = 1, colour = "red") +
scale_x_continuous(limits = c(-2, 2)) +
coord_equal() +
theme_void() +
theme(plot.background = element_rect(fill = "#400000"))

The function you mentioned:
sqrt(x^2)+0.9*sqrt(3.3-x^2)*sin(30*pi*x)
is not the one in the image.
It should be:
(x^2)^(1/3)+0.9*sqrt(3.3-x^2)*sin(30*pi*x)
I.e. use the 3rd root of (x^2), not the 2nd root.

u can do
f(x)=x^(2/3)+0.85*(4-x^2)^(1/2)*sin(a*pi*x)

Related

Customize the position of `geom_rug`

Below is a working example
library(ggplot2)
set.seed(926)
df <- data.frame(expression = rnorm(900),
time = c(rnorm(300), rnorm(300, 1, 2), rnorm(300, 2,0.5)),
membership = factor(rep(1:3, each = 300)))
ggplot(df, aes(x = time, y = expression, fill = membership)) +
geom_point(shape=21, size = 3) +
geom_rug(data = subset(df, membership ==3), sides = "b", color = "green", length = unit(1.5, "cm")) +
geom_rug(data = subset(df, membership ==2), sides = "b", color = "blue", length = unit(1, "cm")) +
geom_rug(data = subset(df, membership ==1), sides = "b", color = "red") +
scale_y_continuous(expand = c(0.3, 0))
My hope is something like
.
Note that I know the options of outside = TRUE, side = "tb" out there. But placing all rug plots at the bottom is what I really hope for.
geom_rug is designed to be drawn at the margins of a plot. It's probably best to use geom_point with a custom symbol in this case:
ggplot(df, aes(x = time, y = expression, fill = membership)) +
geom_point(shape=21, size = 3) +
geom_point(aes(y = -as.numeric(membership) - 2.5, color = membership),
shape = "|", size = 8) +
geom_hline(yintercept = -3) +
theme_classic(base_size = 20) +
scale_y_continuous(breaks = c(-2, 0, 2))
I don't think the position of geom_rug() can be easily customised. I'd recommend to use geom_segment() instead to draw the rugs like you'd want them.
library(ggplot2)
#> Warning: package 'ggplot2' was built under R version 4.2.2
set.seed(926)
df <- data.frame(expression = rnorm(900),
time = c(rnorm(300), rnorm(300, 1, 2), rnorm(300, 2,0.5)),
membership = factor(rep(1:3, each = 300)))
# Helper variables
limits <- range(df$expression)
step <- diff(limits) * 0.1
size <- 0.45 * step
ggplot(df, aes(x = time, y = expression, fill = membership)) +
geom_point(shape=21, size = 3) +
geom_segment(
aes(
colour = membership,
xend = time,
y = limits[1] - as.numeric(membership) * step + size,
yend = limits[1] - as.numeric(membership) * step - size
)
)
Created on 2022-12-12 by the reprex package (v2.0.1)

Error in seq.int(from, to, length.out = n) : 'from' must be a finite number , anyone can help me?

this is my code, and i am using both ggplot2 and reconplots:
library(ggplot2)
demanda<- function(q) (100-q/10)
oferta<- function(q) (q/4)
x_range <- 1:500
curve_intersection<- curve(demanda, oferta, empirical=FALSE,
domain=c(min(x_range),max(x_range)))
curve_intersection
ggplot() +
stat_function(aes(x_range)),color= "green",size=1,fun=demanda) +
stat_function(aes(x_range)),color= "red",size=1,fun=oferta) +
geom_vline(xintercept =curve_intersection$x,linetype= "doted" ) +
geom_hline(yintercept = curve_intersection$y,linetype="doted") +
theme_classic()
I did research on reconPlots package through their GitHub, and here's my solution
Install and load the package
library(devtools)
install_github("andrewheiss/reconPlots")
library(reconPlots)
I tried to follow the example from their GitHub and found out the example doesn't work. So I fixed some codes, and here's the result
library(ggplot2)
library(reconPlots)
demanda <- function(q) (100-q/10)
oferta <- function(q) (q/4)
x_range <- 1:500
curve_intersection <- curve_intersect(demanda, oferta, empirical=FALSE, domain=c(min(x_range),max(x_range)))
ggplot(data.frame(x_range), aes(x_range)) +
stat_function(color= "green", size=1, fun = demanda) +
stat_function(color= "red", size=1, fun = oferta) +
geom_vline(xintercept = curve_intersection$x, linetype = "dotted") +
geom_hline(yintercept = curve_intersection$y, linetype = "dotted") +
theme_classic()
Note that the curve_intersect function came from the reconPlots package, and it's different from curve function as in the graphics package in R
You must have read the example from the Github readme. They give you the wrong code on their github readme. To fix the issues, you need to do this:
library(ggplot2)
library(reconPlots)
demanda<- function(q) (100-q/10)
oferta<- function(q) (q/4)
x_range <- 1:500
curve_intersection<- curve_intersect(demanda, oferta, empirical=FALSE,
domain=c(min(x_range),max(x_range)))
ggplot() +
stat_function( color = "green", size = 1, fun = demanda) +
stat_function( color = "red", size = 1, fun = oferta) +
geom_vline(xintercept = curve_intersection$x, linetype = "dotted") +
geom_hline(yintercept = curve_intersection$y, linetype = "dotted") +
theme_classic()+
xlim(0, max(x_range))

Creating exact squares with panel.grid.major in ggplot2

i have the following issue right now;
I want to create plots with ggplot2 where the elements panel.grid.major.x and panel.grid.major.y form squares within the plot.
My solution so far includes defining the amount of major lines from the x- and y-axis of the plot as well as the option aspect.ratio in the theme options. Following code is a MWE, my actual code right now contains more options:
library(ggplot2)
#remotes::install_github("allisonhorst/palmerpenguins")
library(palmerpenguins)
equal_breaks2 <- function(n = 3, s = 0.05, ...){
function(x){
# rescaling
d <- s * diff(range(x)) / (1+2*s)
seq(min(x)+d, max(x)-d, length=n)
}
}
# This functions comes from a great answer here
# https://stackoverflow.com/questions/28436855/change-the-number-of-breaks-using-facet-grid-in-ggplot2
n_x <- 5
n_y <- 3
ggplot(palmerpenguins::penguins, aes(x = bill_depth_mm, y= bill_length_mm)) +
geom_point(aes(colour = species, shape = sex)) +
scale_color_viridis_d() +
scale_x_continuous(breaks = equal_breaks2(n = n_x, s = 0.00), expand = c(0,0)) +
scale_y_continuous(breaks = equal_breaks2(n = n_y, s = 0.00), expand = c(0,0)) +
theme(aspect.ratio = n_y/n_x,
panel.grid.minor = element_blank()) +
coord_fixed()
This plot unfortunately does not produce exact squares from the grid lines. One has to manually adjust the aspect ratio (in this example n_y=3.7 looks pretty good).
Does anyone have an idea how to solve this, without having to adjust values manually?
Edit: I forgot to mention this in my initial request; Ideally my plot limits are the min and max value of my breaks, so i also have squares at the borders of the plot.
To get a nice scale, I used scales::pretty_breaks.
Let d_x and d_y be the step size between breaks calculated by the scale function.
Let range_x and range_y be the x and y range of the data to plot.
To get squares, aspect.ratio should be :
d_x * range_y / ( d_y * range_x)
Try :
library(ggplot2)
library(scales)
data <- palmerpenguins::penguins
scale_x <- scales::pretty_breaks(n = 5)(data$bill_depth_mm)
scale_y <- scales::pretty_breaks(n = 3)(data$bill_length_mm)
d_x <- diff(scale_x)[1]
d_y <- diff(scale_y)[1]
range_x <- diff(range(scale_x))
range_y <- diff(range(scale_y))
ggplot(data, aes(x = bill_depth_mm, y= bill_length_mm)) +
geom_point(aes(colour = species, shape = sex)) +
scale_color_viridis_d() +
scale_x_continuous(breaks = scale_x, expand = c(0,0)) +
scale_y_continuous(breaks = scale_y, expand = c(0,0)) +
theme(aspect.ratio = d_x * range_y / ( d_y * range_x),
panel.grid.minor = element_blank()) +
coord_fixed(xlim=range(scale_x),ylim=range(scale_y))
So, with the great help of #Waldi, i came up with an automatic solution. Its totally viable to do all the calculation beforehand, but i wanted an automatic solution, within the ggplot-chain.
I created my own coord-ggproto object, which can calculate the aspect ratio from the internals in ggplot (According to the Formula of #Waldi).
CoordOwn <- ggproto("CoordOwn", CoordCartesian,
is_free = function() FALSE,
aspect = function(self, ranges) {
d_x = diff(ranges$x.major_source)[1]
d_y = diff(ranges$y.major_source)[1]
(d_x * diff(ranges$y.range)) / (d_y * diff(ranges$x.range))
}
)
coord_own <- function(ratio = 1, xlim = NULL, ylim = NULL, expand = TRUE, clip = "on") {
ggproto(NULL, CoordOwn,
limits = list(x = xlim, y = ylim),
ratio = ratio,
expand = expand,
clip = clip
)
}
Now i can change n_x and n_y however i want them to, and coord_own fixes the aspect ratio accordingly:
n_x <- 5
n_y <- 5
ggplot(palmerpenguins::penguins, aes(x = bill_depth_mm, y= bill_length_mm)) +
geom_point(aes(colour = species, shape = sex)) +
scale_color_viridis_d() +
scale_x_continuous(breaks = equal_breaks2(n = n_x, s = 0.00), expand = c(0,0)) +
scale_y_continuous(breaks = equal_breaks2(n = n_y, s = 0.00), expand = c(0,0)) +
theme(panel.grid.minor = element_blank()) +
coord_own()

How to increase the hexbin legend in ggplot

I have the following hexbin plot:
I would like the count to start from the lowest possible count, for example 10, and show that with different colour. Note that the lowest count differs with different datasets. Therefore, it is difficult to set it to a specific number. The script that I have written to generate the plot is:
d <- ggplot(selectedDF, aes(BEC_Agg, AC)) + geom_hex(bins = 30) + theme_bw() +
theme(text = element_text(face = "bold", size = 16)) + xlab("\nNormalized BEC") + ylab("AC\n") + scale_fill_gradientn(colors = brewer.pal(3,"Dark2"))
I tried the solution here:
d <- ggplot(selectedDF, aes(BEC_Agg, AC)) + geom_hex(aes(fill=cut(..value..,breaks=pretty(..value..,n=5))),bins = 30) + theme_bw() +
theme(text = element_text(face = "bold", size = 16)) + xlab("\nNormalized BEC") + ylab("AC\n") + scale_fill_gradientn(colors = brewer.pal(3,"Dark2"))
But I got the following error:
Error in cut(value, breaks = pretty(value, n = 5)) :
object 'value' not found
How can I fix that?
You should define the variable value before running ggplot. Since lowest count differs among datasets, you might want to try something like value <- min(count(yourDF)).
Since your focus is tweaking the legend, here is a method. A sample data is generated as you didn't provide any.
# sample dataframe
set.seed(77)
x=rnorm(1000, mean = 4, sd = 1)
y=rnorm(1000, mean = 2, sd = 0.5)
df <- data.frame(x,y)
# -------------------------------------------------------------------------
# The following is from your script
base <- ggplot(df, aes(x, y)) + geom_hex(bins = 30) + theme_bw() +
theme(text = element_text(face = "bold", size = 16)) + xlab("\nNormalized BEC") + ylab("AC\n")
# -------------------------------------------------------------------------
base_limit_break <- base + scale_fill_continuous(limits = c(1,20), breaks = c(1:20))
# -------------------------------------------------------------------------
# This is the part relevant to your question
base_limit_break + guides(fill = guide_colorbar(barheight = unit(10, "cm"), reverse = TRUE))
Output

Histogram with "negative" logarithmic scale in R

I have a dataset with some outliers, such as the following
x <- rnorm(1000,0,20)
x <- c(x, 500, -500)
If we plot this on a linear x axis scale at this we see
histogram(x)
I worked out a nice way to put it on a log scale using this useful thread:
how to use a log scale for y-axis of histogram in R? :
mat <- data.frame(x)
ggplot(ee, aes(x = xx)) + geom_histogram(colour="darkblue", size=1, fill="blue") + scale_x_log10()
However, I would like the x axis labels from this 2nd example to match that of the first example, except with a kind of "negative log" - i.e. first tick (moving from the centre to the left) could be -1, then the next could be -10, the next -100, but all equidistant. Does that make sense?
I am not sure I understand your goal, but when you want a log-like transformation yet have zeroes or negative values, the inverse hyperbolic sine transformation asinh() is often a good option. It is log-like for large values and is defined for all real values. See Rob Hyndman's blog and this question on stats.stackexchange.com for discussion, details, and other options.
If this is an acceptable approach, you can create a custom scale for ggplot. The code below demonstrates how to create and use a custom scale (with custom breaks), along with a visualization of the asinh() transformation.
library(ggplot2)
library(scales)
limits <- 100
step <- 0.005
demo <- data.frame(x=seq(from=-1*limits,to=limits,by=step))
asinh_trans <- function(){
trans_new(name = 'asinh', transform = function(x) asinh(x),
inverse = function(x) sinh(x))
}
ggplot(demo,aes(x,x))+geom_point(size=2)+
scale_y_continuous(trans = 'asinh',breaks=c(-100,-50,-10,-1,0,1,10,50,100))+
theme_bw()
ggplot(demo,aes(x,x))+geom_point(size=2)+
scale_x_continuous(trans = 'asinh',breaks=c(0,1,10,50,100))+
scale_y_log10(breaks=c(0,1,10,50,100))+ # zero won't plot
xlab("asinh() scale")+ylab("log10 scale")+
theme_bw()
Realizing that the question is fairly old, I decided to answer it anyway since I ran into exactly the same problem.
I see that some answers above misunderstood your original question. I think it is a valid visualization question and I outline below my solution that will hopefully be useful for others as well.
My approach was to use ggplot and create custom log transform for x and y axis (as well as custom break generators)
library(ggplot2)
library(scales)
# Create custom log-style x axis transformer (...,-10,-3,-1,0,1,3,10,...)
custom_log_x_trans <- function()
trans_new("custom_log_x",
transform = function (x) ( sign(x)*log(abs(x)+1) ),
inverse = function (y) ( sign(y)*( exp(abs(y))-1) ),
domain = c(-Inf,Inf))
# Custom log x breaker (...,-10,-3,-1,0,1,3,10,...)
custom_x_breaks <- function(x)
{
range <- max(abs(x), na.rm=TRUE)
return (sort( c(0,
sapply(0:log10(range), function(z) (10^z) ),
sapply(0:log10(range/3), function(z) (3*10^z) ),
sapply(0:log10(range), function(z) (-10^z) ),
sapply(0:log10(range/3), function(z) (-3*10^z) )
)))
}
# Create custom log-style y axis transformer (0,1,3,10,...)
custom_log_y_trans <- function()
trans_new("custom_log_y",
transform = function (x) ( log(abs(x)+1) ),
inverse = function (y) ( exp(abs(y))-1 ),
domain = c(0,Inf))
# Custom log y breaker (0,1,3,10,...)
custom_y_breaks <- function(x)
{
max_y <- length(x)
range <- max(abs(max_y), na.rm=TRUE)
return (sort( c(0,
sapply(0:log10(range), function(z) (10^z) ),
sapply(0:log10(range/3), function(z) (3*10^z) )
)))
}
ggplot(data=mat) +
geom_histogram(aes(x=x,fill=..count..),
binwidth = 1, color="black", size=0.1) +
scale_fill_gradient("Count", low = "steelblue", high = "red") +
coord_trans(x="custom_log_x",y="custom_log_y") +
scale_x_continuous(breaks = custom_x_breaks(mat$x)) +
scale_y_continuous(breaks = custom_y_breaks(mat$x)) +
theme(axis.text.x=element_text(angle=90,hjust=1,vjust=0.5)) +
theme_bw()
which gives me the following plot.
Note that:
the plot also includes coloring scheme to show visually the absolute value of each bar.
the bins become increasingly thinner as x increases (side effect of log-transform)
In either case, the two outliers are clearly visible.
I found a way to cheat on it. I say "cheat", because it actually plot negative and positive parts of the data separately. Thus you can not compare the negative and positive data. But only can show the distribution of negative and positive parts separately.
And one of the problem is if there is zero values in your data, it will not be shown in the plot.
reverselog_trans <- function(base = exp(1)) {
trans <- function(x) -log(x, base)
inv <- function(x) base^(-x)
trans_new(paste0("reverselog-", format(base)), trans, inv,
log_breaks(base = base),
domain = c(1e-100, Inf))
}
quartz();
dist1 <- ggplot(data=df.meltFUAC) +
geom_point(alpha=1,aes(x=deltaU.deltaUltrasensitivity,y=deltaF.deltaFitness,
colour=deltaF.w_c)) +
scale_x_continuous(name = expression(Delta * S[ult]),
limits=c(1e-7,1),trans = "log10",breaks=c(1e-01,1e-03,1e-05),
labels=c("1e-01","1e-03","1e-05")) +
scale_y_continuous(name = expression(paste(Delta, " Fitness")),trans = "log10",
limits = c(1e-7,1), breaks=c(1e-01,1e-03,1e-05),
labels=c("1e-01","1e-03","1e-05")) +
theme_bw() +
theme(legend.position = "none", axis.title.x=element_blank(),strip.background=element_blank(),
panel.border=element_rect(colour = "black"),panel.grid.major=element_blank(),
panel.grid.minor=element_blank(),plot.background=element_blank(),
plot.margin=unit(c(0,0,0,-11),"mm"))
dist2 <- ggplot(data=df.meltFUAC, aes(x=-deltaU.deltaUltrasensitivity,y=deltaF.deltaFitness,
colour=deltaF.w_c)) +
geom_point(alpha=1) +
scale_x_continuous(name = expression(Delta * sqrt(S[ult] %.% S[amp])),limits=c(1,1e-7),
trans = reverselog_trans(10),breaks=c(1e-01,1e-03,1e-05),
labels=c("-1e-01","-1e-03","-1e-05")) +
scale_y_continuous(name = expression(paste(Delta, " Fitness")),trans = "log10",
limits = c(1e-7,1), breaks=c(1e-01,1e-03,1e-05),
labels=c("1e-01","1e-03","1e-05")) +
theme_bw() +
theme(legend.position = "none",strip.background=element_blank(),panel.border=element_rect(colour = "black"),
axis.text.y=element_blank(), axis.ticks.y=element_blank(), axis.title.y=element_blank(),
axis.line.y=element_line(colour="black",size=1,linetype="solid"),axis.title.x=element_blank(),
panel.grid.major=element_blank(),panel.grid.minor=element_blank(),plot.background=element_blank(),
plot.margin=unit(c(0,-8,0,2.5),"mm"))
hist0 <- ggplot(data=df.meltFUAC, aes(deltaF.deltaFitness,fill=deltaF.w_c)) +
#geom_histogram(alpha = 0.5, aes(y=..density..),position = 'identity') +
geom_density(alpha = 0.5, aes(colour=deltaF.w_c)) +
scale_x_continuous(name = expression(paste(Delta, " Fitness")),
limits=c(1e-7,1),trans = "log10",breaks=c(1e-01,1e-03,1e-05),
labels=c("1e-01","1e-03","1e-05")) +
scale_y_continuous(name = "Density", limits=c(0,0.6)) +
theme_bw() +
theme(legend.position = "none", axis.title.x=element_blank(),strip.background=element_blank(),
axis.text.y=element_blank(), axis.ticks.y=element_blank(), axis.title.y=element_blank(),
axis.text.x=element_blank(), axis.ticks.x=element_blank(), axis.title.x=element_blank(),
panel.border=element_rect(colour = "black"),panel.grid.major=element_blank(),
panel.grid.minor=element_blank(),plot.background=element_blank(),
plot.margin=unit(c(0,5,2.5,-2.5),"mm")) +
coord_flip()
hist1 <- ggplot(data=df.meltFUAC, aes(deltaU.deltaUltrasensitivity,fill=deltaF.w_c)) +
#geom_histogram(alpha = 0.5, aes(y=..density..),position = 'identity') +
geom_density(alpha = 0.5, aes(colour=deltaF.w_c)) +
scale_x_continuous(name = expression(Delta * S[ult]),
limits=c(1e-7,1),trans = "log10",breaks=c(1e-01,1e-03,1e-05),
labels=c("1e-01","1e-03","1e-05")) +
scale_y_continuous(name = "Density", limits=c(0,0.6)) +
theme_bw() +
theme(legend.position = "none", axis.title.x=element_blank(),strip.background=element_blank(),
axis.text.y=element_blank(), axis.ticks.y=element_blank(), axis.title.y=element_blank(),
axis.text.x=element_blank(), axis.ticks.x=element_blank(), axis.title.x=element_blank(),
axis.line.x=element_line(colour="black",size=1,linetype="solid"),
panel.border=element_rect(colour = "black"),panel.grid.major=element_blank(),
panel.grid.minor=element_blank(),plot.background=element_blank(),
plot.margin=unit(c(5,0,-2.5,2),"mm"))
hist2 <- ggplot(data=df.meltFUAC, aes(-deltaU.deltaUltrasensitivity,fill=deltaF.w_c)) +
#geom_histogram(alpha = 0.5, aes(y=..density..),position = 'identity') +
geom_density(alpha = 0.5, aes(colour=deltaF.w_c)) +
scale_x_continuous(name = expression(Delta * S[ult]),limits=c(1,1e-7),
trans = reverselog_trans(10),breaks=c(1e-01,1e-03,1e-05),
labels=c("-1e-01","-1e-03","-1e-05")) +
scale_y_continuous(name = "Density", limits=c(0,0.6)) +
theme_bw() +
theme(legend.position = "none",strip.background=element_blank(),panel.border=element_rect(colour = "black"),
axis.text.y=element_blank(), axis.ticks.y=element_blank(), axis.title.y=element_blank(),
axis.text.x=element_blank(), axis.ticks.x=element_blank(), axis.title.x=element_blank(),
axis.line.y=element_line(colour="black",size=1,linetype="solid"),
axis.line.x=element_line(colour="black",size=1,linetype="solid"),
panel.grid.major=element_blank(),panel.grid.minor=element_blank(),plot.background=element_blank(),
plot.margin=unit(c(5,-8,-2.5,2.5),"mm"))
grid.newpage();
pushViewport(viewport(layout = grid.layout(3, 3, widths = unit(c(4,4,2),"null"),
heights=unit(c(2,7.5,0.5),"null"))));
vplayout <- function(x, y) viewport(layout.pos.row = x, layout.pos.col = y);
print(dist2, vp = vplayout(2, 1));
print(dist1, vp = vplayout(2, 2));
print(hist2, vp = vplayout(1, 1));
print(hist1, vp = vplayout(1, 2));
print(hist0, vp = vplayout(2, 3));
grid.text(expression(Delta * Ultrasensitivity),vp = vplayout(3,1:2),x = unit(0.55, "npc"),
y = unit(0.9, "npc"),gp=gpar(fontsize=12, col="black"));
dev.copy2pdf(file=sprintf("%s/_dist/dist_hist_deltaF_deltaU_wc_01vs10.pdf", resultDir));
dev.off();
Here is the graph it got (but you need to manually to put the legend on):
Or a simpler one:
reverselog_trans <- function(base = exp(1)) {
trans <- function(x) -log(x, base)
inv <- function(x) base^(-x)
trans_new(paste0("reverselog-", format(base)), trans, inv,
log_breaks(base = base),
domain = c(1e-100, Inf))
}
quartz();
hist1 <- ggplot(deltaF, aes(deltaFitness,fill=w_c)) + guides(fill=guide_legend(title=expression(omega[c]))) + geom_histogram(alpha = 0.5, aes(y=..density..),position = 'identity') + geom_density(alpha = 0.05, aes(colour=w_c)) + scale_x_continuous(name = expression(paste(Delta, " Fitness")),trans = "log10");
hist1 <- hist1 + scale_y_continuous(name = "Density", limits=c(0,1));
#hist1 <- hist1 + theme(panel.background=element_blank(),panel.border=element_blank(),axis.line.x=element_blank(),axis.line.y=element_line(colour="black",linetype="solid",size=1),axis.title.x=element_blank(),panel.grid.major=element_blank(),panel.grid.minor=element_blank(),plot.background=element_blank(),plot.margin=unit(c(5,5,0,5),"mm"));
hist1 <- hist1 + theme_bw();
hist1 <- hist1 + theme(strip.background=element_blank(),panel.border=element_rect(colour = "black"),axis.title.x=element_blank(),panel.grid.major=element_blank(),panel.grid.minor=element_blank(),plot.background=element_blank(),plot.margin=unit(c(5,5,0,5),"mm"));
hist1 <- hist1 + scale_color_discrete(name=expression(omega[c]));# + geom_vline(xintercept=0, colour="grey", size = 1);# + geom_hline(yintercept=0, colour="grey", size = 0.5);
hist2 <- ggplot(deltaU, aes(deltaUltrasensitivity,fill=w_c)) + geom_histogram(alpha = 0.5, aes(y=..density..),position = 'identity') + geom_density(alpha = 0.05, aes(colour=w_c)) + scale_x_continuous(name = expression(paste(Delta, " Ultrasensitivity")), limits=c(1e-7,1),trans = "log10",breaks=c(1e-01,1e-03,1e-05),labels=c("1e-01","1e-03","1e-05"));
hist2 <- hist2 + scale_y_continuous(name = "Density",limits=c(0,1)) ;#+ geom_vline(xintercept=0, colour="grey", size = 1);# + geom_hline(yintercept=0, colour="grey", size = 0.5);
#hist2 <- hist2 + theme(legend.position = "none", axis.title.x=element_blank(),panel.background=element_blank(),panel.border=element_blank(),panel.grid.major=element_blank(),panel.grid.minor=element_blank(),plot.background=element_blank(),plot.margin=unit(c(0,5,0,-7.5),"mm"));
hist2 <- hist2 + theme_bw();
hist2 <- hist2 + theme(legend.position = "none", axis.title.x=element_blank(),strip.background=element_blank(),panel.border=element_rect(colour = "black"),panel.grid.major=element_blank(),panel.grid.minor=element_blank(),plot.background=element_blank(),plot.margin=unit(c(0,5,0,-7.5),"mm"));
# + ggtitle("Positive part")
hist3 <- ggplot(deltaU, aes(-deltaUltrasensitivity,fill=w_c)) + geom_histogram(alpha = 0.5, aes(y=..density..),position = 'identity') + geom_density(alpha = 0.05, aes(colour=w_c)) + scale_x_continuous(name = expression(paste(Delta, " Ultrasensitivity")), limits=c(1,1e-7),trans = reverselog_trans(10),breaks=c(1e-01,1e-03,1e-05),labels=c("-1e-01","-1e-03","-1e-05"));
hist3 <- hist3 + scale_y_continuous(name = "Density", limits=c(0,1));# + geom_hline(yintercept=0, colour="black", size = 0.5);
#hist3 <- hist3 + theme(legend.position = "none",panel.background=element_blank(),axis.text.y=element_blank(), axis.ticks.y=element_blank(), axis.title.y=element_blank(),axis.line.y=element_line(colour="black",size=1,linetype="solid"),axis.title.x=element_blank(),panel.grid.major=element_blank(),panel.grid.minor=element_blank(),plot.background=element_blank(),plot.margin=unit(c(0,-7.5,0,5),"mm"));
hist3 <- hist3 + theme_bw();
hist3 <- hist3 + theme(legend.position = "none",strip.background=element_blank(),panel.border=element_rect(colour = "black"),axis.text.y=element_blank(), axis.ticks.y=element_blank(), axis.title.y=element_blank(),axis.line.y=element_line(colour="black",size=1,linetype="solid"),axis.title.x=element_blank(),panel.grid.major=element_blank(),panel.grid.minor=element_blank(),plot.background=element_blank(),plot.margin=unit(c(0,-7.5,0,5),"mm"));
# + ggtitle("Negative part")
grid.newpage();
pushViewport(viewport(layout = grid.layout(4, 2, widths = unit(c(5,5),"null"),heights=unit(c(4.6,0.4,4.6,0.4),"null"))));
vplayout <- function(x, y) viewport(layout.pos.row = x, layout.pos.col = y);
print(hist1, vp = vplayout(1, 1:2)); # key is to define vplayout
grid.text(expression(paste(Delta, " Fitness")),vp = vplayout(2,1:2),x = unit(0.5, "npc"), y = unit(0.9, "npc"),gp=gpar(fontsize=12, col="black"));
print(hist3, vp = vplayout(3, 1));
print(hist2, vp = vplayout(3, 2));
grid.text(expression(paste(Delta, " Ultrasensitivity")),vp = vplayout(4,1:2),x = unit(0.5, "npc"), y = unit(0.9, "npc"),gp=gpar(fontsize=12, col="black"));
dev.copy2pdf(file=sprintf("%s/deltaF_deltaU_wc_01vs10.pdf", resultDir));
dev.off();
Here is the graph I got:
Why suffer with ggplot2 solution? Your first plot was done with lattice histogram function, and this is where you should stay. Just apply logarithmic transformation directly within histogram function, use nint argument to specify the number of histogram bins, and type argument to choose between "count", or "density". I think that you got everything you need there, but maybe I'm missing some crucial detail of your question...
library(lattice)
histogram(log10(x), nint=50, type="count")

Resources