I am trying to plot percentages in a simple 2x2 contingency table with vcd::mosaic but I keep getting a Viewport error. Here is how to reproduce (I work on Ubunto 20.04 and R 3.6.3):
t0 <- as.table(rbind( c(221,47), c(17,9) ))
names(dimnames(t0)) = c("X", "C")
rownames(t0) = c("neg", "pos")
colnames(t0) = c("neg", "pos")
library(vcd)
labs <- round(prop.table(t0, 1), 2)
mosaic(t(t0), split = TRUE, shade = TRUE, pop = FALSE )
labeling_cells(text = labs, margin = 0)(t0)
and I get with the last command:
labeling_cells(text = labs, margin = 0)(t0)
Error in grid.Call.graphics(C_downviewport, name$name, strict) :
Viewport 'cell:X=neg,C=neg' was not found
Does anybody know why?
You visualized the transposed table t(t0) with mosaic() but then try to add labeling_cells() for the original table t0. As the two tables don't match, the labeling cannot find the viewports it expects. Simply use t(t0) for the labeling as well:
mosaic(t(t0), split = TRUE, shade = TRUE, pop = FALSE)
labeling_cells(text = labs, margin = 0)(t(t0))
Related
I am performing ESEM with psych.
esem.diagram returns a graph in which the items overlap.
I would like to ask for some help with fixing the overlap or removing the rectangles please :)
My Code:
esem1 <- esem(modelESEM, varsX=c(1:33),varsY=c(34:41) ,nfX = 4, nfY = 1, fm = "minres",
rotate = "promax", plot = TRUE, cor = "cor", use = "pairwise")
esem.diagram(esem=esem1, cut=0.4)
I want to skip a empty panel using lattice package in R.
set.seed(1)
df1 <- data.frame("treatment" = c(rep("A",16),rep("B",16),rep("C",16)),
"disease_type" = c(rep("1",8),rep("2",8)),
"days_after_application" = rep(c(rep("10-24",4),rep("24-48",4)),6),
"severity" = rnorm(48, mean = 80, sd = 5))
df1[(df1$disease_type == "2" & df1$days_after_application == "24-48"),"severity"] <- NA
library(lattice)
figure1 <- bwplot(treatment~severity|days_after_application+disease_type,
data = df1,layout = c(2,2),
strip = strip.custom(strip.names = TRUE))
jpeg("figure1.jpeg")
print(figure1)
dev.off()
Here is what I get
My question is how I can remove/skip empty panel in the top right WITHOUT changing layout?
I have tried following code. However, it doesn't work.
figure2 <- bwplot(treatment~severity|days_after_application+disease_type,
data = df1,layout = c(2,2),
strip = strip.custom(strip.names = TRUE),
skip = c(FALSE,FALSE,FALSE,TRUE))
jpeg("figure2.jpeg")
print(figure2)
dev.off()
Here is what I got
I also tried following codes. But it is not what I want since I do want 2 levels strips.
df1[(df1$disease_type == "2" & df1$days_after_application == "24-48"),] <- NA
bwplot(treatment~severity|interaction(days_after_application,disease_type),
data = df1,layout = c(2,2),
strip = strip.custom(strip.names = TRUE))
Thank you!
Get help from a Professor in Temple University.
Here is his solution:
figure4 <- bwplot(treatment~severity|days_after_application+disease_type,
data = df1,layout = c(2,2),
strip = strip.custom(strip.names = TRUE),
skip = c(FALSE,FALSE,FALSE,TRUE),
scales=list(alternating=FALSE), ## keep x-scale on bottom
between=list(x=1, y=1)) ## space between panels
pdf("figure4%03d.pdf",onefile = FALSE) ## force two pages in file.
print(figure4)
dev.off()
When using chartSeries, by default it also shows on the top left of the plot the last value. Is there any way to prevent it from doing it?
When adding a new TA with addTA, you can avoid the last value on the plot by setting the argument legend = "", but only if you're making a new plot for the TA. If the TA is on a previously plotted graphic, it'll show the last value regardless of what you put in the legend argument.
getSymbols ("AAPL", src = "google")
chartSeries(AAPL)
What can I use here to prevent it from printing the last value on the plot?
addTA(EMA(Cl(AAPL)), on = 1, legend = "")
This still prints the last value on the top left of the plot. The weird part is that it doesn't do it if you're plotting on a new plot like this:
addTA(EMA(Cl(AAPL)), legend = "")
Is it like this by default, or is there something I can do to get around it?
The last value is shown by default (yes, annoyingly). You'll likely have to modify the source code to remove the last number showing in addTA.
I don't use addTA, but rather add_TA and chart_Series, because I think they look much better (second generation charts for quantmod). Here is a solution that removes the last number from showing for the add_TA version. But you must be willing to modify the source code.
In add_TA, you'll need to modify approximately lines 56-60 of the source:
Replace the text.exp, which is this:
# this is inside add_TA:
if (is.na(on)) {
plot_object$add_frame(ylim = c(0, 1), asp = 0.15)
plot_object$next_frame()
text.exp <- expression(text(x = c(1, 1 + strwidth(name)),
y = 0.3, labels = c(name, round(last(xdata[xsubset]),
5)), col = c(1, col), adj = c(0, 0), cex = 0.9,
offset = 0, pos = 4))
plot_object$add(text.exp, env = c(lenv, plot_object$Env),
with these modifications:
if (is.na(on)) {
plot_object$add_frame(ylim = c(0, 1), asp = 0.15)
plot_object$next_frame()
text.exp <- expression(text(x = c(strwidth(name)), # <- affects label on the subchart
y = 0.3, labels = name, col = c(col), adj = c(0), cex = 0.9,
offset = 1, pos = 4))
plot_object$add(text.exp, env = c(lenv, plot_object$Env),
expr = TRUE)
...
and assign this modified code to a new variable, called say add_TA.mine:
add_TA.mine <- function (x, order = NULL, on = NA, legend = "auto", yaxis = list(NULL,
NULL), col = 1, taType = NULL, ...)
{
lenv <- new.env()
lenv$name <- deparse(substitute(x))
lenv$plot_ta <- function(x, ta, on, taType, col = col, ...) {
xdata <- x$Env$xdata
....
[all the code for the rest of the function with modifications]....
}
}
plot_object
}
Now, just run the code with the modified function
library(quantmod)
getSymbols("AAPL")
environment(add_TA.mine) <- environment(get("add_TA", envir = asNamespace("quantmod")))
assignInNamespace(x = "add_TA", value = add_TA.mine, ns = "quantmod")
chart_Series(AAPL, subset = "2017")
add_TA(RSI(Cl(AAPL)))
quantmod:::add_TA(RSI(Cl(AAPL)))
You can see the last value is no longer printed:
(You could make the same kinds of changes in the old addTA code (perhaps via chartSeries if you really want to stick to the old plots)
If you're happy with the changes, and want to make them permament in add_TA, you can recompile the quantmod source code yourself with your modifications (i.e. you need to download the quantmod source code and recompile the package) . If you make a mess of things you can always redownload the original quandmod source code again.
I am plotting a time series with the timePlot function of the open air package of R. The graph has grey grid lines in the background that I would like to turn off but I do not find a way to do it. I would expect something simple such as grid = FALSE, but that is not the case. It appears to be rather complex, requiring the use of extra arguments which are passed to xyplot of the library lattice. I believe the answer lies some where in the par.settings function but all attempts have failed. Does anyone have any suggestions to this issue?
Here is by script:
timeozone <- import(i, date="date", date.format = "%m/%d/%Y", header=TRUE, na.strings="")
ROMO = timePlot(timeozone, pollutant = c("C7", "C9", "C10"), group = TRUE, stack = FALSE,y.relation = "same", date.breaks = 9, lty = c(1,2,3), lwd = c(2, 3, 3), fontsize = 15, cols = c("black", "black"), ylab = "Ozone (ppbv)")
panel = function(x, y) {
panel.grid(h = 0, v = 0)
panel.xyplot(x,y)
}
I often create large plots in RStudio which I save to PDF but would also like to partly show in the PDF knitr report.
Is there a way to create the full object then cut a piece (ideally top left corner) and include that second picture in the PDF report?
as example, a pheatmap code that produces a plot with 56 cols and 100's of rows. I would like to show only the left-top-most 10col and 10 rows but if I sample the input data, I obviously get another plot due to the clustering being done on different data. Also, I would love a solution applicable to any plot types (not only pheatmap).
drows <- "euclidean"
dcols <- "euclidean"
clustmet <- "complete"
col.pal <- c("lightgrey","blue")
main.title <- paste("Variant (freq>", minfreq, "%) in all samples", sep="")
hm.parameters.maj <- list(hm.maj.data,
color = col.pal,
fontsize = 10,
cellwidth = 14,
cellheight = 14,
scale = "none",
treeheight_row = 200,
kmeans_k = NA,
show_rownames = T,
show_colnames = T,
main = main.title,
clustering_method = clustmet,
cluster_rows = TRUE,
cluster_cols = FALSE,
clustering_distance_rows = drows,
clustering_distance_cols = dcols,
legend=FALSE)
# To draw the heatmap on screen (comment-out if you run the script from terminal)
do.call("pheatmap", hm.parameters.maj)
# To draw to file (you may want to adapt the info(header(vcf))sizes)
outfile <- paste("major-variants_heatmap_(freq>", minfreq, ")_", drows, ".pdf", sep="")
do.call("pheatmap", c(hm.parameters.maj, filename=outfile, width=24, height=35))
Thanks in advance
Stephane