R plotly crashing on linux machines with no X11 - r

I'm ploting together a plotly heatmap along with ggplot2 dendrograms I processed a bit (incompatible with heatmaply), on a linux machine without X11 and running into an error:
Here's the code:
library(ggplot2)
library(plotly)
library(dendextend)
#dendogram data
set.seed(1)
my.mat <- matrix(rnorm(10*100),nrow=100,ncol=10,dimnames = list(paste("g",1:100,sep=""),paste("s",1:10,sep="")))
my.hover.mat <- matrix(paste(paste(rownames(my.mat),paste("description",1:100,sep=" "),sep=":"),colnames(my.mat),signif(my.mat,3),sep="'</br>'"),nrow=100,ncol=10)
x <- as.matrix(scale(my.mat))
dd.col <- as.dendrogram(hclust(dist(x)))
dd.row <- as.dendrogram(hclust(dist(t(x))))
#cut dd.col
dd.col <- cut(dd.col,h=6)$upper
ggdend.col <- as.ggdend(dd.col)
leaf.heights <- dplyr::filter(ggdend.col$nodes,!is.na(leaf))$height
leaf.seqments.idx <- which(ggdend.col$segments$yend %in% leaf.heights)
ggdend.col$segments$yend[leaf.seqments.idx] <- max(ggdend.col$segments$yend[leaf.seqments.idx])
ggdend.col$segments$col[leaf.seqments.idx] <- "black"
ggdend.col$labels$label <- 1:nrow(ggdend.col$labels)
ggdend.col$labels$y <- max(ggdend.col$segments$yend[leaf.seqments.idx])
ggdend.col$labels$x <- ggdend.col$segments$x[leaf.seqments.idx]
ggdend.col$labels$col <- "black"
ggdend.col$segments$lwd <- 0.5
ggdend.row <- dendro_data(dd.row)
ggdend.row$labels$label <- ""
ggdend.row$labels$col <- "black"
ggdend.row$segments$lwd <- 0.5
#ggplot dendrograms
py <- ggplot()+geom_segment(data=ggdend.col$segments,aes(x=x,y=y,xend=xend,yend=yend))+coord_flip()+annotate("text",size=4,hjust=1,x=ggdend.col$label$x,y=ggdend.col$label$y,label=ggdend.col$label$label,colour=ggdend.col$label$col)+labs(x="",y="")+
theme_minimal()+theme(axis.text=element_blank(),axis.ticks=element_blank(),panel.grid=element_blank())
px <- ggplot()+geom_segment(data=ggdend.row$segments,aes(x=x,y=y,xend=xend,yend=yend))+annotate("text",size=4,hjust=1,x=ggdend.row$label$x,y=ggdend.row$label$y,label=ggdend.row$label$label,colour=ggdend.row$label$col)+labs(x="",y="")+
labs(x="",y="")+theme_minimal()+theme(axis.text=element_blank(),axis.ticks=element_blank(),panel.grid=element_blank())
# heatmap
col.ord <- order.dendrogram(dd.col)
row.ord <- order.dendrogram(dd.row)
my.mat <- my.mat[col.ord,row.ord]
my.hover.mat <- my.hover.mat[col.ord,row.ord]
heatmap.plotly <- plot_ly() %>% add_heatmap(z=~my.mat,x=factor(colnames(my.mat),lev=colnames(my.mat)),y=factor(rownames(my.mat),lev=rownames(my.mat)),hoverinfo='text',text=my.hover.mat)
# plotting it all together
eaxis <- list(showticklabels = FALSE,showgrid = FALSE,zeroline = FALSE)
p_empty <- plot_ly(filename="r-docs/dendrogram") %>% layout(margin = list(l = 200),xaxis = eaxis,yaxis = eaxis)
all.together <- plotly::subplot(px, p_empty, heatmap.plotly, py, nrows = 2, margin = 0.01)
which gives:
On a linux machine with no X11, however, the conversion of a ggplot2 object to a plotly object, that takes place in the plotly::subplot command, crashes with this error message:
Error in .External2(C_X11, paste("png::", filename, sep = ""), g$width, :
unable to start device PNG
[1]: https://i.stack.imgur.com/UhKg7.png
The same error is obtained if I try to convert the dendrogram ggplot objects: px and py, to plotly objects:
> plotly_build(py)
Error in .External2(C_X11, paste("png::", filename, sep = ""), g$width, :
unable to start device PNG
So that is not a solution to my problem.
So my questions are:
Is there a workaround to the X11 problem? I won't be able to install X11 on my machine so that one is not a possible solution.
Perhaps there's a way to generate a plotly dendrogram, either directly or from a dendrogram or ggdend objects - i.e. without having to convert a ggplot2 to a plotly object.

Related

plotfun - unable to replace Index (x-axis) with Date

I want to plot the stock price time series for several stocks on individual plots. I've used plotfun but am unable to change to x-axis from Index to Date. I was wondering if I've missed something or is there better way to achieve this. Below is the code that I've created thus far and one of the two plotfun plots.
enter image description hereThanks for your time and consideration in advance.
library("quantmod")
library("ggplot2")
library("BatchGetSymbols")
library("magrittr")
library("broom")
library("dplyr")
library("zoo")
library("xts")
library("tidyverse")
library("tidyquant")
library("TSstudio")
library("rlang")
GetMySymbols <- function(x) {
getSymbols(x,
src ="yahoo",
from = "2010-07-01",
to = "2016-06-30",
auto.assign = FALSE)}
tickers <- c('TLS.AX','WOW.AX')
prices_Close <- map(tickers, GetMySymbols) %>% map(Cl) %>% reduce(merge.xts)
names(prices_Close) <- tickers
##plot.zoo(prices_Close, plot.type = 'multiple')
##plot.xts(prices_Close)
##plot.ts(df)
##df <- fortify(prices_Close)
mydf <- as.Data.frame(prices_Close)
plotfun <- function(col)
plot(mydf[,col], ylab = names(mydf[col]), type = "l")
par(ask = FALSE)
sapply(seq(1, length(mydf), 1), plotfun)
I've found the solution to the problem above:
for (i in 2:ncol(df)){
print(ggplot(df, aes_string(x = "Index", y= df[,i])) + geom_line() + xlab("Date"))
}

Extract all click event plots from Shiny, Plotly - R

In the following shiny app, the plotly package is used to create an interactive correlation heat map. When individual tiles are clicked, the corresponding scatter plot appears. One can then download the individual scatters by clicking download plot as png. But is there a way to download all the possible scatter plots at once without having to click each individual tile and save each individual one? Thank you
library(plotly)
library(shiny)
# compute a correlation matrix
correlation <- round(cor(mtcars), 3)
nms <- names(mtcars)
ui <- fluidPage(
mainPanel(
plotlyOutput("heat"),
plotlyOutput("scatterplot")
),
verbatimTextOutput("selection")
)
server <- function(input, output, session) {
output$heat <- renderPlotly({
plot_ly(x = nms, y = nms, z = correlation,
key = correlation, type = "heatmap", source = "heatplot") %>%
layout(xaxis = list(title = ""),
yaxis = list(title = ""))
})
output$selection <- renderPrint({
s <- event_data("plotly_click")
if (length(s) == 0) {
"Click on a cell in the heatmap to display a scatterplot"
} else {
cat("You selected: \n\n")
as.list(s)
}
})
output$scatterplot <- renderPlotly({
s <- event_data("plotly_click", source = "heatplot")
if (length(s)) {
vars <- c(s[["x"]], s[["y"]])
d <- setNames(mtcars[vars], c("x", "y"))
yhat <- fitted(lm(y ~ x, data = d))
plot_ly(d, x = ~x) %>%
add_markers(y = ~y) %>%
add_lines(y = ~yhat) %>%
layout(xaxis = list(title = s[["x"]]),
yaxis = list(title = s[["y"]]),
showlegend = FALSE)
} else {
plotly_empty()
}
})
}
shinyApp(ui, server)
You can use webshot to capture a static image of Plotly's HTML output using the instructions here: https://plot.ly/r/static-image-export/
An example for loop below generates random scatter plots from mtcars.
library(plotly)
library(webshot)
## You'll need to run the function the first time if you dont't have phantomjs installed
#webshot::install_phantomjs()
ColumnOptions <- colnames(mtcars)
for (i in seq_len(5)){
xCol <- sample(ColumnOptions,1)
yCol <- sample(ColumnOptions,1)
ThisFileName <- paste0("Scatter_",xCol,"_vs_",yCol,".png")
plot_ly(x = mtcars[[xCol]], y = mtcars[[yCol]], type = "scatter", mode = "markers") %>%
export(., file = ThisFileName)
}
However, if you're going to be potentially doing this dozens of times, the amount of computation required to go through the following steps really adds up.
Generate a JSON plotly object from R
Use htmlwidgets/htmltoolsto generate a self-contained HTML web page
Render that HTML as a browser would see it with an external program --webshot
Use webshot to render an image of that HTML and save it as a PNG
This isn't really a reflection of plotly being slow, but to make an analogy it's kind've like using an airplane to travel half a mile -- the plane gets you there, but if you need to make that trip more than a few times you should probably consider a car.
The plotly loop above takes 27 seconds to render 5 PNG images, but the alternative method below using ggplot2 takes 1.2 seconds.
library(ggplot2)
ColumnOptions <- colnames(mtcars)
for (i in seq_len(5)){
xCol <- sample(ColumnOptions,1)
yCol <- sample(ColumnOptions,1)
ThisFileName <- paste0("ggplot2_Scatter_",xCol,"_vs_",yCol,".png")
ggplot() +
geom_point(aes(x = mtcars[[xCol]], y = mtcars[[yCol]])) +
labs(x = xCol, y = yCol) -> ThisPlot
ggsave(plot = ThisPlot, filename = ThisFileName)
}

Visualization issue while using Leaflet

I have two data frame as below:
PickUP <- data.frame(pickuplong = c(-73.93909 ,-73.94189 ,-73.93754,-73.91638,-73.92792 ,-73.88634), pickuplat =c(40.84408,40.83841,40.85311,40.84966,40.86284,40.85628))
Dropoff <- data.frame(pickuplong = c(-73.93351 ,-73.93909 ,-73.93909 ,-73.80747,-73.95722,-73.91880), pickuplat =c(40.76621,40.84408,40.85311,40.69951,40.68877,40.75917), Droplong =c(-73.91300,-73.96259 ,-73.94870,-73.93860,-73.93633, -73.90690), Droplat =c(40.77777,40.77488 ,40.78493,40.84463,40.75977,40.77013))
I try to find the pickup coordinations (longtitude and latitude) in the pickup data frame which are repeated in dropoff dataframe. I have the below code but I got the error on this:
library(sp)
library(rgdal)
library(leaflet)
library(mapview)
library(dplyr)
a <- semi_join(Dropoff , PickUP , by = c("pickuplong","pickuplat"))
a$ID <- 1:nrow(a)
Dropoff_p <- a[, c("ID", "Pickup_longitude", "Pickup_latitude")]
Dropoff_d <- a[, c("ID", "Dropoff_longitude", "Dropoff_latitude")]
coordinates(Dropoff_p) <- ~Pickup_longitude + Pickup_latitude
coordinates(Dropoff_d) <- ~Dropoff_longitude + Dropoff_latitude
proj4string(Dropoff_p) <- CRS("+init=epsg:4326")
proj4string(Dropoff_d) <- CRS("+init=epsg:4326")
map_p <- mapview(Dropoff_p, color = "red")
map_d <- mapview(Dropoff_d, color = "blue")
map_p + map_d
My error is:
Error in $<-.data.frame (tmp, "ID", value = c(1L, 0L)) :
replacement has 2 rows, data has 0 Error during wrapup: cannot open the
connection
When subsetting the data frame, you have to use the same column names. I changed the column name in the Dropoff_p, Dropoff_d, coordinates(Dropoff_p), and proj4string(Dropoff_d), and then your script works.
In addition, the mapview package just has a new update. If you want, you can update your mapview to version 2.0.1. You can also add col.regions = "red" and col.regions = "blue" because it seems like under the new version the color argument will only change the outline of a point. To change the fill color, use col.regions.
library(sp)
library(rgdal)
library(leaflet)
library(mapview)
library(dplyr)
a <- semi_join(Dropoff , PickUP , by = c("pickuplong","pickuplat"))
a$ID <- 1:nrow(a)
Dropoff_p <- a[, c("ID", "pickuplong", "pickuplat")]
Dropoff_d <- a[, c("ID", "Droplong", "Droplat")]
coordinates(Dropoff_p) <- ~pickuplong + pickuplat
coordinates(Dropoff_d) <- ~Droplong + Droplat
proj4string(Dropoff_p) <- CRS("+init=epsg:4326")
proj4string(Dropoff_d) <- CRS("+init=epsg:4326")
map_p <- mapview(Dropoff_p, color = "red", col.regions = "red")
map_d <- mapview(Dropoff_d, color = "blue", col.regions = "blue")
map_p + map_d

Strategies for editing reactive functions in Shiny, 'data' must be of a vector type, was 'NULL' error

Goal: I am trying to create a shiny app that displays (1) the stressplot of a non-metric multidimensional scaling solution, (2) a ggplot of the point configuration, and (3) the results of clustering the point configuration by plotting the point configuration and superimposing chulls of the clustering.
Problem: The first two plots work without difficulty. Instead of a third plot, I get the error: 'data' must be of a vector type, was 'NULL'
I would appreciate any advice on how to resolve the specific problem, i.e. "error in array: 'data' must be of a vector type, was 'NULL'"
I would also appreciate any general advice on how to debug shiny. My only strategy is to treat the code like it isn't reactive code, and I suspect that this strategy isn't terribly effective.
My attempt to solve: I've searched the error on rseek and stack overflow and reviewed the posts. In some of the cases with similar errors the problem was that necessary data wasn't being calculated. I went through the code, treated it as normal (non-reactive) code, and used fake data. When I did this I didn't have any problem, so I assume it is something about the reactivity? Question 2 about how to debug is a reaction to the fact that trying to debug like the code wasn't dynamic didn't identify the problem.
Reproducible Example: I put together a shiny app that has randomly generated data. Before doing the testing I updated R and all the packages I use.
# Packages and options
library(shiny)
library(vegan)
library(cluster)
library(tidyverse)
options(digits = 3)
# Create dissimilarity matrix
d <- rnorm(1000)
mat <- matrix(d, ncol = 10)
diss_m <- daisy(mat) %>% as.matrix()
# Function
find_chulls <- function(df, x, y) {
ch <- chull(df[[x]], df[[y]])
df[ch,] %>% as.data.frame()
}
ui <- fluidPage(
titlePanel("Research"),
sidebarLayout(
sidebarPanel(
numericInput('dim', 'Dimensions', 2, min = 2, max = 15)
),
mainPanel(
h3('Stressplot'),
plotOutput('plot0'),
h3('Non-Metric Multidimensional Scaling'),
plotOutput('plot1'),
h3('2d Density Plot'),
plotOutput('plot2'),
h3('Cluster Analysis'),
plotOutput('plot3')
)
)
)
server <- function(input, output, session) {
nmds <- reactive({
metaMDS(diss_m,
distance = "euclidean",
k = input$dim,
trymax = 200,
autotransform = FALSE,
noshare = FALSE,
wascores = FALSE)
})
output$plot0 <- renderPlot({
stressplot(nmds())
})
pts <- reactive({
nmds()$points %>% as.data.frame()
})
output$plot1 <- renderPlot({
ggplot(pts(), aes(x = MDS1, y = MDS2)) +
geom_point()
})
output$plot2 <- renderPlot({
ggplot(pts(), aes(x = MDS1, y = MDS2)) +
geom_point() +
geom_density2d()
})
df_cl <- reactive({
km <- kmeans(x = pts(), centers = input$clust)
cl <- km$cluster
data.frame(pts(), clust = cl)
})
df_ch <- reactive({
df_ch_temp <- df_cl() %>% group_by(clust) %>% do(find_chulls(., 1, 2))
df_ch_temp %>% as.data.frame()
})
The plot below is the one that doesn't work
output$plot3 <- renderPlot({
ggplot(df_ch(), aes(x = MDS1, y = MDS2, fill = as.factor(clust))) + geom_polygon(alpha = 0.10)
})
}
# Run the application
shinyApp(ui = ui, server = server)
Your input$clust is undefined in:
df_cl <- reactive({
km <- kmeans(x = pts(), centers = input$clust)
cl <- km$cluster
data.frame(pts(), clust = cl)
})
You need to add an input binding for clust, e.g.:
numericInput('clust', 'Clusters', 2, min = 2, max = 15)
As for debugging: I added browser() at the top in df_cl, then execution stops and you can inspect variables and run code in the terminal (e.g. in Rstudio). When I ran km <- kmeans(x = pts(), centers = input$clust) I got the error you described and could then see that input contains no clust element.

x axis and y axis labels in pheatmap in R

I really like how the pheatmap package creates very nice looking heatmaps in R. However, I am trying to add x and y axis labels to the output (if one were just in plot(), one would use: xlab = 'stuff'). A simple example is as follows.
require(pheatmap)
## Generate some data
d <- matrix(rnorm(25), 5, 5)
colnames(d) = paste("bip", 1:5, sep = "")
rownames(d) = paste("blob", 1:5, sep = "")
## Create the heatmap:
pheatmap(d)
The above yields the following heatmap:
I cannot for the life of me figure out how to add an 'xlab' or 'ylab' to this plot. Thoughts?
The main issue here is that pheatmap, which uses grid package, creates a new grid page each time it is called. The solution I've found is:
library(pheatmap)
library(grid)
## Generate some data
d <- matrix(rnorm(25), 5, 5)
colnames(d) = paste("bip", 1:5, sep = "")
rownames(d) = paste("blob", 1:5, sep = "")
## Create the heatmap:
setHook("grid.newpage", function() pushViewport(viewport(x=1,y=1,width=0.9, height=0.9, name="vp", just=c("right","top"))), action="prepend")
pheatmap(d)
setHook("grid.newpage", NULL, "replace")
grid.text("xlabel example", y=-0.07, gp=gpar(fontsize=16))
grid.text("ylabel example", x=-0.07, rot=90, gp=gpar(fontsize=16))

Resources