这是一个工作示例。这里的目的是在下拉菜单中向用户显示调色板中的颜色(而不仅仅是调色板名称)。这里下拉菜单中的图像是在运行时创建的。这可能是可取的,也可能不是可取的。如果下拉菜单中的图像永远不会改变(即静态),请参阅 SeGa 的答案。
这是从here 显示的示例修改而来的。
ui.R文件
## UI.R
fluidPage(
title='Plots in Selectize Input',
tags$h2('Plots in Selectize Input'),
fluidRow(
column(4,
selectizeInput('palette',label="Palette",choices=NULL,options=list(
placeholder='Select a colour palette',maxOptions=4)
)),
column(8,
plotOutput('plot')
)
)
)
server.R文件
## SERVER.R
library(ggplot2)
data(diamonds)
len <- length(levels(diamonds$cut))
clist <- list("rainbow"=rainbow(len),"topo"=topo.colors(len),
"terrain"=terrain.colors(len),"cm"=cm.colors(len))
function(input,output,session) {
paletteurl <- session$registerDataObj(
name='uniquename1',
data=clist,
filter=function(data,req) {
query <- parseQueryString(req$QUERY_STRING)
palette <- query$palette
cols <- clist[[palette]]
image <- tempfile()
tryCatch({
png(image,width=100,height=50,bg='transparent')
par(mar=c(0,0,0,0))
barplot(rep(1,length(cols)),col=cols,axes=F)
},finally = dev.off())
shiny:::httpResponse(
200,'image/png',readBin(image,'raw',file.info(image)[,'size'])
)
}
)
updateSelectizeInput(
session,'palette',server=TRUE,
choices=names(clist),
selected=1,
options=list(render=I(sprintf(
"{
option: function(item, escape) {
return '<div><img width=\"100\" height=\"50\" ' +
'src=\"%s&palette=' + escape(item.value) + '\" />' +
escape(item.value) + '</div>';
}
}",
paletteurl
)))
)
output$plot <- renderPlot({
shiny::req(input$palette)
cols <- clist[[input$palette]]
ggplot(diamonds,aes(x=carat,y=price,colour=cut))+
geom_point()+
scale_colour_manual(values=cols)+
theme_minimal(base_size=18)
})
}
如果有人更好地理解这一点,欢迎您改进/更新此答案。甚至添加另一个答案以显示不同的用法。