I would like to use this plot:
dtf1 <- data.frame(ID = c(1:10),text = c("my", "and","keep","any","somenone",
"exist","tr",
"ggplot2","euf","edff"),
Diff = c(-5:4), stringsAsFactors = FALSE)
I tried this:
Error in f(..., self = self) : Breaks and labels are different lengths
Which will include the text of text column as labels in every respective bar.
dtf1$colour <- ifelse(dtf1$Diff < 0, "firebrick1","steelblue")
dtf1$hjust <- ifelse(dtf1$Diff > 0, 1.3, -0.3)
dtf1$colour <- ifelse(dtf1$Diff < 0, "negative","positive")
ggplot(dtf1,aes(ID,Diff,label="",hjust=hjust))+
geom_bar(stat="identity",position="identity",aes(fill = colour))+
scale_fill_manual(values=c(positive="firebrick1",
negative="steelblue")) +
scale_y_continuous(labels = dtf1$text) +
coord_flip()
And the error is
:
Error in f(..., self = self) : Breaks and labels are different lengths
Just like one of the comments suggested:
library(ggplot2)
dtf1 <- data.frame(ID = c(1:10),text = c("my", "and","keep","any","somenone",
"exist","tr",
"ggplot2","euf","edff"),
Diff = c(-5:4), stringsAsFactors = FALSE)
dtf1$colour <- ifelse(dtf1$Diff < 0, "firebrick1","steelblue")
dtf1$hjust <- ifelse(dtf1$Diff > 0, 1.3, -0.3)
dtf1$colour <- ifelse(dtf1$Diff < 0, "negative","positive")
ggplot(dtf1,aes(ID,Diff,label="",hjust=hjust))+
geom_bar(stat="identity",position="identity",aes(fill = colour))+
scale_fill_manual(values=c(positive="firebrick1",
negative="steelblue")) +
scale_y_continuous() +
geom_text(aes(label=text)) +
coord_flip()
Created on 2019-02-18 by the reprex package (v0.2.1)
It's essentially the same thing as above except we use geom_label instead if you'd prefer.
ggplot(dtf1,aes(ID,Diff,label="",hjust=hjust))+
geom_bar(stat="identity",position="identity",aes(fill = colour))+
scale_fill_manual(values=c(positive="firebrick1",
negative="steelblue"))+
geom_label(aes(label=text))+
coord_flip()
Related
I am trying to write the base R code, using tidyverse style.
I know this question, it just did not work for me for some reasons.
> dput(my_df)
c(0.492476485097794, 0, -0.0571584138399486, -0.348306694268216,
0.510825623765991, -0.0512932943875506, -0.0540672212702757,
-0.325422400434628, 0.526093095896779, 0, -0.0465200156348928,
-0.336472236621213, 0.550046336919272, 0, -0.0800427076735366,
-0.287682072451781, 0.51082562376599, 0, -0.0689928714869512,
-0.287682072451781, 0.481838086892739, 0, -0.060624621816435,
-0.287682072451781, 0.432864082296279, 0, -0.0555698511548109,
-0.336472236621213, 0.470003629245736, 0.0246926125903714,
-0.075985906977922,
-0.305381649551182, 0.517943091534855, 0, -0.0434851119397388,
-0.31015492830384, 0.473784352085642, -0.0190481949706944,
-0.0392207131532814,
-0.2484613592985, 0.413975797776073, 0.0168071183163813, 0,
-0.22314355131421,
0.362905493689368, 0.0143887374520996, -0.0143887374520996,
-0.191055236762709,
0.375789339962048, -0.0121213605323448, -0.0500104205746613,
-0.152016207298626, 0.370018359112417, -0.0421114853501268,
-0.0666913744986723,
-0.175448677506193, 0.304660408986199, -0.010152371464018, 0,
-0.190518323998133, 0.359141036433926, -0.0996298409488412,
0.00947874395454378,
-0.186102279633861, 0.358945092473272, -0.0655972824858133,
-0.00851068966790863,
-0.218879152527752, 0.292987124681474, -0.091349778588228, 0.042559614418796,
-0.162518929497775, 0.234839591077401, -0.064021858764931,
0.0163938097756764,
-0.177455367142782, 0.270545790208794)
I did some work in base R, finding characteristic polynomial roots and drawing the circle.
But I really want to do it, using ggplot2, just do not know how.
My base R code is:
library(plotrix)
gdpDiff <- diff(my_df)
m1 = ar(gdpDiff, method = 'mle')
m1$order
m1$x.mean
m1$ar
p1 = c(1, -m1$ar)
r1 = polyroot(p1)
r1
r1Re <- Re(r1)
r1Im <- Im(r1)
Mod(r1)
plot(r1Re, r1Im, asp = 1, xlim = c(min(r1Re), max(r1Re)), ylim = c(min(r1Im), max(r1Im)))
draw.circle(0, 0, radius = 1)
abline(v = 0)
abline(h = 0)
My current result is (with 4 dots):
Any chance to do the same, using ggplot? I would greatly appreciate your help.
While this is not entirely with ggplot2, the package ggforce has a function (geom_circle) for making circles. You can use that. I have written a function to convert the real and imaginary parts into a tibble and you can then use it to plot further:
library(ggplot2)
library(ggforce)
library(plotrix)
poly_fun <- function(my_vector) {
gdpDiff <- diff(my_vector)
m1 <- ar(gdpDiff, method = 'mle')
p1 <- c(1, -m1$ar)
r1 <- polyroot(p1)
tibble(
real = Re(r1),
imaginary = Im(r1)
)
}
df <- poly_fun(my_df)
ggplot() +
geom_circle(data = tibble(x = 0, y = 0), aes(x0 = x, y0 = y, r = 1)) +
geom_point(data = df, aes(x = real, y = imaginary)) +
xlim(min(df$real), max(df$real)) +
ylim(min(df$imaginary), max(df$imaginary)) +
coord_fixed(ratio = 1) +
geom_hline(yintercept = 0) +
geom_vline(xintercept = 0)
I try run the following function in R:
GainChart <- function(score, good.label, n.breaks = 50, ...){
df <- data.frame(percentiles = seq(0, 1, length = n.breaks),
gain = Gain(score, good.label, seq(0, 1, length = n.breaks)))
p <- ggplot(df, aes(percentiles, gain)) + geom_line(size = 1.2, colour = "darkred")
p <- p + geom_line(aes(x = c(0,1), y = c(0,1)), colour = "gray", size = 0.7)
p <- p + scale_x_continuous("Sample Percentiles", labels = percent_format(), limits = c(0, 1))
p <- p + scale_y_continuous("Cumulative Percents of Bads", labels = percent_format(), limits = c(0, 1))
p
}
And I received the following error message: "Error: Aesthetics must be either length 1 or the same as the data (50): x, y"
The command for call the function is:
GainChart(data_sampni$score,data_sampni$TOPUP_60d)
Your second geom_line() doesn't make sense. It seems that you are trying to draw a line between [0,0] and [1,1]. In that case, use geom_abline():
+ geom_abline(aes(intercept = 0, slope = 1))
The help for geom_line says that if data=NULL (the default) then the data is inherited from the parent graph. That is where your mismatch is coming from.
Iy you change the second line to something like:
p <- p + geom_line(aes(x,y), data=data.frame(x=c(0,1), y=c(0,1)))
Then it should work.
I have a ggplot map, for example:
library(ggmap)
ggmap(get_map())
I'd like the axis labels to be automatically labeled as N-S / W-E: in the above case, for example, instead of lon -95.4 it should show 95.4°E.
I have tried to mess with the scales package and using scale_x_continuous and scale_y_continuous labels and breaks options, but I have not managed to make it work.
It would be awesome to have a scale_y_latitude and scale_x_longitude.
EDIT:
Thanks to #Jaap 's answer I got to the following:
scale_x_longitude <- function(xmin=-180, xmax=180, step=1, ...) {
ewbrks <- seq(xmin,xmax,step)
ewlbls <- unlist(lapply(ewbrks, function(x) ifelse(x < 0, paste(x, "W"), ifelse(x > 0, paste(x, "E"),x))))
return(scale_x_continuous("Longitude", breaks = ewbrks, labels = ewlbls, expand = c(0, 0), ...))
}
scale_y_latitude <- function(ymin=-90, ymax=90, step=0.5, ...) {
nsbrks <- seq(ymin,ymax,step)
nslbls <- unlist(lapply(nsbrks, function(x) ifelse(x < 0, paste(x, "S"), ifelse(x > 0, paste(x, "N"),x))))
return(scale_y_continuous("Latitude", breaks = nsbrks, labels = nslbls, expand = c(0, 0), ...))
}
Which works pretty well. But for some reason my R doesn't seem to like the degree symbol in front of the cardinal point... It is displayed as a simple dot, e.g. longitude -24 becomes 24..W
Unfortunately, there is no such thing as scale_x_longitude or scale_y_latitude yet. In the meantime here is a workaround in which you specify the labels beforehand:
# load the needed libraries
library(ggplot2)
library(ggmap)
# get the map
m <- get_map(location=c(lon=0,lat=0),zoom=5)
# create the breaks- and label vectors
ewbrks <- seq(-10,10,5)
nsbrks <- seq(-10,10,5)
ewlbls <- unlist(lapply(ewbrks, function(x) ifelse(x < 0, paste(x, "°E"), ifelse(x > 0, paste(x, "°W"),x))))
nslbls <- unlist(lapply(nsbrks, function(x) ifelse(x < 0, paste(x, "°S"), ifelse(x > 0, paste(x, "°N"),x))))
# create the map
ggmap(m) +
geom_blank() +
scale_x_continuous(breaks = ewbrks, labels = ewlbls, expand = c(0, 0)) +
scale_y_continuous(breaks = nsbrks, labels = nslbls, expand = c(0, 0)) +
theme(axis.text = element_text(size=12))
which gives:
To get the degrees in the functions, you can raise the o as superscript (which will circumvent the need for a special symbol):
scale_x_longitude <- function(xmin=-180, xmax=180, step=1, ...) {
xbreaks <- seq(xmin,xmax,step)
xlabels <- unlist(lapply(xbreaks, function(x) ifelse(x < 0, parse(text=paste0(x,"^o", "*W")), ifelse(x > 0, parse(text=paste0(x,"^o", "*E")),x))))
return(scale_x_continuous("Longitude", breaks = xbreaks, labels = xlabels, expand = c(0, 0), ...))
}
scale_y_latitude <- function(ymin=-90, ymax=90, step=0.5, ...) {
ybreaks <- seq(ymin,ymax,step)
ylabels <- unlist(lapply(ybreaks, function(x) ifelse(x < 0, parse(text=paste0(x,"^o", "*S")), ifelse(x > 0, parse(text=paste0(x,"^o", "*N")),x))))
return(scale_y_continuous("Latitude", breaks = ybreaks, labels = ylabels, expand = c(0, 0), ...))
}
ggmap(m) +
geom_blank() +
scale_x_longitude(xmin=-10, xmax=10, step=5) +
scale_y_latitude(ymin=-10, ymax=10, step=5) +
theme(axis.text = element_text(size=12))
which gives the following map:
I used geom_blank just to illustrate the desired effect. You can off course use other geom's (e.g. geom_point) to plot your data on the map.
You can now use metR package. It has scale_*_latitude() and scale_*_longitude() functions.
# load the needed libraries
library(ggplot2)
library(ggmap)
library(metR) #new package
# get the map
m <- get_map(location=c(lon=0,lat=0),zoom=5)
# create the map
ggmap(m) +
scale_x_longitude(breaks = seq(-10,10,5)) +
scale_y_latitude(breaks = seq(-10,10,5))
#> Scale for x is already present.
#> Adding another scale for x, which will replace the existing scale.
#> Scale for y is already present.
#> Adding another scale for y, which will replace the existing scale.
Created on 2022-11-28 with reprex v2.0.2
Thanks to the excellent answer in "Combine a ggplot2 object with a lattice object in one plot" and some further thoughts I could plot a lattice plot next to a ggplot:
library(ggplot2)
library(lattice)
library(gtools)
library(plyr)
library(grid)
library(gridExtra)
set.seed(1)
mdat <- data.frame(x = rnorm(100), y = rnorm(100), veryLongName = rnorm(100),
cluster = factor(sample(5, 100, TRUE)))
cols <- c("x", "y", "veryLongName")
allS <- adply(combinations(3, 2, cols), 1, function(r)
data.frame(cluster = mdat$cluster,
var.x = r[1],
x = mdat[[r[1]]],
var.y = r[2],
y = mdat[[r[2]]]))
sc <- ggplot(allS, aes(x = x, y = y, color = cluster)) + geom_point() +
facet_grid(var.x ~ var.y) + theme(legend.position = "top")
sc3d <- cloud(veryLongName ~ x + y, data = mdat, groups = cluster)
scG <- ggplotGrob(sc)
sc3dG <- gridExtra:::latticeGrob(sc3d)
ids <- grep("axis-(l|b)-(1|2)|panel", scG$layout$name)
scG$grobs[ids[c(2, 5, 8)]] <- list(nullGrob(), nullGrob(), nullGrob())
grid.newpage()
grid.draw(scG)
pushViewport(viewport(0, 0, width = .515, height = .46,
just = c("left", "bottom")))
grid.rect()
grid.draw(sc3dG)
As you can see in the picture there is quite some margin around the lattice plot and on top of it the axis label for the z-axis is cut (which is not the case is I plot the lattice plot alone).
So how can I get rid of this behaviour, thus how to solve the follwing two problems:
Get rid of the inner margin between the viewport and the lattice plot
Avoid that the label in the lattice plot is cut.
I tried to play with the clip option of the viewport but without success. So, what to do?
Update 2020
Edited code and answer to reflect new naming convention in the grob.
those settings are probably somewhere in ?xyplot, but I find it's faster to read the internet,
theme.novpadding <-
list(layout.heights =
list(top.padding = 0,
main.key.padding = 0,
key.axis.padding = 0,
axis.xlab.padding = 0,
xlab.key.padding = 0,
key.sub.padding = 0,
bottom.padding = 0),
axis.line = list(col = 0),
clip =list(panel="off"),
layout.widths =
list(left.padding = 0,
key.ylab.padding = 0,
ylab.axis.padding = 0,
axis.key.padding = 0,
right.padding = 0))
sc3d <- cloud(veryLongName ~ x + y, data = mdat, groups = cluster,
par.settings = theme.novpadding )
scG <- ggplotGrob(sc)
sc3dG <- grobTree(gridExtra:::latticeGrob(sc3d),
rectGrob(gp=gpar(fill=NA,lwd=1.2)))
ids <- grep("axis-(l|b)-(1|2)|panel", scG$layout$name)
scG$grobs[ids[c(5, 2, 8)]] <- list(nullGrob(), sc3dG, nullGrob())
grid.newpage()
grid.draw(scG)
Is there any chance to write text which is "wrapped" around the circle? I mean something like this:
Yes, and here is the code, free of charge :-) . I wrote this a while back but I don't think ever published it in any CRAN package.
# Plot symbols oriented to local slope.
# Interesting problem: if underlying plot has some arbitrary aspect ratio,
# retrieve by doing: Josh O'B via SO:
# myasp <- with(par(),(pin[2]/pin[1])/(diff(usr[3:4])/diff(usr[1:2])))
# so make that the default value of argument 'asp'
# Default is 'plotx' is vector of indices at which to
# plot symbols. If is_indices=FALSE, only then turn to splinefun to
# calculate y-values and slopes; and user beware.
#
# 6 Feb 2014: added default col arg so can stick in a color vector if desired
# TODO
#
slopetext<-function(x,y,plotx, mytext, is_indices=TRUE, asp=with(par(), (pin[1]/pin[2])*(diff(usr[3:4])/diff(usr[1:2]))),offsetit= 0, col='black', ...) {
if (length(x) != length(y)) stop('data length mismatch')
if (!is.numeric(c(x,y,plotx) ) ) stop('data not numeric')
if(is_indices) {
# plotting at existing points.
if(any(plotx<=1) | any(plotx>= length(x))) {
warning("can't plot endpoint; will remove")
plotx<-plotx[(plotx>1 & plotx<length(x))]
}
lows<-plotx-1
highs<-plotx+1
# then interpolate low[j],high[j] to get slope at x2[j]
slopes <- (y[highs]-y[lows])/(x[highs]-x[lows]) #local slopes
# sign(highlow) fix the rotation problem
angles <- 180/pi*atan(slopes/asp) + 180*(x[lows] > x[highs] )
intcpts <- y[highs]-slopes*x[highs]
ploty <- intcpts + x[plotx]*slopes
# change name, so to speak, to simplify common plotting code
plotx<-x[plotx]
}else{
#interpolating at plotx values
if (any(plotx<min(x)) | any(plotx>max(x)) ) {
warning("can't plot extrapolated point; will remove")
plotx<-plotx[(plotx>min(x) & plotx<max(x))]
}
spf<-splinefun(x,y)
ploty<-spf(plotx)
angles <- 180/pi * atan(spf(plotx,1)/asp) #getting first deriv, i.e. slope
} #end of else
xlen<-length(plotx) # better match y and mytext
# The trouble is: srt rotates about some non-centered value in the text cell
# Dunno what to do about that.
dely <- offsetit*cos(angles)
delx <- offsetit*sin(angles)
# srt must be scalar
mytext<-rep(mytext,length=xlen)
col <- rep(col,length=xlen)
for (j in 1:xlen) text(plotx[j], ploty[j], labels=mytext[j], srt= angles[j], adj=c(delx,dely),col=col[j], ...)
}
Edit: per David's excellent suggestion, a sample case:
x <- 1:100
y <- x/20 + sin(x/10)
plot(x,y,t='l')
slopetext(x=x,y=y,plotx=seq(10,70,by=10),mytext=letters[1:8])
The third argument in this example selects every tenth value of (x,y) for placement of the text.
I should warn that I haven't idiot-proofed the is_indices=FALSE case and the spline fit may in extreme cases place your text in funny ways.
plotrix::arctext
library(plotrix)
# set up a plot with a circle
plot(x = 0, y = 0, xlim = c(-2, 2), ylim = c(-2, 2))
draw.circle(x = 0, y = 0, radius = 1)
# add text
arctext(x = "wrap some text", center = c(0, 0), radius = 1.1, middle = pi/2)
arctext(x = "counterclockwise", center = c(0, 0), radius = 1.1, middle = 5*pi/4,
clockwise = FALSE, cex = 1.5)
arctext(x = "smaller & stretched", center = c(0, 0), radius = 1.1, middle = 2*pi ,
cex = 0.8, stretch = 1.2)
circlize
For greater opportunities of customization, check the circlize package (see the circlize book). By setting facing = "bending" in circos.text, the text wraps around a circle.
library(circlize)
# create some angles, labels and their corresponding factors
# which determine the sectors
deg <- seq(from = 0, to = 300, by = 60)
lab <- paste("some text", deg, "-", deg + 60)
factors <- factor(lab, levels = lab)
# initialize plot
circos.par(gap.degree = 10)
circos.initialize(factors = factors, xlim = c(0, 1))
circos.trackPlotRegion(ylim = c(0, 1))
# add text to each sector
lapply(factors, function(deg){
circos.updatePlotRegion(sector.index = deg, bg.col = "red")
circos.text(x = 0.5, y = 0.5, labels = as.character(deg), facing = "bending")
})
circos.clear()
From circlize version 0.2.1, circos.text has two new options: bending.inside which is identical to original bending and bending.outside (see Figure 3.4 in the circlize book). Thus, it is easy to turn the text in the bottom half of the plot using bending.outside:
circos.par(gap.degree = 10)
circos.initialize(factors = factors, xlim = c(0, 1))
circos.trackPlotRegion(ylim = c(0, 1))
lapply(factors[1:3], function(deg){
circos.updatePlotRegion(sector.index = deg, bg.col = "red")
circos.text(x = 0.5, y = 0.5, labels = as.character(deg), facing = "bending.outside")
})
lapply(factors[4:6], function(deg){
circos.updatePlotRegion(sector.index = deg, bg.col = "red")
circos.text(x = 0.5, y = 0.5, labels = as.character(deg), facing = "bending.inside")
})
circos.clear()
The figure in the question can now be recreated quite easily in ggplot using the geomtextpath package:
library(geomtextpath)
df <- data.frame(x = c(0, 5.5, 6, 5.2, 0, 0.5, 0) + 8 * rep(0:5, each = 7),
y = rep(c(0, 0, 1, 2, 2, 1, 0), 6) + 8,
id = rep(1:6, each = 7))
df2 <- data.frame(x = c(3, 11, 19, 27, 35, 43), y = 9, id = 1:6,
z = paste("text", 0:5 * 60))
ggplot(df, aes(x, y, group = id)) +
geom_polygon(fill = "red", color = "black") +
geom_hline(yintercept = 9, color = "red", alpha = 0.3, size = 7) +
geom_textpath(data = df2, aes(label = z), size = 7, upright = FALSE) +
ylim(c(0, 10)) +
xlim(c(0, 48)) +
coord_polar(theta = "x", direction = -1, start = -pi/4) +
theme_void()
Disclaimer: I'm co-author of said package.