我的目标是生成一个选定颜色代码的文本列表，例如shiny中的"#A020F0", "#864BAB", "#4BFF14"。我正在使用colourpicker包中的拾色器。我想要的是，每当用户选择一种颜色并按下按钮时，最终选择的颜色的代码就会附加到文本中。
library(shiny)
library(colourpicker)
library(devtools)
ui <- fluidPage( colourInput("col", "Select colour", "purple"),
numericInput(inputId='x', label="colors", value=3, min=1, step=1)
,actionButton(inputId='OK', label="enter color"),
textOutput("couleurs"))
server <- function(input, output) {
output$couleurs<-renderText({
v='"'
t=''
for (k in c(1:input$x)) {
if(input$OK){
t=input$col
}
v=paste(v,t,',"')
}
return(v)
})
}
shinyApp(ui = ui, server = server)
我收到以下错误：cannot coerce type 'closure' to vector of type 'character'
答案 0 :(得分：0)
您可能想使用reactiveValues和observeEvent。
library(shiny)
library(colourpicker)
ui <- fluidPage(
colourInput('col', 'Select colour', 'purple'),
actionButton(inputId = 'OK', label = 'enter color'),
textOutput('couleurs')
)
server <- function(input, output) {
values <- reactiveValues(col_string = '')
observeEvent(input$OK, {
if (values$col_string == '') {
values$col_string <- paste0('"', input$col, '"')
} else {
values$col_string <- paste0(values$col_string, ', ', paste0('"', input$col, '"'))
}
})
output$couleurs <- renderText({ values$col_string })
}
shinyApp(ui = ui, server = server)
这是在sankey网络中使用选定颜色的示例。就像我在评论中说的，您将必须使用paste0或sep = ""的{{1}}参数，以便合并成paste的元素不会被分隔空间。这就是为什么我问您粘贴命令的输出是什么的原因。注意这两个命令及其输出之间的区别...
colorJS这是最小的可复制示例（不需要专门格式化的Excel电子表格，只有您可以访问它）...
domain <- '"one", "two", "three"'
col_string <- '"#382743", "#916402", "#064713"'
paste('d3.scaleOrdinal().domain([', domain, '])', '.range([', col_string, '])')
# d3.scaleOrdinal().domain([ "one", "two", "three" ]) .range([ "#382743", "#916402", "#064713" ])
paste0('d3.scaleOrdinal().domain([', domain, '])', '.range([', col_string, '])')
# d3.scaleOrdinal().domain(["one", "two", "three"]).range(["#382743", "#916402", "#064713"])
答案 1 :(得分：0)
这是一个完整的可复制应用程序
library(shiny)
library(networkD3)
library(openxlsx)
library(colourpicker)
library(devtools)
library(readr)
ui <- fluidPage(
tabsetPanel(
tabPanel("Data", fileInput("myData", "Upload your data "),
helpText(h6("Default max. file size is 5MB")),
uiOutput("tb")),
tabPanel("Display graph", flowLayout(
flowLayout( verticalLayout(sliderInput(inputId ='x',label = "Font size",min = 8,max = 24,value = 11,step = 1),
sliderInput(inputId ='y',label = "Graph size",min = 12,max = 20,value = 20,step = 2)
),verticalLayout(textOutput("codec"),
colourInput("col", "Select colour", "purple"),
actionButton(inputId = 'OK', label = 'enter color'))
),
verticalLayout(textInput("domaine","Group names "),
textInput("couleur","Group colors","'blue','#1FF22A','pink','#EFFC00','red'"),
helpText("* Same order of group names as",'"1600D9","red"#F7F705"')
),
uiOutput("sankey",position="right"))),
tabPanel("Summary", uiOutput("s")))
)
server <- function(input, output) {
#read links data
data <- reactive({
file1 <- input$myData
if (is.null(file1)) {
return(NULL)
}
read.xlsx(file1$datapath,startRow = 2,sheet = 1,colNames = TRUE,cols =1:6)
})
#about data
output$filedf <- renderTable({
if (is.null(data())) {
return ()
}
input$myData
})
output$s <- renderUI({
if (is.null(data()))
h1("Check your file!", align='center'
)
else
tabsetPanel(
tabPanel("Source", tableOutput("from")),
tabPanel("Target", tableOutput("to")),
tabPanel("Value", tableOutput("weight"))
)
})
#summary data
output$from <- renderTable({
if (is.null(data())) {
return ()
}
x <- reactive({
file1 <- input$myData
if (is.null(file1)) {
return(NULL)
}
read.xlsx(file1$datapath,startRow = 2,sheet = 1,colNames = TRUE,cols =2)
})
summary(x())
})
output$to <- renderTable({
if (is.null(data())) {
return ()
}
x <- reactive({
file1 <- input$myData
if (is.null(file1)) {
return(NULL)
}
read.xlsx(file1$datapath,startRow = 2,sheet = 1,colNames = TRUE,cols =4)
})
summary(x())
})
output$weight <- renderTable({
if (is.null(data())) {
return ()
}
x <- reactive({
file1 <- input$myData
if (is.null(file1)) {
return(NULL)
}
read.xlsx(file1$datapath,startRow = 2,sheet = 1,colNames = TRUE,cols =5)
})
summary(x())
})
#display data table
output$table <- renderTable({
if (is.null(data())) {
return ()
}
data()
})
#read nodes data
label <- reactive({
file1 <- input$myData
if (is.null(file1)) {
return(NULL)
}
read.xlsx(file1$datapath,startRow = 2,sheet = 1,colNames = TRUE,cols = 7:8)
})
values <- reactiveValues(col_string = '')
observeEvent(input$OK, {
if (values$col_string == '') {
values$col_string <- paste0('"', input$col, '"')
} else {
values$col_string <- paste0(values$col_string, ', ', paste0('"', input$col, '"'))
}
})
output$couleurs <- renderText({ values$col_string })
output$splot <- renderSankeyNetwork({
colorJS <- paste('d3.scaleOrdinal().domain([',input$domaine,'])','.range([',couleurs,'])')
sankeyNetwork(
Links = data(),
Nodes = label(),
Source = 'i',
Target = 'j',
Value = 'value',
NodeID = "name",
fontSize = input$x,
nodeWidth =0.6*input$x,
NodeGroup = "ngroup", LinkGroup = "lgroup"
,colourScale = colorJS
)
})
#render demanded outputs
output$tb <- renderUI({
if (is.null(data()))
h3("Watch me - Tutorial",br(),tags$video(src='Sankey.mp4',type="video/mp4",width="720px",height="450px",controls="controls"),align="center")
else
tabsetPanel(
tabPanel("About file", tableOutput("filedf")),
tabPanel("Data",tableOutput("table"))
)
})
output$codec<-renderText({paste("Code:",input$col)})
output$sankey <- renderUI({
if (is.null(data()))
h1("Check your file!", align='center'
)
else
sankeyNetworkOutput("splot",width = 46*input$y,height = 23*input$y)
})
}
shinyApp(ui = ui, server = server)