问题
In my shiny app I filter the heatmaps with a selectinput to show them in tab1. Everything is working fine. But, I have tried to get a uniform size a.) of the different heatmaps (all should have the same overall size and all should have same tile size), and b.) to align the heatmaps on the left side (actually it is centered). I am not able to get behind the issue, although I went through the online explanations. Thanks for your help.
My code:
global.R
# global.R
library(shiny)
library(ggplot2)
library(dplyr)
# construct the dataframe
df <- data.frame(
test_id = c(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 4, 4, 4, 4, 4, 4, 4, 4),
test_nr = c(1, 1, 1, 1, 2, 2, 2, 2, 3, 3, 3, 3, 4, 4, 4, 4, 5, 5, 5, 5,
1, 1, 1, 1, 2, 2, 2, 2, 3, 3, 3, 3, 1, 1, 1, 1, 2, 2, 2, 2),
region = c("A", "B", "C", "D", "A", "B", "C", "D", "A", "B", "C", "D", "A",
"B", "C", "D", "A", "B", "C", "D", "A", "B", "C", "D", "A", "B",
"C", "D", "A", "B", "C", "D", "A", "B", "C", "D", "A", "B", "C", "D"),
test_value = c(3, 1, 2, 2, 2, 1, 2, 2, 3, 2, 2, 3, 2, 1, 2, 2, 1, 2, 3,
4, 2, 1, 1, 2, 1, 1, 1, 1, 2, 2, 3, 2, 2, 2, 99, 99, 3, 3, 3, 3)
)
# named vector for heatmap
cols <- c("1" = "green",
"2" = "darkgreen",
"3" = "orange",
"4" = "red",
"99" = "black")
labels_legend <- c("1" = "Complete response",
"2" = "Major response",
"3" = "Minor response",
"4" = "No response",
"99" = "NA")
ui.R
# Define UI ----
ui <- fluidPage(
tags$style(HTML("
.tabbable > .nav > li > a {background-color: aqua; color:black; width: 300PX;}
")),
# App title ----
titlePanel("TEST HEATMAP"),
# Sidebar layout with input and output definitions ----
sidebarLayout(
# Sidebar panel for inputs ----
sidebarPanel(width = 2,
# Input: Select the id ----
selectInput(inputId = "test_id",
label = "Test ID",
choices = df$test_id,
selected = NULL)
),
# Main panel for displaying outputs ----
mainPanel(width = 10,
# Output: Tabset plot, ----
tabsetPanel(type = "tabs",
tabPanel("tab1",
plotOutput("test_plot")
),
tabPanel("tab2",
),
tabPanel("tab3",
)
)
)
)
)
server.R
shinyServer(function(input, output,session) {
var_testid <- reactive({input$test_id})
output$test_plot <- renderPlot({
req(var_testid())
df <- df %>%
filter(test_id == as.integer(var_testid())) # filter testid
ggplot(
df,
aes(region, test_nr)) +
geom_tile(aes(fill= factor (test_value))) +
geom_text(aes(label = test_value), size = 10, color = "white") + # text in tiles
scale_colour_manual(
values = cols,
breaks = c("1", "2", "3", "4", "99"),
labels = labels_legend,
aesthetics = c("colour", "fill")
) +
theme(text = element_text(size = 14)) + # this will change all text size
labs(title = "Test (Individual heatmap)", x = "Region", y = "Event") +
labs(fill = "Test") +
coord_fixed(ratio=1, clip="on") +
theme(axis.text.y = element_text(face = "bold", size = 12)) +
theme(axis.text.x = element_text(angle = 0, face = "bold", size = 12)) +
theme(axis.line = element_line(colour = "darkblue",
size = 1, linetype = "solid")
)
})
})
来源:https://stackoverflow.com/questions/64959014/r-shiny-ggplot2-heatmap-uniform-size-of-plots-and-align-left