So, I've a t-dist plot created in R using curve and adding on the polygons onto that. It gives me a basic looking plot.
What I need is a more good looking plot where
X-axis starts from -6
Y-axis starts from 0
Background of the plot(except under the curve) is filled with some color which I need
I think I need to use the ggplot2 package for this, so answers based on ggplot2 usage is what I need. Or any answer that would return me that output is appreciated.
Here is my code
curve(dt(x, df = 7), from = -6, to = 6)
x <- seq(-1.96, -6, len = 100)
y <- dt(x, 7)
x1 <- seq(1.96, 6, len = 100)
y1 <- dt(x1, 7)
polygon(c(x1[1], x1, x1[100]), c(dt(-6, 7), y1, dt(6, 7)),
col = "#b14025", border = "black")
polygon(c(x[1], x, x[100]), c(dt(-6, 7), y, dt(6, 7)),
col = "#b14025", border = "black")
First Image is the current Output
Second Image is what I think it should look like
Here is one way to obtain a similar result using the ggplot2 package:
library(ggplot2)
dt_tails <- function(x){
y <- dt(x,7)
y[abs(x) < 1.96] <- NA
return(y)
}
dt_7 <- function(x) dt(x,7)
p <- ggplot(data.frame(x=c(-6,6)),aes(x=x)) +
stat_function(fun=dt_7, geom="area", fill="white", colour="black")
p <- p + stat_function(fun=dt_tails, geom="area", fill='#b14025')
p <- p + theme(panel.grid.major=element_blank(),
panel.grid.minor=element_blank(),
panel.background=element_rect(fill="#eae9c8") )
plot(p)
Since you expected a ggplot answer, just add + theme(panel.background = element_rect(fill = "yellow")) to your plot or what ever color you like.
I finally managed to do it with the base plotting functions only.
For Shading the area outside curve: I just added one more polygon tracing the area outside the curve.
For fixing the graph to start at the required X and Y, I used another parameter of plot function xaxs & yaxs from this Link
Here is my attached code
curve(dt(x, df = 7), from = -6, to = 6,xaxs="i",yaxs="i",ylim=c(0,0.4))
t = seq(-6,6,len = 100)
yt = dt(t,7)
x <- seq(-1.96, -6, len = 100)
y <- dt(x, 7)
x1 <- seq(1.96, 6, len = 100)
y1 <- dt(x1, 7)
polygon(x = c(-6,-6,t,6,6),
y = c(0.4,0,yt,0,0.4),
col = "#eae9c8",
border = "black")
polygon(x = c(x1[1], x1, x1[100]),
y = c(dt(-6, 7), y1, dt(6, 7)),
col = "#b14025",
border = "black")
polygon(x = c(x[1], x, x[100]),
y = c(dt(-6, 7), y, dt(6, 7)),
col = "#b14025",
border = "black")
Here is the attached output
Related
I have got a df with over 400 datapoints and want to colour those accourding to the RColorBrewer package with the palette = "Blues".
I plotted my data and even expanded the color input maximum of the palette to the length of my data points to avoid getting "Error messages" (see below), but the colors in the plot aren't changing (only a black line).
Error: Aesthetics must be either length 1 or the
same as the data (427): fill
I've created a dummy df to make my problem reproducible:
library(ggplot2)
library(RColorBrewer)
color = colorRampPalette(rev(brewer.pal(n = 9, name = "Blues")))(300)
df = (curve(3*x^2 + x, from=1, to=10, n=300, xlab="xvalue", ylab="yvalue",
col="blue", lwd=2, main="Plot of (3x^2 + x)"))
dfx = matrix(data = df$x, ncol = 1)
dfy = matrix(data = df$y, ncol = 1)
dfa = cbind(dfx,dfy)
DF = ggplot(dfa, aes(x = dfx, y = dfy)) +
geom_point(fill = color)
I expect the curve to change into a light blue at the start (1,4) with an increase in darkness till the end (dark blue at the end (10,310)).
Thanks in advance!
color_seq = colorRampPalette(brewer.pal(n = 9, name = "Blues"))(300)
df = (curve(3*x^2 + x, from=1, to=10, n=300, xlab="xvalue", ylab="yvalue",
col="blue", lwd=2, main="Plot of (3x^2 + x)"))
dfx = matrix(data = df$x, ncol = 1)
dfy = matrix(data = df$y, ncol = 1)
dfa = as.data.frame(cbind(dfx , dfy, color_seq), stringsAsFactors = FALSE)
dfa$V1 <- as.numeric(dfa$V1) ## convert both to numeric so the scale is continous
dfa$V2 <- as.numeric(dfa$V2)
ggplot(dfa, aes(x = V1, y = V2, color = color_seq)) +
geom_point() +
scale_color_identity()
exDF <- data.frame(dataX = seq(1, 10, .1),
dataY = sapply(seq(1, 10, .1), function(x) 3*x^2 + x))
exDFcolors <- colorRampPalette(brewer.pal(9, "Blues"))(nrow(exDF))
ggplot(exDF, aes(dataX, dataY)) +
geom_line(size = 2, color = exDFcolors)
I just encountered such graph attached where two colors of geom_point are used (I believe it is made by ggplot2). Similarly, I would like to have dots of one color to range from size 1 to 5, and have another color for a series of dots for the range 10 to 50. I have however no clue on how to add two different ranges of point in one graph.
At the basic step I have:
a <- c(1,2,3,4,5)
b <- c(10,20,30,40,50)
Species <- factor(c("Species1","Species2","Species3","Species4","Species5"))
bubba <- data.frame(Sample1=a,Sample2=b,Species=Species)
bubba$Species=factor(bubba$Species, levels=bubba$Species)
xm=melt(bubba,id.vars = "Species", variable.name="Samples", value.name = "Size")
str(xm)
ggplot(xm,aes(x= Samples,y= fct_rev(Species)))+geom_point(aes(size=Size))+scale_size(range = range(xm$Size))+theme_bw()
Any would have clues where I should look into ? Thanks!
I've got an approach that gets 90% of the way there, but I'm not sure how to finish the deed. To get a single legend for size, I used a transformation to convert input size to display size. That makes the legend appearance conform to the display. What I don't have figured out yet is how to apply a similar transformation to the fill so that both can be integrated into the same legend.
Here's the transformation, which in this case shrinks everything 10 or more:
library(scales)
shrink_10s_trans = trans_new("shrink_10s",
transform = function(y){
yt = if_else(y >= 10, y*0.1, y)
return(yt)
},
inverse = function(yt){
return(yt) # Not 1-to-1 function, picking one possibility
}
)
Then we can use this transformation on the size to selectively shink only the dots that are 10 or larger. This works out nicely for the legend, aside from integrating the fill encoding with the size encoding.
ggplot(xm,aes(x= Samples,y= fct_rev(Species), fill = Size < 10))+
geom_point(aes(size=Size), shape = 21)+
scale_size_area(trans = shrink_10s_trans, max_size = 10,
breaks = c(1,2,3,10,20,30,40),
labels = c(1,2,3,10,20,30,40)) +
scale_fill_manual(values = c(rgb(136,93,100, maxColorValue = 255),
rgb(236,160,172, maxColorValue = 255))) +
theme_bw()
a <- c(1, 2, 3, 4, 5)
b <- c(10, 20, 30, 40, 50)
Species <- factor(c("Species1", "Species2", "Species3", "Species4", "Species5"))
bubba <- data.frame(Sample1 = a, Sample2 = b, Species = Species)
bubba$Species <- factor(bubba$Species, levels = bubba$Species)
xm <- reshape2::melt(bubba, id.vars = "Species", variable.name = "Samples", value.name = "Size")
ggplot(xm, aes(x = Samples, y = fct_rev(Species))) +
geom_point(aes(size = Size, color = Size)) +
scale_color_continuous(breaks = c(1,2,3,10,20,30), guide = guide_legend()) +
scale_size(range = range(xm$Size), breaks = c(1,2,3,10,20,30)) +
theme_bw()
Here's a cludge. I haven't got time to figure out the legend at the moment. Note that 1 and 10 are the same size, but a different colour, as are 3 and 40.
# Create data frame
a <- c(1, 2, 3, 4, 5)
b <- c(10, 20, 30, 40, 50)
Species <- factor(c("Species1", "Species2", "Species3", "Species4", "Species5"))
bubba <- data.frame(Sample1 = a, Sample2 = b, Species = Species)
# Restructure data
xm <- reshape2::melt(bubba, id.vars = "Species", variable.name = "Samples", value.name = "Size")
# Calculate bubble size
bubble_size <- function(val){
ifelse(val > 3, (1/15) * val + (1/3), val)
}
# Calculate bubble colour
bubble_colour <- function(val){
ifelse(val > 3, "A", "B")
}
# Calculate bubble size and colour
xm %<>%
mutate(bub_size = bubble_size(Size),
bub_col = bubble_colour(Size))
# Plot data
ggplot(xm, aes(x = Samples, y = fct_rev(Species))) +
geom_point(aes(size = bub_size, fill = bub_col), shape = 21, colour = "black") +
theme(panel.grid.major = element_line(colour = alpha("gray", 0.5), linetype = "dashed"),
text = element_text(family = "serif"),
legend.position = "none") +
scale_size(range = c(1, 20)) +
scale_fill_manual(values = c("brown", "pink")) +
ylab("Species")
I think you are looking for bubble plots in R
https://www.r-graph-gallery.com/bubble-chart/
That said, you probably want to build the right and left the side of the graphic separately and then combine.
I would like to create a simple plot but with nonstandard breaks.
That's the code for my data:
> dput(dt1)
c(15.9540654816514, 37.5416557213931, 143.317585514018, 317.329051086954,
736.342269565211, 611.759999999995, 1145.49376842104, 3287.57274999997
)
> dput(dt2)
c(7.74957214839424, 17.5499521829522, 47.8167516932271, 72.1468924428822,
131.457629238329, 119.135097468354, 193.812365333332, 339.109355072461
)
> dput(dt3)
c(3.43850794565666, 11.4081262121212, 24.6747108504399, 54.7253625128734,
85.7360432084306, 89.7801271317832, 117.764457806452, 152.859368367347
)
and I would like to achieve something like that:
Just ignore red point on that graph.
That's the code which I have written so far. However, approach of changing the y breaks doesn't work.
plot(dt1,col="blue",cex = 1.8,xlim=c(0,10), ylim = c(1,5000), yaxt = "n", bty="n",xlab="",ylab="")
axis(side = 2, at = C(10,100,1000,5000)
points(dt2,col="green",cex = 1.8)
points(dt3,col="red",cex = 1.8)
Is it possible ? I would like to create identical xlabel like on the attached picture. I can change it as well in other software so do not focus mostly on that.
This is the closest I can think of using ggplot2.
library(data.table)
library(dplyr)
library(ggplot2)
theme_set(theme_bw())
dat <- rbindlist(list(
data.table(dt = "dt1",
y = c(15.9540654816514, 37.5416557213931, 143.317585514018, 317.329051086954,
736.342269565211, 611.759999999995, 1145.49376842104, 3287.57274999997)),
data.table(dt = "dt2",
y = c(7.74957214839424, 17.5499521829522, 47.8167516932271, 72.1468924428822,
131.457629238329, 119.135097468354, 193.812365333332, 339.109355072461)),
data.table(dt = "dt3",
y = c(3.43850794565666, 11.4081262121212, 24.6747108504399, 54.7253625128734,
85.7360432084306, 89.7801271317832, 117.764457806452, 152.859368367347))))
## generate lables
labs <- paste(rep(1:4, c(2,3,2,1)), rep(c(1,2,3,4,3,4), c(1,2,1,1,1,2)), sep = '\n-\n')
## create x variable
dat[, x := rep(1:8, 3) %>% factor(labels = labs)]
## plot
ggplot(dat, aes(x = x, y = y, colour = dt)) +
geom_point() +
scale_y_log10(limits = c(1, 10000),
breaks = 10^(0:4)) +
xlab("") + ylab("")
ggsave('temp.png', width = 4, height = 3)
The output looks like this:
I'm trying to make a scatter plot in R with ggplot2, where the middle of the y-axis is collapsed or removed, because there is no data there. I did it in photoshop below, but is there a way to create a similar plot with ggplot?
This is the data with a continuous scale:
But I'm trying to make something like this:
Here is the code:
ggplot(data=distance_data) +
geom_point(
aes(
x = mdistance,
y = maxZ,
shape = factor(subj),
color = factor(side),
size = (cSA)
)
) +
scale_size_continuous(range = c(4, 10)) +
theme(
axis.text.x = element_text(colour = "black", size = 15),
axis.text.y = element_text(colour = "black", size = 15),
axis.title.x = element_text(colour = "black", size= 20, vjust = 0),
axis.title.y = element_text(colour = "black", size= 20),
legend.position = "none"
) +
ylab("Z-score") +
xlab("Distance")
You could do this by defining a coordinate transformation. A standard example are logarithmic coordinates, which can be achieved in ggplot by using scale_y_log10().
But you can also define custom transformation functions by supplying the trans argument to scale_y_continuous() (and similarly for scale_x_continuous()). To this end, you use the function trans_new() from the scales package. It takes as arguments the transformation function and its inverse.
I discuss first a special solution for the OP's example and then also show how this can be generalised.
OP's example
The OP wants to shrink the interval between -2 and 2. The following defines a function (and its inverse) that shrinks this interval by a factor 4:
library(scales)
trans <- function(x) {
ifelse(x > 2, x - 1.5, ifelse(x < -2, x + 1.5, x/4))
}
inv <- function(x) {
ifelse(x > 0.5, x + 1.5, ifelse(x < -0.5, x - 1.5, x*4))
}
my_trans <- trans_new("my_trans", trans, inv)
This defines the transformation. To see it in action, I define some sample data:
x_val <- 0:250
y_val <- c(-6:-2, 2:6)
set.seed(1234)
data <- data.frame(x = sample(x_val, 30, replace = TRUE),
y = sample(y_val, 30, replace = TRUE))
I first plot it without transformation:
p <- ggplot(data, aes(x, y)) + geom_point()
p + scale_y_continuous(breaks = seq(-6, 6, by = 2))
Now I use scale_y_continuous() with the transformation:
p + scale_y_continuous(trans = my_trans,
breaks = seq(-6, 6, by = 2))
If you want another transformation, you have to change the definition of trans() and inv() and run trans_new() again. You have to make sure that inv() is indeed the inverse of inv(). I checked this as follows:
x <- runif(100, -100, 100)
identical(x, trans(inv(x)))
## [1] TRUE
General solution
The function below defines a transformation where you can choose the lower and upper end of the region to be squished, as well as the factor to be used. It directly returns the trans object that can be used inside scale_y_continuous:
library(scales)
squish_trans <- function(from, to, factor) {
trans <- function(x) {
if (any(is.na(x))) return(x)
# get indices for the relevant regions
isq <- x > from & x < to
ito <- x >= to
# apply transformation
x[isq] <- from + (x[isq] - from)/factor
x[ito] <- from + (to - from)/factor + (x[ito] - to)
return(x)
}
inv <- function(x) {
if (any(is.na(x))) return(x)
# get indices for the relevant regions
isq <- x > from & x < from + (to - from)/factor
ito <- x >= from + (to - from)/factor
# apply transformation
x[isq] <- from + (x[isq] - from) * factor
x[ito] <- to + (x[ito] - (from + (to - from)/factor))
return(x)
}
# return the transformation
return(trans_new("squished", trans, inv))
}
The first line in trans() and inv() handles the case when the transformation is called with x = c(NA, NA). (It seems that this did not happen with the version of ggplot2 when I originally wrote this question. Unfortunately, I don't know with which version this startet.)
This function can now be used to conveniently redo the plot from the first section:
p + scale_y_continuous(trans = squish_trans(-2, 2, 4),
breaks = seq(-6, 6, by = 2))
The following example shows that you can squish the scale at an arbitrary position and that this also works for other geoms than points:
df <- data.frame(class = LETTERS[1:4],
val = c(1, 2, 101, 102))
ggplot(df, aes(x = class, y = val)) + geom_bar(stat = "identity") +
scale_y_continuous(trans = squish_trans(3, 100, 50),
breaks = c(0, 1, 2, 3, 50, 100, 101, 102))
Let me close by stressing what other already mentioned in comments: this kind of plot could be misleading and should be used with care!
I am trying hard to figure out to add color gridient label to my plot ( link to previous question). Sorry for keep asking but this is maximum I could push me forward.
#data 1:
lab1 <- 1:10
group <- rep(1:3, each = length (lab1))
label <- rep(lab1, 3)
avar <- rep(c(0, 1, 4, 5, 6, 8, 10, 11, 12, 13), 3)
myd <- data.frame (group, label, avar)
# data 2
fillcol <- rep(rnorm(length(lab1)-1, 0.5, 0.2), 3)
group1 <- rep(1:3, each = length(fillcol)/3)
# this variable will be used to fill color in bars
filld <- data.frame(group1, fillcol)
colbarplot <- function(group) {
myd1 <- myd[myd$group == group,]
filld1 <- filld[filld$group1 == group,]
blues <- colorRampPalette(c("yellow", "blue"))
barplot(as.matrix(diff(myd1$avar)), horiz=T,
col=blues(10)[10* filld1$fillcol],
axes=F, xlab="Mark")
axis(1, labels=myd$label, at=myd$avar)
axis(3, labels=myd$avar, at=myd$avar)
}
par(mfrow = c(4, 1))
par(mar = c(2.5, 1, 2.5, 1))
sapply(unique(myd$group),function(x) colbarplot(x))
Now I am struggling to add legend, sorry for this new user.
blues <- colorRampPalette(c("yellow", "blue"))
colors <- blues(10)
count <- length(colors)
m <- matrix(1:count, count, 1)
m1 <- m
image(m, col=colors, ylab="", axes=FALSE)
I produced color scale that is not what I am expecting, I am trying plot a smaller legend, less in width and height, along with original scale use in color coding.
Here are some unsuccessful trials for labeling:
colab <- c(round (min(filld$fillcol), 2), round(max(filld$fillcol), 2))
colpos <- c(0.33 * max(mapdat$position),0.66 * max(mapdat$position))
axis(1, labels=colab, at=colpos)
Getting a decent legend is much easier with ggplot2
library(plyr)
myd$group <- factor(myd$group)
gData <- ddply(myd, .(group), function(x){
data.frame(delta = diff(x$avar), label = paste(head(x$label, -1), tail(x$label, -1), sep = "-"))
})
gData$FillCol <- rnorm(nrow(gData))
ggplot(gData, aes(x = group, y = delta, fill = FillCol, label = label)) + geom_bar(stat = "identity") + coord_flip() + scale_fill_gradient(low = "blue", high = "yellow") + geom_text(position = "stack")