英文:
How to insert a custom image into Shiny plot header?
问题
在底部发布的几乎是最小工作示例（MWE）代码中，我试图将自定义图像添加到绘图标题中。在完整的应用程序中，用户点击图像以触发解释性模态对话框。但是，在这种情况下，我无法在绘图标题中呈现图像。在其他情况下，对我来说效果很好，我使用renderUI()，但在这种情况下，我试图在renderPlot()函数内呈现图像。下面的图像比这些文字更好地解释了问题。有没有办法在renderPlot()内部实现这一点？
MWE 代码：
library(shiny)
library(survival)
### 定义函数 ###
weibSurv <- function(t, shape, scale) pweibull(t, shape=shape, scale=scale, lower.tail = FALSE)
ui <- fluidPage(
selectInput("distSelect", "选择分布:", c("Weibull", "Gamma")),
sliderInput('shape', '调整形状:', min = 0, max = 3, step = 0.1, value = 1.5),
plotOutput("plot")
)
server <- function(input, output, session) {
output$plot <- renderPlot({
curve(
weibSurv(x, shape = input$shape, scale = 1/0.03),
from = 0, to = 80,
main =
fluidRow(
paste(input$distSelect), # 留下 paste，实际应用程序中还有更多要包括的对象
tags$button(
id = "explainBtn",
class = "btn action-button",
tags$img(src = "https://images.plot.ly/language-icons/api-home/python-logo.png")
)
)
)
})
}
shinyApp(ui, server)
<details>
<summary>英文:</summary>
In the almost-MWE code posted at the bottom, I'm trying to pull a custom image into the plot header. In the full App the user clicks on the image in order to trigger an explanatory modal dialogue. However, I can't get the image to render in the plot header in this case. In other cases where this works for me fine, I use `renderUI()`, but in this case I'm trying to render the image inside the `renderPlot()` function. Image below explains better than these words. Is there a way to do this inside `renderPlot()`?
[![enter image description here][1]][1]
MWE code:
library(shiny)
library(survival)
### define function ###
weibSurv <- function(t, shape, scale) pweibull(t, shape=shape,scale=scale, lower.tail=F)
ui <- fluidPage(
selectInput("distSelect","Select distribution:",c("Weibull","Gamma")),
sliderInput('shape','Adjust shape:',min=0,max=3,step=0.1,value=1.5),
plotOutput("plot")
)
server <- function(input, output, session) {
output$plot <- renderPlot({
curve(
weibSurv(x, shape=input$shape,scale=1/0.03),
from=0, to=80,
main =
fluidRow(
paste(input$distSelect), # leave paste, actual App has more objects to include here
tags$button(
id = "explainBtn",
class = "btn action-button",
tags$img(src = "https://images.plot.ly/language-icons/api-home/python-logo.png")
)
)
)
})
}
shinyApp(ui, server)
[1]: https://i.stack.imgur.com/7Uysx.png
</details>
# 答案1
**得分**: 1
在这种情况下，我会使用shiny的`actionLink`：
```R
library(shiny)
library(survival)
### 定义函数 ###
weibSurv <- function(t, shape, scale) pweibull(t, shape=shape, scale=scale, lower.tail = FALSE)
ui <- fluidPage(
selectInput("distSelect", "选择分布:", c("Weibull", "Gamma")),
sliderInput('shape', '调整形状:', min = 0, max = 3, step = 0.1, value = 1.5),
column(12, align = "center",
actionLink(inputId = "explainBtn", label = strong("Weibull"), icon = NULL, br(), img(src = "https://images.plot.ly/language-icons/api-home/python-logo.png"))
),
plotOutput("plot")
)
server <- function(input, output, session) {
output$plot <- renderPlot({
par(mar = c(5, 4, 0, 2) + 0.1) # 减少图上方的空间
curve(
weibSurv(x, shape = input$shape, scale = 1/0.03),
from = 0, to = 80,
)
})
observeEvent(input$explainBtn, {
showModal(modalDialog("做一些有用的事情"))
})
}
shinyApp(ui, server)
英文:
I'd use shiny's actionLink in this scenario:
library(shiny)
library(survival)
### define function ###
weibSurv <- function(t, shape, scale) pweibull(t, shape=shape,scale=scale, lower.tail=F)
ui <- fluidPage(
selectInput("distSelect","Select distribution:",c("Weibull","Gamma")),
sliderInput('shape','Adjust shape:',min=0,max=3,step=0.1,value=1.5),
column(12, align="center",
actionLink(inputId = "explainBtn", label = strong("Weibull"), icon = NULL, br(), img(src = "https://images.plot.ly/language-icons/api-home/python-logo.png"))
),
plotOutput("plot")
)
server <- function(input, output, session) {
output$plot <- renderPlot({
par(mar=c(5,4,0,2)+0.1) # reduce space above Plot
curve(
weibSurv(x, shape=input$shape,scale=1/0.03),
from=0, to=80,
)
})
observeEvent(input$explainBtn, {
showModal(modalDialog("do something useful"))
})
}
shinyApp(ui, server)
答案2
得分: 0
以下是您要翻译的内容：
对于任何喜欢`renderUI`的人，这里有一个解决方案，尽管我更倾向于ismirsehregal的上面的`actionLink()`解决方案，因为它更清晰。
library(shiny)
library(survival)
### 在应用中定义的函数
weibSurv <- function(t, shape, scale) pweibull(t, shape=shape, scale=scale, lower.tail=FALSE)
ui <- fluidPage(
selectInput("distSelect", "选择分布:", c("Weibull", "Gamma")),
sliderInput('shape', '调整形状:', min=0, max=3, step=0.1, value=1.5),
uiOutput("plotHeader"),
fluidRow(plotOutput("plot"))
)
server <- function(input, output, session) {
output$plot <- renderPlot({
curve(
weibSurv(x, shape=input$shape, scale=1/0.03),
from=0,
to=80
)
})
output$plotHeader <- renderUI({
fluidRow(
align = 'center',
paste(input$distSelect),
tags$button(
id = "explainBtn",
class = "btn action-button",
tags$img(src = "https://images.plot.ly/language-icons/api-home/python-logo.png")
)
)
})
}
shinyApp(ui, server)
英文:
For anyone who favors renderUI, here's a solution though I would defer to ismirsehregal's actionLink() solution above as it is cleaner.
library(shiny)
library(survival)
### define functions used in App
weibSurv <- function(t, shape, scale) pweibull(t, shape=shape,scale=scale, lower.tail=F)
ui <- fluidPage(
selectInput("distSelect","Select distribution:",c("Weibull","Gamma")),
sliderInput('shape','Adjust shape:',min=0,max=3,step=0.1,value=1.5),
uiOutput("plotHeader"),
fluidRow(plotOutput("plot"))
)
server <- function(input, output, session) {
output$plot <- renderPlot({
curve(
weibSurv(x, shape=input$shape,scale=1/0.03),
from=0,
to=80
)
})
output$plotHeader <- renderUI({
fluidRow(
align = 'center',
paste(input$distSelect),
tags$button(
id = "explainBtn",
class = "btn action-button",
tags$img(src = "https://images.plot.ly/language-icons/api-home/python-logo.png")
)
)
})
}
shinyApp(ui, server)
通过集体智慧和协作来改善编程学习和解决问题的方式。致力于成为全球开发者共同参与的知识库，让每个人都能够通过互相帮助和分享经验来进步。
评论