只有1个数据点时,热图R的自定义colorRamp

时间:2018-01-11 17:50:26

标签: r shiny plotly

所以我需要几个热图并且不要过度拥挤我的应用程序我将它们分成更小的热图。问题是我无法将颜色显示在颜色条上。我做了一个自定义的colorRamp并使用了zmin和zmax,但它无法正常工作。有人可以告诉我该怎么做,我已经在网上搜索了一段时间而没有。帮助是有责任的。

library(shiny)
library(plotly)
data<-data.frame(Start_Period=c("Early Afternoon"),Meeting_Days=c("MTWR"),Average=c(23))


    ui <-fluidPage(
      plotlyOutput("test")
    )

    server <- shinyServer(function(input, output, session) {
      output$test<-renderPlotly({

        plot_ly(data,
                x = data$Meeting_Days, y =data$Start_Period,
                z = data$Average, type = "heatmap",
                hoverinfo='text',
                zauto=FALSE,
                zmin=0,
                zmax=80,
                colorbar=list(
                  title='Average Enrollment'
                ),
                colors = colorRamp(c('#700001',
                                     '#c10001',
                                     '#eff6ff',
                                     '#9ae7f3',
                                     '#1D7DBB')),
                text=paste("Average Enrollment:",data$Average_Enrollment)
        )%>%layout(margin=list(l = 110,pad = 2 ))
      })  

    })

    shinyApp(ui = ui, server = server)

这是我正在使用的一个例子,理想情况下我希望colorbar拥有colorRamp中的所有颜色,并且热图可以跟随它。它所选择的颜色是#eff6ff,它是中间的,不注意其余部分。

1 个答案:

答案 0 :(得分:0)

我尝试使用ggplotly并出现同样的问题。所以也许你可以欺骗它。您可以在if else参数中添加renderPlotly({})语句。如果行数为1,您可以添加一个非常小的行代替平均值(我将1替换为23)。希望能帮助到你!

ui <-fluidPage(
  plotlyOutput("test")
)

server <- shinyServer(function(input, output, session) {
  output$test<-renderPlotly({

    if (nrow(data) <= 1) {

      data2 <- data
      data3 <- rbind(data, data2)
      data3[2, 3] <- 1

    } else  {

      data3 <- data

    } 


    plot_ly(data3,
            x = ~Meeting_Days, y =~Start_Period,
            z = ~Average, type = "heatmap",
            hoverinfo='text',
            zauto=FALSE,
            zmin=0,
            zmax=80,
            colorbar=list(
              title='Average Enrollment'
            ),
            colors = colorRamp(c('#700001',
                                 '#c10001',
                                 '#eff6ff',
                                 '#9ae7f3',
                                 '#1D7DBB')),
            text=paste("Average Enrollment:",data$Average_Enrollment)
    )%>%layout(margin=list(l = 110,pad = 2 ))

  })  

})

shinyApp(ui = ui, server = server)