Graphics come out blank.
I need to plot several graphs from a GBM analysis, so I am using a loop along with the paste function.
But are all the graphics coming out blank? What can it be? When executing code out of the loop everything works. Thank you
list <- list("A","B", "C")
for (i in list) {
df <- fread(paste("data_", i, ".csv", sep = ""), header = TRUE)
gbm.fit <- gbm( formula = y ~ ., distribution = "gaussian", data = train,n.trees = 1000, interaction.depth = 5, shrinkage = 0.1, cv.folds = 5, n.cores = NULL, verbose = FALSE )
pathname <- paste("gbm", i, ".tiff", sep = "")
tiff( file = pathname, width = 1200, height = 1000, res = 105 )
vip( gbm.fit, num_features = 15, bar = TRUE, width = 0.75, horizontal = TRUE, color = hcl.colors( 15, palette = "Greens2", alpha = NULL, rev = FALSE, fixup = TRUE ), fill = hcl.colors( 15, palette ="Greens", alpha = NULL, rev = TRUE, fixup = TRUE ) )
dev.off()
}
I would like the graphics to come out with the correct content
The vip function uses ggplot2-based graphics. Therefore, either print() the plot or use ggsave() to save the plot to a file:
1. The print() method:
myPlot <- vip( gbm.fit, num_features = 15, bar = TRUE, width = 0.75, horizontal = TRUE,
color = hcl.colors( 15, palette = "Greens2", alpha = NULL, rev = FALSE,
fixup = TRUE ), fill = hcl.colors( 15, palette ="Greens", alpha = NULL,
rev = TRUE, fixup = TRUE ) )
tiff( file = pathname, width = 1200, height = 1000, res = 105 )
print(myPlot)
dev.off()
2. The ggsave() method:
myRes <- 105 # ggsave uses inches, not pixels
ggsave(pathname, myPlot, device = "tiff", width = 1200 / myRes,
height = 1000 / myRes, dpi = myRes)
Related
I use the example from the site, but I want to remove the points so that only the connection of the medians remains.
My code.
# for reproducibility
set.seed(123)
library(ggstatsplot)
df_disgust <- dplyr::filter(bugs_long, condition %in% c("LDHF", "HDHF"))
p2 <-
ggstatsplot::ggwithinstats(
data = df_disgust,
x = condition,
y = desire,
xlab = "Condition",
ylab = "Desire to kill bugs",
type = "np",
conf.level = 0.99,
title = "Non-parametric Test",
package = "ggsci",
palette = "uniform_startrek",
point.args = list(size = 0, alpha = 0.5),
point.path = FALSE,
centrality.plotting = TRUE,
outlier.tagging = T,
ggtheme = ggthemes::theme_map()
)
ggstatsplot::combine_plots(
plotlist = list(p2),
plotgrid.args = list(nrow = 2),
annotation.args = list(
title = "Effect of disgust on desire to kill bugs ",
caption = "Source: Bugs dataset from `jmv` R package"
)
)
The parameter that is responsible for the points, as I understood point.args = list(size = 3, alpha = 0.5),but when I set size = 0 the dots don't disappear.
I didn't find any other parameters that would be responsible for the points
You can just set the transparency for respective geometric layers to 0.
library(ggstatsplot)
df_disgust <- dplyr::filter(bugs_long, condition %in% c("LDHF", "HDHF"))
ggwithinstats(df_disgust,
condition,
desire,
point.args = list(alpha = 0),
centrality.point.args = list(alpha = 0),
point.path = FALSE
)
grouped_ggwithinstats(df_disgust,
condition,
desire,
grouping.var = gender,
point.args = list(alpha = 0),
centrality.point.args = list(alpha = 0),
point.path = FALSE
)
Created on 2022-05-13 by the reprex package (v2.0.1.9000)
I have the following code. It selects data and makes a plotly plot. The code loops through the variable "criteria" and at the end of the loop inserts the plot in the appropriate index.
Everything works fine except that all but the last elements of the list are null and only the last plot is included.
How do I include all the plotly charts in the list?
criteria <- c("A", "B", "C")
for(i in 1:length(criteria)){
plotTbl <- dataTbl[Site == criteria[i]]
plotTbl <- unique(plotTbl[ ,N := .N, by = .(Site, Var)])
noexacCols <- unique(c(brewer.pal(name="Set1", n = 9),
brewer.pal(name="Set2", n = 8),
brewer.pal(name="BrBG", n =11),
brewer.pal(name="Paired", n = 12)))
noexacCols <- noexacCols[i]
colMapper <- data.table(Var = sort(unique(plotTbl[,Var])))
colMapper[, colorCodes := noexacCols]
plotTbl <- plotTbl[colMapper, on = .(Var), nomatch = 0]
plotTbl[ ,Percent := round(100*N/sum(N), 1)]
plotTbl[ ,text2display := paste0("Site = ",Site,
"<br>",category, " = ", Var,
"<br>N = ", N, " (", Percent, "%)")]
f1 <- list(
family = "Arial, sans-serif",
size = 14,
color = "black"
)
f2 <- list(
family = "Arial, sans-serif",
size = 12,
color = "black"
)
a <- list(
title = "",
titlefont = f1,
showticklabels = TRUE,
tickangle = 0,
tickfont = f2
)
b <- list(
title = "",
titlefont = f1,
showticklabels = TRUE,
tickangle = 0,
tickfont = f2,
zeroline = TRUE,
showline = TRUE,
mirror = FALSE,
linecolor = toRGB("black"),
linewidth = 1
)
p <- list()
p[[i]] <- plot_ly(data = plotTbl ,
x = ~Var,
y = ~N,
type = 'bar',
marker = list(color = ~colorCodes),
opacity = 0.7,
hoverinfo="text",
text = ~text2display) %>%
layout(xaxis = a, yaxis = b, showlegend = F, margin = list(b = 30))
}
You create p within the loop and thus overwrite it on every revolution. Move line p <- list() before the loop.
I have icons on a leaflet plot which have different colors and shapes based on some variables in my data frame. I want to include a legend on the plot that shows what each shape and color combination represents. How should I do it?
To demonstrate with dummy data:
library(leaflet)
lat1= 36+runif(n=5,min=-1,max=1)
lon1 =-115+runif(n=5,min=-1,max=1)
lat2= 35+runif(n=5,min=-0.5,max=0.5)
lon2 =-110+runif(n=5,min=-0.5,max=0.5)
lat3= 34+runif(n=5,min=-0.5,max=0.5)
lon3 =-112+runif(n=5,min=-0.5,max=0.5)
data_all=rbind(data.frame(Longitude=lon1,Latitude=lat1,Group=sample(c(16,17,18),5,replace = TRUE),condition=sample(c("red","blue","green"),5,replace = TRUE),stringsAsFactors = FALSE),
data.frame(Longitude=lon2,Latitude=lat1,Group=sample(c(16,17,18),5,replace = TRUE),condition=sample(c("red","blue","green"),5,replace = TRUE),stringsAsFactors = FALSE),
data.frame(Longitude=lon3,Latitude=lat1,Group=sample(c(16,17,18),5,replace = TRUE),condition=sample(c("red","blue","green"),5,replace = TRUE),stringsAsFactors = FALSE))
# A function to create png images for each shape and color
pchIcons = function(pch = 1, width = 30, height = 30, bg = "transparent", col = NULL, ...) {
n = length(pch)
files = character(n)
# create a sequence of png images
for (i in seq_len(n)) {
f = tempfile(fileext = '.png')
png(f, width = width, height = height, bg = bg)
par(mar = c(0, 0, 0, 0))
plot.new()
points(.5, .5, pch = pch[i], col = col[i], cex = min(width, height) / 8, ...)
dev.off()
files[i] = f
}
files
}
### ---------
leaflet(data_all)%>% addTiles() %>%
addMarkers(
data = data_all,
icon = ~ icons(
iconUrl = pchIcons(pch= Group,width=40,height=40,col=condition,lwd=4),
popupAnchorX = 20, popupAnchorY = 0
))
Based on this post, using base64enc and creating fixed filenames instead of using tempfile:
# A function to create file names
filename <- function(pch,col) paste0(pch, '_', col, '.png')
# A function to create png images for each shape and color
pchIcons = function(pch = 1, width = 30, height = 30, bg = "transparent", col = NULL, ...) {
n = length(pch)
files = character(n)
# create a sequence of png images
for (i in seq_len(n)) {
f = filename(pch[i], col[i])
png(f, width = width, height = height, bg = bg)
par(mar = c(0, 0, 0, 0))
plot.new()
points(.5, .5, pch = pch[i], col = col[i], cex = min(width, height) / 8, ...)
dev.off()
files[i] = f
}
files
}
# A function to build the legend
build_legend <- function(){
paste(sapply(strsplit(unique(paste(data_all$Group,data_all$condition)), " "),
function(x){
paste0("<img src='data:image/png;base64,",
base64enc::base64encode(filename(x[[1]], x[[2]])),
"' width='16'; height='16'> ",
"Group=",x[[1]], " Condition=", x[[2]],
"<br/>" )}), collapse = " ")
}
# The plot
leaflet(data_all)%>% addTiles() %>%
addMarkers(
data = data_all,
icon = ~ icons(
iconUrl = pchIcons(pch= Group,width=40,height=40,col=condition,lwd=4),
popupAnchorX = 20, popupAnchorY = 0)) %>%
addControl(html = build_legend(), position = "bottomleft")
is there any way to specify color key for d3heatmap in R? following is the code with which I am able to make the heatmap but could not show a color key. Kindly provide some answers.
library(d3heatmap)
d3heatmap(data, Rowv = TRUE, Colv = TRUE,
distfun = dist, hclustfun = hclust, dendrogram = c("both", "row",
"column", "none"), reorderfun = function(d, w) reorder(d, w), k_row=400, symm = FALSE, scale = "row", na.rm = TRUE,labRow = rownames(data), labCol = colnames(data), digits = 3L,theme = NULL, color = scales::col_quantile("Blues", NULL, 5),
width = 960, height = 500, xaxis_height = 80, yaxis_width = 120,
xaxis_font_size = "12pt", yaxis_font_size = "12pt", brush_color ="#0000FF",
show_grid = TRUE, anim_duration = 0)
I want to plot 4 of the following plots as an par(mfrow=c(2,2)) type arrangement.
install.packages("wavelets")
require(wavelets)
dat <- rnorm(100)
plot.modwt(modwt(dat)) #4 of these in a 2x2 grid is desired
However, layout and mfrow based attempts have not succeeded.
I will be giving the correct answer a bounty.
As #plannapus commented, the function plot.modwt already calls layout. So you will need to alter the original function.
If you type plot.modwt in you R console, you will get the complete definition.
Copy this function and save it as a new function, say, my.plot.modwt.
Comment out the layout line in this function
Set up your new layout. This worked for me:
nf = layout(matrix(c(3, 1, 4, 2, 7, 5,8, 6), 4, 2, byrow = TRUE),
c(2,2), c(2,1, 2, 1), TRUE)
layout.show(nf)
Call your function (4 times )to create plots:
my.plot.modwt(modwt(dat1))
my.plot.modwt(modwt(dat2))
my.plot.modwt(modwt(dat3))
my.plot.modwt(modwt(dat4))
Note, some other alterations to the layout will probably be needed.
My code:
y.plot.modwt = function (x, levels = NULL, draw.boundary = FALSE, type = "stack",
col.plot = "black", col.boundary = "red", X.xtick.at = NULL,
X.ytick.at = NULL, Stack.xtick.at = NULL, Stack.ytick.at = NULL,
X.xlab = "t", y.rlabs = TRUE, plot.X = TRUE, plot.W = TRUE,
plot.V = TRUE, ...)
{
stackplot.modwt <- function(x, w.range, v.range, col.plot,
col.boundary, draw.boundary, X.xtick.at, X.ytick.at,
Stack.xtick.at, Stack.ytick.at, X.xlab = "t", plot.X = TRUE) {
innerplot <- function(x, y, type = "l", xtick.at, ytick.at) {
if (is.null(xtick.at) == FALSE || is.null(ytick.at) ==
FALSE) {
plot(x, y, type = "l", axes = FALSE, frame.plot = TRUE)
<snip>
if (plot.X) {
#nf <- layout(matrix(c(2, 2, 1, 1), 2, 2, byrow = TRUE),
# c(1, 2), c(2, 1), TRUE)
par(mai = c(0.6, 0.4, 0.1, 0.6))
<snip>
}