Я пытаюсь распечатать сетку тепловых карт, используя заговор для R в Shiny. Я хочу дать им собственную цветовую гамму, но она ведет себя не так, как я хочу. Когда я используюцвета = Опция при построении моей графической диаграммы, кажется, использует распределение значений, а не zmin и zmax, которые я дал, чтобы назначить цвета.

В приведенном ниже примере кода вы можете видеть, что я назначаю каждому графику одну и ту же цветовую шкалу (colorScale), используя параметр colors =. Это работает так, как я ожидаю, когда у меня есть хорошо распределенный набор данных, как в первом, втором и четвертом ряду графиков.

Тем не менее, в третьем ряду, где графики имеют очень искаженные данные, вы можете видеть, что весы выглядят иначе, чем все остальное - они имеют синий и красный цвета, но пропускают белый в середине, вместо фиолетового.

В моем реальном коде это вызывает большую проблему для диаграммы, у которой много значений в середине, с некоторыми крайностями на обоих концах - я хочу, чтобы эти значения в середине выглядели белыми, чтобы показать, что изменений не было, но вместо этого они фиолетового цвета, что затрудняет выделение важных ценностей (крайних).

Есть ли способ заставить цветовое назначение вести себя так, как я хочу?

Спасибо Клифф

server.R

if (!require("pacman")) install.packages("pacman")

pacman::p_load(shiny,data.table,plotly)


colorScale <- colorRamp(c("darkblue","cornflowerblue","white","sandybrown","firebrick"))

nCodeNames <- c("a","b","c","d","e","f","g","h","i","j","k","l")
means = c(rnorm(600,0,2.5),runif(600,-5,5),runif(130,-4,-3.9),runif(70,4.5,5),rnorm(150,-3),rnorm(50,4),rnorm(180,-2.5),runif(20,4.93,4.98),runif(300,-4,3),rnorm(300,3.5))



dt <- data.table(age=rep(rep(c(11:20),times=20),times=12),composite=rep(rep(c(81:100),each=10),times=12),mean=means,n_code=rep(nCodeNames,each=200))

sub<-dt[n_code=="a"]

shinyServer(function(input, output) {

for(Ncode in nCodeNames){
  local({
    ncode = Ncode
    output[[paste0("grid",ncode)]] <- renderPlotly({
      sub <- dt[n_code == ncode]
      p <- plot_ly(data=sub, x=~age, y=~composite, z=~mean, type="heatmap", zmin=-5,zmax=5, 
                   colors = colorScale, colorbar=list(thickness="15"))%>%
           layout(title=ncode,xaxis=list(type="category",tickvals=c(11,15,20)),yaxis=list(title="",ticks=""))
    })
  })
}
})

ui.R

if (!require("pacman")) install.packages("pacman")

pacman::p_load(shiny, plotly)

nCodeNames <- c("a","b","c","d","e","f","g","h","i","j","k","l")


shinyUI(navbarPage(
  "E-N Matrics: Proportion of E-Code Resulting in each N-Code",

  tabPanel("Grid",

            lapply(c(1:4), function(i) fluidRow(
              lapply(c(1:3), function(j) column(4, plotlyOutput(paste0("grid",nCodeNames[(i-1)*3+j]))))
             ))

           #fluidRow(column(4,plotlyOutput(paste0("grid",nCodeNames[(1-1)*3+1]))),column(4,plotly))
  )
  ))