[英]Color an area with a sliderInput in a shiny app
I have this small example app adapted from the web:我有这个改编自 web 的小示例应用程序:
library( shiny )
library( shinyWidgets )
ui <- fluidPage(
tags$br(),
noUiSliderInput(
inputId = "noui2", label = "Slider vertical:",
min = 0, max = 1000, step = 50,
value = c(100, 400), margin = 100,
orientation = "vertical",
width = "100px", height = "300px"
),
verbatimTextOutput(outputId = "res2")
)
server <- function(input, output, session) {
output$res2 <- renderPrint(input$noui2)
}
shinyApp(ui, server)
Then I load an image as background like:然后我加载图像作为背景,如:
I am wondering if there is a way to color the specific area hight between 100 and 400 (given by the slider) in the borders of the figure like:我想知道是否有一种方法可以为图形边界中 100 到 400 之间(由滑块给出)的特定区域高度着色,例如:
Below please find an approach using plotly's filled area plots :请在下面找到一种使用 plotly 的填充区域图的方法:
library(shiny)
library(plotly)
library(shinyWidgets)
DF <- data.frame(
x = c(cos(seq(0.01, 10, 0.01)) * 1000:1 + 1000, cos(seq(0.01, 10, 0.01)) * 1000:1 + 1500),
y = rep(1:1000, 2),
id = c(rep("trace_1", 1000), rep("trace_2", 1000))
)
ui <- fluidPage(
br(),
column(
2,
noUiSliderInput(
inputId = "noui2",
label = "Slider vertical:",
min = 0,
max = 1000,
step = 50,
value = c(100, 400),
margin = 100,
orientation = "vertical",
direction = c("rtl"),
width = "100px",
height = "350px"
)
),
column(4, plotlyOutput("plot")),
verbatimTextOutput(outputId = "res2")
)
server <- function(input, output, session) {
output$res2 <- renderPrint(input$noui2)
plotDF <- reactive({
plotDF <- DF[DF$y %in% input$noui2[1]:input$noui2[2], ]
plotDF$id <- paste0("filtered_", plotDF$id)
plotDF
})
output$plot <- renderPlotly({
fig <- plot_ly(
rbind(DF, plotDF()),
x = ~ x,
y = ~ y,
split = ~ id,
type = "scatter",
mode = "lines",
color = I("black"),
fillcolor = 'red',
showlegend = FALSE
) |> style(fill = 'tonexty', traces = 2)
})
}
shinyApp(ui, server)
This is somewhat of a first attempt, the alignment is not perfect but it gets the idea across.这是第一次尝试,alignment 并不完美,但它传达了这个想法。 Note the plotting box is still there to get a bit more insight what happens while aligning.
请注意绘图框仍然存在,以便更深入地了解对齐时发生的情况。
library( shiny )
library( shinyWidgets )
ui <- fluidPage(
tags$br(),
fluidRow(
column(2,noUiSliderInput(
inputId = "noui2", label = "Slider vertical:",
min = 0, max = 1000, step = 50,
value = c(100, 400), margin = 100,
orientation = "vertical",
width = "100px", height = "300px"
)),column(10,plotOutput("plot",height = "330px"))
),
verbatimTextOutput(outputId = "res2")
)
server <- function(input, output, session) {
output$res2 <- renderPrint(input$noui2)
output$plot<-renderPlot({
par(mar=c(0,0,1.5,0))
plot(type='n',0:1*1000,0:1*1000, xlab='', ylab='', xaxt='n', yaxt='n')
rect(100, 1000-input$noui2[2], 300,1000-input$noui2[1] , col='red')
})
}
shinyApp(ui, server)
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.