I am plotting a matrix of DNA characters in shiny using the plot.matrix package which allows plotting of non-numeric matrix
I want to create the matrix plot in shiny and make it interactive, where when you hover over a sequence the name of the sequence appears.
e.g. in by below example the hover labels would be the row names R1, R2 etc,
Are there any good packages or ways to do this?
See below for an simplified example of my current code:
library(plot.matrix)
library(shiny)
matsample<- cbind(c("A","A","A","T"),c("A","A","A","T"),c("A","A","A","G"))
rownames(matsample) <- c("R1","R2","R3","R4")
ui <- plotOutput("matimage")
server <- function(input, output){
output$matimage <- renderPlot({
plot(matsample,col=rainbow(7),fmt.cell='%s',las=1, cex=0.5)},
width=200,
units='px')
}
shinyApp(ui = ui, server = server)
If using plotly would be an option, you could use heatmaply like this:
library(shiny)
library(plotly)
library(heatmaply)
alph <- c("A"=1, "C"=2, "G"=3, "T"=4, "I"=5, "U"=6, "N"=7)
seq <- factor(names(alph), unique(names(alph)))
# matsample <- cbind(c("A","A","A","T"),c("A","A","A","T"),c("A","A","A","G"))
matsample <- matrix(sample(names(alph), 4000, replace = TRUE), nrow=4)
ms <- matrix(alph[matsample], ncol = ncol(matsample), byrow=FALSE)
rownames(matsample) <- c("R1","R2","R3","R4")
rownames(ms) <- rownames(matsample)
mm <- data.frame(do.call(rbind, lapply(rownames(ms), rep, ncol(matsample))))
ui <- plotlyOutput("matimage", width = 160 + (ncol(matsample)*20))
server <- shinyServer(function(input, output, session) {
output$matimage <- renderPlotly({
heatmaply(ms, custom_hovertext = mm,
cellnote = matsample,
show_dendrogram = c(FALSE, FALSE),
Rowv=NULL, Colv=NULL, color=rainbow(7),
hide_colorbar=TRUE,
plot_method = "plotly")
})
})
shinyApp(ui = ui, server = server)
Related
Right now I'm using shiny and Plotly in R to make graphs to visualize data.
I have this list with items and for each item I want to generate a graph with the name of this item.
Is it possible to have your graph output name based on this list item?
In the simplest terms:
What I have:
output$plot <- renderPlotly({})
What I want:
listitems <- c("graph1", "graph2")
output$listitems[1] <- renderPlotly({})
This situation would be ideal, as I want to generate multiple graphs by using a function to minimalize code.
If I understand correctly, you don't want to assign every plot manually. Accordingly we can use a for-loop or lapply like this:
library(shiny)
library(plotly)
ui <- fluidPage(
uiOutput("myPlots")
)
server <- function(input, output, session) {
listItems <- paste0("graph", 1:10)
dfList <- replicate(10, data.frame(x = 1:10, y = runif(10)), simplify = FALSE)
names(dfList) <- listItems
lapply(seq_along(dfList), function(i){
output[[listItems[i]]] <- renderPlotly({plot_ly(dfList[[i]], x = ~x, y = ~y, type = "scatter", mode = "lines+markers") %>% layout(title = listItems[i])})
})
output$myPlots <- renderUI({
lapply(listItems, plotlyOutput)
})
}
shinyApp(ui, server)
Take a look at subplots. In your example, this would have to be something like:
library(shiny)
library(plotly)
ui <- fluidPage(
plotlyOutput("plot")
)
server <- function(input, output, session) {
p1 <- plot_ly(economics, x = ~date, y = ~unemploy) %>%
add_lines(name = ~"unemploy")
p2 <- plot_ly(economics, x = ~date, y = ~uempmed) %>%
add_lines(name = ~"uempmed")
listitems <- list(p1, p2)
output$plot <- renderPlotly({
subplot(listitems)
})
}
shinyApp(ui, server)
Output:
I have the dataframe below:
col1<-sample(500, size = 500, replace = TRUE)
col2<-sample(500, size = 500, replace = TRUE)
d<-data.frame(col1,col2)
And I create a histogram of this data frame that has click-event activated. When the user clicks on a bar the rows of the dataframe that have the relative value are displayed in a datatable. The problem is that the app works fine with a few values. If for example my dataframe had 5 rows instead of 500 with :
col1<-sample(5, size = 5, replace = TRUE)
col2<-sample(5, size = 5, replace = TRUE)
d<-data.frame(col1,col2)
But with more values the app does not work since the plotly gives a range of values in every single bar instead of a unique value.
library(plotly)
library(shiny)
library(DT)
ui <- fluidPage(
mainPanel(
plotlyOutput("heat")
),
DT::dataTableOutput('tbl4')
)
server <- function(input, output, session) {
output$heat <- renderPlotly({
render_value(d) # You need function otherwise data.frame NN is not visible
p <- plot_ly(x = d$col2, type = "histogram",source="subset") # set source so
# that you can get values from source using click_event
})
render_value=function(NN){
output$tbl4 <- renderDataTable({
s <- event_data("plotly_click",source = "subset")
print(s)
return(DT::datatable(d[d$col2==s$y,]))
})
}
}
shinyApp(ui, server)
You can try this (added code to capture the count). You need to plot a histogram of count and then you can able to get your original data based on click event.
library(plotly)
library(shiny)
library(DT)
library(dplyr)
ui <- fluidPage(
mainPanel(
plotlyOutput("heat")
),
DT::dataTableOutput('tbl4')
)
server <- function(input, output, session) {
output$heat <- renderPlotly({
col1<-sample(500, size = 500, replace = TRUE)
col2<-sample(500, size = 500, replace = TRUE)
d<-data.frame(col1,col2)
d=d %>%
group_by(col2) %>%
mutate(count = n()) # You can programatically add count for each row
render_value(d) # You need function otherwise data.frame NN is not visible
p <- plot_ly(x = d$count, type = "histogram",source="subset")
# You should histogram of count
# set source so that you can get values from source using click_event
})
render_value=function(d){
output$tbl4 <- renderDataTable({
s <- event_data("plotly_click",source = "subset")
print(s)
return(DT::datatable(d[d$count==s$x,]))
})
}
}
shinyApp(ui, server)
Screenshot from the working prototype:
How does one dynamically aggregate a raster in Shiny?
i.e. using an example .flt file:
https://www.ngdc.noaa.gov/mgg/global/relief/ETOPO2/ETOPO2v2-2006/ETOPO2v2c/raw_binary/
library("dplyr")
library("ggplot2")
library("shiny")
library("raster")
ui <- fluidPage(
mainPanel(
plotOutput("canvasHere")
),
sliderInput("sliderRes", label = h5("Resolution reduction"),
min = 1, max = 100, value = 5)
) ## UI end
shinyServer <- function(input, output) {
BMgradient <- raster("/home/berg/Downloads/ETOPO2v2c_f4_LSB/ETOPO2v2c_f4_LSB.flt",crs=NA,template=NULL)
##resolutionFactor <- input$sliderRes
resolutionFactor <- 5
BMgradient <- aggregate(BMgradient, fact=resolutionFactor, fun=max)
p <- rasterToPoints(BMgradient)
bmdf <- data.frame(p)
colnames(bmdf) <- c("bbb", "ccc", "varFillBBB")
output$canvasHere <- renderPlot({
ggplot()+
geom_tile(data=bmdf,aes(bbb,ccc,fill=varFillBBB))
})
}
print("Processed code")
runApp(list(ui = ui, server = shinyServer))
Now, usually I'd just adjust a variable in the server by using:
resolutionFactor <- input$sliderRes
However, this doesn't seem to work for raster aggregation, and I just have to use a static resolution factor such as: resolutionFactor <- 5
How can I do this dynamically via a slider in the UI?
After a while, I managed to find the solution.
The raster aggregation itself needs to be placed in the reactive environment.
i.e.
output$yourOutput <- renderPlot({
BMgradient <- raster(...)
resolutionFactor <- input$sliderRes
## Rest of raster code
ggplot()+
geom_tile(data=bmdf,aes(bbb,ccc,fill=varFillBBB))
})
Then, you can manually adjust the slider and the raster will dynamically aggregate.
I have a plotly plot in R Shiny. I want to be able to click many points and have them displayed in a table. The plot is working great and I can get 1 plotly_click (via event_data()) to show in a table. How can a grow a vector of many event_data points. Here is some sample code. I was trying to save the event in d_save. Thanks.
library(shiny)
library(plotly)
data1 <- data.frame(cbind(seq(1,1000,1),seq(1,1000,1)*5))
colnames(data1) <- c('index','data')
data_points <- data.frame(cbind(seq(1,1000,5),seq(1,1000,5)*5))
colnames(data_points) <- c('index','data')
ui <- fluidPage(
plotlyOutput("plot1"),
tableOutput("dataTable")
)
d_save <- vector()
server <- function(input, output, session) {
# make plotly plot
output$plot1 <- renderPlotly({
p <- plot_ly(data1, x = data1$index, y = data1$data,mode = "lines")
add_trace(p, x = data_points$index, y = data_points$data, mode = "markers")
})
# show table of stances
output$dataTable <- renderTable({
d <- event_data("plotly_click")
d_save <- c(d_save,d$pointNumber[2]+1)
data.frame(d_save)
})
}
shinyApp(ui, server)
There is nothing seriously wrong with this and it was weird that it never got answered. It is not a bad example of pure plotly (without using ggplot).
I fixed it by:
changing the d_save <- c(...) assignment to a d_save <<- c(...) (using a reactiveValues here would be cleaner).
changing the plotly call to be a pipe, which seemingly allows some settings to carry over (like the type=scatter default) - eliminating the warning:
No trace type specified: Based on info supplied, a 'scatter' trace
seems appropriate.
fixed an "off-by-one" indexing error in the d_save assignment.
added a layout(...) to give it a title (this is useful for a lot of things).
The resulting code:
library(shiny)
library(plotly)
data1 <- data.frame(cbind(seq(1,1000,1),seq(1,1000,1)*5))
colnames(data1) <- c('index','data')
data_points <- data.frame(cbind(seq(1,1000,5),seq(1,1000,5)*5))
colnames(data_points) <- c('index','data')
ui <- fluidPage(
plotlyOutput("plot1"),
tableOutput("dataTable")
)
d_save <- vector()
server <- function(input, output, session) {
# make plotly plot
output$plot1 <- renderPlotly({
plot_ly(data1, x=data1$index, y=data1$data,mode = "lines") %>%
add_trace(x = data_points$index, y=data_points$data, mode = "markers") %>%
layout(title="Plotly_click Test")
})
# show table of point markers clicked on by number
output$dataTable <- renderTable({
d <- event_data("plotly_click")
d_save <<- c(d_save,d$pointNumber[1]+1)
data.frame(d_save)
})
}
shinyApp(ui, server)
The image:
I am trying to create an app using Shiny, where I want the user to be able to select the color of each line in a plot. The general idea is to import the data in the app and then plot each variable in the data. I tried to use the colorpicker 'jscolorInput' from the shinysky package, which works fine when placed in the ui.r file, but since I want my app to be dynamic for each dataset uploaded, I need to put the colorpicker in the server.R, using a reactive function.
When placed in the server, the 'jscolorInput' does not work.
What I want to do is:
Reproduce the colorpicker as many times as the number of
variables in the data
Take the input from the color and pass it
as color argument in the plot
I am very new in both shiny development and stackoverflow, so please excuse my mistakes.
Here is a reproducible example that does not work.
require(shinysky)
require(shiny)
dat <- data.frame(matrix(rnorm(120, 2, 3), ncol=3))
runApp(list(
ui = bootstrapPage(
# The reactive colorpicker
uiOutput('myPanel'),
# The plot
plotOutput('plot')
),
server = function(input, output) {
# Print as many colorpickers as the columns in the dataset
cols <- reactive({
n <- ncol(dat)
for(i in 1:n){
print(jscolorInput(paste("col", i, sep="_")))
}
})
output$myPanel <- renderPrint({cols()})
# Put all the input in a vector
colors <- reactive({
n <- ncol(dat)
lapply(1:n, function(i) {
input[[paste("col", i, sep="_")]]
})
})
output$plot <- renderPlot({
cols <- ifelse(is.null(input$col_1), rep("000000 ", n), colors())
plot(dat[,1], col= paste0("#", cols[1], ""))
for(i in 2:ncol(dat))lines(dat[,i], col=cols[i])
})
}
))
Here is a working version of what you are trying to do. Look at the differences between our code, there were a few problems with your code. Also, note that I'm not using shinysky because it doesn't have the colourpicker anymore (it's moved to a different package that's inactive), so instead I'm using the inputColour from shinyjs.
library(shiny)
library(shinyjs)
dat <- data.frame(matrix(rnorm(120, 2, 3), ncol=3))
runApp(shinyApp(
ui = fluidPage(
uiOutput('myPanel'),
plotOutput("plot")
),
server = function(input, output, session) {
cols <- reactive({
lapply(seq_along(dat), function(i) {
colourInput(paste("col", i, sep="_"), "Choose colour:", "black")
})
})
output$myPanel <- renderUI({cols()})
# Put all the input in a vector
colors <- reactive({
lapply(seq_along(dat), function(i) {
input[[paste("col", i, sep="_")]]
})
})
output$plot <- renderPlot({
if (is.null(input$col_1)) {
cols <- rep("#000000", ncol(dat))
} else {
cols <- unlist(colors())
}
plot(dat[,1], col = cols[1])
for(i in 2:ncol(dat)) lines(dat[,i], col = cols[i])
})
}
))
Disclaimer: I'm the author of shinyjs