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)
Related
I am trying to combine fraction with value calculated elsewhere. I tried to combine it with expression and paste but didn't work. any suggestions please?
library(ggplot2)
Changing_Value <- 150
ggplot(data=data.frame(x=0,y=0))+
annotate('text', x = 0, y = 0,
label = "P^{frac(-1,K)}== Changing_Value ",parse = TRUE,size=7)
You can use sprintf. See the help file to see what other options are besides %d.
ggplot(data = data.frame(x = 0, y = 0)) +
annotate("text", x = 0, y = 0,
label = sprintf("P^{frac(-1,K)}== %d", Changing_Value),
parse = TRUE, size = 7)
Use paste to generate the string:
library(ggplot2)
Changing_Value <- 150
ggplot(data=data.frame(x=0,y=0))+
annotate('text', x = 0, y = 0,
label = paste("P^{frac(-1,K)}==",Changing_Value),parse = TRUE,size=7)
Or you can use glue
ggplot(data = data.frame(x = 0, y = 0)) +
annotate("text", x = 0, y = 0,
label = glue::glue("P^frac(-1,K)=={Changing_Value}"),
parse = TRUE, size = 7)
Depending on the input of my code - a varying number of columns are populated. I am attempting to create a loop which will only populate the columns which are populated. However, i am struggling as the loop keep overwriting and only retains the last line plotted on the graph. I though printing the ggplot would help - but sadly not!
plot <- ggplot(plottable, aes(x = Date))
####for (i in 2:ncol(plottable)) {
for (i in 2:ncol(plottable)) {
Exposure <- assign(colnames(plottable)[i],plottable[,i])
plot <- plot +
geom_line(aes(y=Exposure, color = colnames(plottable)[i]))
print(plot)
}
plot
Data
structure(list(Date = structure(c(18078, 18079, 18080, 18081, 18082), class = "Date"), Zone9 = c(0, 0, 0, 0, 0), Zone6 = c(0, 0, 0, 0, 0), Zone4 = c(0, 0, 0, 0, 0), Zone3 = c(0, 969698.444, 969698.444, 969698.444, 969698.444), Zone2 = c(0, 0, 0, 0, 0), Zone11 = c(0, 15560719.2483794, 15560719.2483794, 15560719.2483794, 15560719.2483794), Zone10 = c(0, 2208064.625714, 2208064.625714, 2208064.625714, 2208064.625714), Zone1 = c(0, 0, 0, 0, 0)), row.names = c(NA, 5L), class = "data.frame")
Personally I would follow the approach using tidyr::pivot_longer as outlined by #AndyEggers. Nonetheless if you don't want to reshape your dataset you could add multiple geom layers to a plot using e.g. lapply or purrr::map like so:
ggplot(plottable, aes(x = Date)) +
lapply(names(plottable)[!names(plottable) %in% "Date"], function(x) {
geom_line(aes(y=.data[[x]], color = x))
})
Making use of ggplot2::economics as example data:
library(ggplot2)
ggplot(economics, aes(x = date)) +
lapply(names(economics)[!names(economics) %in% "date"], function(x) {
geom_line(aes(y=.data[[x]], color = x))
})
Your approach looks like something I would have tried before I got comfortable with tidyr and ggplot. I suggest a different approach that makes better use of these tools:
plottable %>%
pivot_longer(cols = -Date) %>%
ggplot(aes(x = Date, y = value, col = name)) +
geom_line()
I try to reproduce a ggtern code from this post: Ternary plot - scaling opacity across groups
library(ggtern)
set.seed(1234)
df <- data.frame(X = c(runif(150, 0.7, 1),runif(50, 0, 0.3)),
Y = c(runif(150, 0, 0.3),runif(50, 0, 0.3)),
Z = c(runif(150, 0, 0.5),runif(50, 0.5, 1)),
D = c(rep("A", 150), rep("B", 50)))
# ternary plot
ggtern(df, aes(x = X,y = Y, z = Z, color = D)) +
stat_density_tern(aes(alpha = ..level.., fill = D),
geom = 'polygon',
bins = 10,
color = "grey",bdl=0.005) +
geom_point(alpha = 0.5) +
scale_colour_manual(values = c("tomato3", "turquoise4"))``
And I get the following error:
Warning messages:
1: Removed 3 rows containing non-finite values (StatDensityTern).
2: Computation failed in stat_density_tern():
unused argument (z.range = z.range)
I don't understand what caused the computational problem with the unused argument, which seems to fail to draw the density contour around points.
Can someone figure out what the problem is? Thanks.
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.