I'm building a heatmap using R's d3heatmap library: https://cran.r-project.org/web/packages/d3heatmap/d3heatmap.pdf
I'd like to be able to allow a user to freely adjust (through the UI) the height = argument in the d3heatmapOutput() function.
Compare the following two code snippets (just copy/paste them directly into R Studio), where the only difference between them is the value of the height = argument in the d3heatmapOutput():
library(d3heatmap)
library(shiny)
ui <- fluidPage(
h1("A heatmap demo"),
selectInput("palette", "Palette", c("YlOrRd", "RdYlBu", "Greens", "Blues")),
checkboxInput("cluster", "Apply clustering"),
d3heatmapOutput("heatmap", height = "400px")
)
server <- function(input, output, session) {
output$heatmap <- renderD3heatmap({
d3heatmap(
scale(mtcars),
colors = input$palette,
dendrogram = if (input$cluster) "both" else "none"
) })
}
shinyApp(ui, server)
VS.
library(d3heatmap)
library(shiny)
ui <- fluidPage(
h1("A heatmap demo"),
selectInput("palette", "Palette", c("YlOrRd", "RdYlBu", "Greens", "Blues")),
checkboxInput("cluster", "Apply clustering"),
d3heatmapOutput("heatmap", height = "1000px")
)
server <- function(input, output, session) {
output$heatmap <- renderD3heatmap({
d3heatmap(
scale(mtcars),
colors = input$palette,
dendrogram = if (input$cluster) "both" else "none"
) })
}
shinyApp(ui, server)
I'd like to allow the user to choose this value of height = themselves. However, because "400px" is a non-numeric argument, UI tools such as numericInput() don't work. Likewise, selectInput() doesn't work either, e.g.:
selectInput("foo", "Bar:", c("400px", "700px", "1000px"))
where d3heatmapOutput("heatmap", height = "foo"). Unfortunately, neither of these options work, which makes me wonder if I may have overlooked a simpler, more elegant option.
In this example you can control the hight of the plot using a slider. The idea is to render the map on the server side and to use paste0 function to set desired size in pixels.
library(d3heatmap)
library(shiny)
ui <- fluidPage(
h1("A heatmap demo"),
sliderInput("pixels", "size", value = 400, min = 100, max = 1000),
selectInput("palette", "Palette", c("YlOrRd", "RdYlBu", "Greens", "Blues")),
checkboxInput("cluster", "Apply clustering"),
uiOutput("dynamic")
)
server <- function(input, output, session) {
output$heatmap <- renderD3heatmap({
d3heatmap(
scale(mtcars),
colors = input$palette,
dendrogram = if (input$cluster) "both" else "none"
) })
output$dynamic <- renderUI({
d3heatmapOutput("heatmap", height = paste0(input$pixels, "px"))
})
}
shinyApp(ui, server)
Related
I have developed an application, where I am generating plots. I am able to render the plots and download it without any problem.
I would like to get the details of the points in the graph, when i move my cursor to the points. With search, I am not sure, if I can obtain this in Shiny.
Any help would be great.
Below is the code, i have used.
UI Code:
tabItem(tabName = "models2",
fluidPage(
fluidRow(
infoBoxOutput("overview")
),
fluidRow(
actionButton("result1","Generate Result"),
downloadButton('downloadPlot','Download Plot'),
plotOutput("plot3")
)
))
SERVER CODE
server <- function(input,output){
output$claim_overview <- renderValueBox({
valueBox(
paste("91")," Overview",icon=icon("hourglass"),
color="green"
)
})
data<- reactiveValues()
observeEvent(input$result1,{
data$plot <- ggplot(data=timedata, aes(x=dat1, y=yes, group=3))+
geom_point(shape=1)+
coord_cartesian(xlim=c(dat1_xlowlim,dat1_xhighlim))+
labs(title="Prediction Probability",x="Reg.Date",y="True probability")
})
output$plot3 <- renderPlot({ data$plot })
output$downloadPlot <- downloadHandler(
filename = function()
{paste("input$plot3",'.png',sep='')
},
content = function(file){
ggsave(file,plot = data$plot)
}
)
}
You can use either brush option or hover option to get any info from the plot.
Mouse hover example:
df<- table(rpois(100, 5))
ui <- fluidPage(
mainPanel(
plotOutput(outputId = "scatterplot", hover = "plot_hover"),
verbatimTextOutput(outputId = "dftable"),
br()
)
)
server <- function(input, output) {
output$scatterplot <- renderPlot({
plot(df, type = "h", col = "red", lwd = 10)
})
output$dftable <- renderPrint({
paste(input$plot_hover)
})
}
shinyApp(ui = ui, server = server)
I would like to show in my shiny app a link that directs to the URL generated based on user's input. I don't want to show the full text of the URL. I know the a(href="",label="") function can be used if I know the URL beforehand, but in this case the URL depends on the user's input. The following doesn't work:
ui <- fluidPage(
titlePanel("Show map of a given state"),
sidebarLayout(
sidebarPanel(
textInput("state", label = "State", value = "CA", placeholder = "California or CA"),
actionButton("showU","Show map")
),
mainPanel(
conditionalPanel(
condition = "input.showU > 0",
htmlOutput("url"),
a(href=htmlOutput("url"),"Show in Google Map",target="_blank")
)
)
)
)
server <- function(input, output){
observeEvent(input$showU,{
output$url <-renderUI({paste("https://www.google.com/maps/place/", input$state, sep="")})
})
}
shinyApp(ui,server)
I hope I can click on the "Show in Google Map" and be directed to the URL generated on the fly. Please help me, thank you.
You need to use renderUI together with uiOutput to update UI reactively:
library(shiny)
ui <- fluidPage(
titlePanel("Show map of a given state"),
sidebarLayout(
sidebarPanel(
textInput("state", label = "State", value = "CA", placeholder = "California or CA"),
actionButton("showU","Show map")
),
mainPanel(
conditionalPanel(
condition = "input.showU > 0",
uiOutput("url")
)
)
)
)
server <- function(input, output){
observeEvent(input$showU,{
output$url <-renderUI(a(href=paste0('https://www.google.com/maps/place/', input$state),"Show in Google Map",target="_blank"))
})
}
shinyApp(ui,server)
If this questions is actually about creating reactive URL links, then HubertL's answer is the way to go.
If you want to keep the map and search funciton all self-contained in the shiny, rather than having to open a new link to Google Maps, you can use my googleway package to achieve the same task
library(shiny)
library(googleway)
ui <- fluidPage(
titlePanel("Show map of a given state"),
sidebarLayout(
sidebarPanel(
),
mainPanel(
google_mapOutput(outputId = "myMap", height = "600px")
)
)
)
server <- function(input, output){
## you need a valid API key from Google Maps
## https://developers.google.com/maps/
map_key <- "your_map_api_key"
output$myMap <- renderGoogle_map({
google_map(key = map_key, search_box = T)
})
}
shinyApp(ui,server)
I used a HTML button for which the url could be generated recursively
library(shiny)
# Define UI for application that draws a histogram
ui <- fluidPage(
# Application title
titlePanel("HTML button"),
# Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel(
sliderInput("bins",
"Number of bins:",
min = 1,
max = 50,
value = 30)
),
# Show a plot of the generated distribution
mainPanel(
plotOutput("distPlot"),
HTML(paste0(htmlOutput('url_test')))
)
)
)
# Define server logic required to draw a histogram
server <- function(input, output) {
output$distPlot <- renderPlot({
# generate bins based on input$bins from ui.R
x <- faithful[, 2]
bins <- seq(min(x), max(x), length.out = input$bins + 1)
# draw the histogram with the specified number of bins
hist(x, breaks = bins, col = 'darkgray', border = 'white')
})
output$url_test = renderText({
paste('Go to Google')
})
cultivar_url = reactive({
print('https://www.google.com')
})
}
# Run the application
shinyApp(ui = ui, server = server)
I have a square plot (aspect ratio 1:1) that I'm trying to scale to be the full width of mainPanel. Due to the height parameter being 400px by default, the plot comes out as a 400x400 image in the middle of the panel:
I read that you can alter the height parameter of plotOutput to be "100%" or "auto" to have the panel use the natural dimensions of the image. However, plotOutput then tries to retrieve the height parameter from renderPlot, which itself is getting its height value from plotOutput resulting in a "Catch-22" scenario and a plot of height 0px.
What I'm trying to do is set the height value of renderPlot (or plotOutput) to be equal to the width of mainPanel, but I'm unsure how to access this value. Here's my code so far:
library( shiny )
library( ggplot2 )
server <- function(input, output)
{
output$plot1 <- renderPlot({
X <- data.frame( x=rnorm(input$n), y=rnorm( input$n ) )
ggplot( X, aes(x=x, y=y) ) + geom_point() + coord_fixed()
}, height=400 # how to get this value to be mainPanel width?
)
}
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
sliderInput("n", "Number of Samples", min=10, max=1000, value=100) ),
mainPanel( plotOutput("plot1", height="auto") )
)
)
shinyApp(ui = ui, server = server)
Any thoughts?
Based on this post:
library( shiny )
library( ggplot2 )
server <- function(input, output)
{
output$plot1 <- renderPlot({
X <- data.frame( x=rnorm(10), y=rnorm( 10) )
ggplot( X, aes(x=x, y=y) ) + geom_point() + coord_fixed()
} ,
height=reactive(ifelse(!is.null(input$innerWidth),input$innerWidth*3/5,0))
)
}
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
tags$head(tags$script('$(document).on("shiny:connected", function(e) {
Shiny.onInputChange("innerWidth", window.innerWidth);
});
$(window).resize(function(e) {
Shiny.onInputChange("innerWidth", window.innerWidth);
});
')),
sliderInput("n", "Number of Samples", min=10, max=1000, value=100) ),
mainPanel( plotOutput("plot1"))
)
)
shinyApp(ui = ui, server = server)
Is there any way to change parameters for plotOutput() reactively? Let's say I have an input selector, which allows me to choose type of plot (scatter, 'p' or line plot 'l'). For the scatter plot I want to set brush as "rowBrush" and for the line plot I want to make it "colBrush" and direction = "x". Thanks in advance!
Here is an example.
library(shiny)
ui <- fluidPage(
titlePanel("Dynamic brush"),
sidebarLayout(
sidebarPanel(
selectInput("plot_type", "Plot type", c("p", "l"), selected = "p")
),
mainPanel(
uiOutput("plot_out")
)
)
)
server <- function(input, output) {
output$plot_out <- renderUI({
brush <- NULL
if (input$plot_type == "p") {
brush <- "rowBrush"
} else if (input$plot_type == "l") {
brush <- "colBrush"
}
plotOutput("plot", brush=brush)
})
output$plot <- renderPlot({
plot(mtcars$mpg, mtcars$cyl, type=input$plot_type )
})
}
shinyApp(ui = ui, server = server)
I´m searching for a method to change the height parameter in plotOutput() depending on an input$.. value.
Any suggestions?
Samuel
Here you go:
library(shiny)
shinyApp(
ui = fluidPage(
numericInput("height", "height", 300),
plotOutput("plot", height = "auto")
),
server = function(input, output, session) {
output$plot <- renderPlot({
plot(1:10)
},
height = function(x) input$height)
}
)