为了显示变量名称，将图放大，但是，显示它们仍然很混乱（有超过 1000 个变量），所以我认为更好的选择是只显示工具提示和按组着色。
library(shiny)
library(DT)
library(data.table)
library(forcats)
library(ggplot2)
library(waiter)
library(plotly)
modalActionButton <- function(inputId, label, icon = NULL, width = NULL, ...) {
value <- restoreInput(id = inputId, default = NULL)
tags$button(id = inputId, type = "button", style = if (!is.null(width))
paste0("width: ", validateCssUnit(width), ";"), type = "button",
class = "btn btn-default action-button", `data-dismiss` = "modal", `data-val` = value,
list(shiny:::validateIcon(icon), label), ...)
}
# more realistic toy data which mimics your actual data
# we will transform it later
dat <- tibble::tribble(
~ID, ~num_express, ~dene, ~trans,
"id1", 6, ".", -1,
"id2", 3, ".", -1,
"id3", 7, ".", -1,
"id4", 7, ".", -1,
"id5", 4, ".", -1) %>%
tidyr::expand_grid(group = letters[1:3],
no = 1:100) %>%
dplyr::mutate(var_nm = paste0(group, "_dd_s.", no),
var_val = round(runif(1500, min = 0, max = 99), 0)) %>%
tidyr::pivot_wider(.,
id_cols = c(ID, num_express, dene, trans),
names_from = var_nm,
values_from = var_val)
dat <- as.data.table(dat)
# data preparation no using {data.table} starts here
# before starting the data preparation with your real data
# save it as .csv and it read in at the start of the app with
# `dat <- fread("yourdata.csv")`
dat_dt <- dat[, -c(2:4), with=FALSE]
dat_dt <- melt(dat_dt,
id.vars = "ID",
variable.name = "col_nm",
value.name = "val")
dat_dt[, c("group", "col_nm1", "col_nm2", "col_no") := tstrsplit(col_nm, "[\\._]")
][,
ttip := paste0("var: ", col_nm, "<br>",
"value: ", val)
][,
col_nm := as.factor(col_nm)
]
shinyApp(
ui = fluidPage(
use_waiter(),
# make modal page wider
tags$head(
tags$style(HTML("
.modal-dialog {
width: 80%;
}
"))
),
DT::dataTableOutput('table')
), # close FluidPage
server = function(input, output, session) {
w <- Waiter$new(id = "plot",
html = spin_whirly(),
color = "#FFFFFF")
output$table <- DT::renderDataTable({
datatable(dat[, .(ID, num_express, dene, trans)],
rownames = FALSE,
selection = 'none',
# get ID of clicked row
callback = JS(
'table.on("click.dt","tr", function() {
var data=table.row(this).data();
Shiny.onInputChange("rows",data[0]);
});')
)
})
data_row <- reactive({
dat_dt[ID == input$rows & val != 0,]
})
flag <- reactiveValues(val = 0)
observeEvent(input$close, {
flag$val <- flag$val - 1
})
observeEvent(input$rows, {
flag$val <- flag$val + 1
})
temp_plot <- reactive({
w$show()
if (flag$val == 0) {
p <- plotly_empty() %>% config(displayModeBar = FALSE,
displaylogo = FALSE)
} else {
p <- ggplot(data_row(),
aes(x = fct_reorder(col_nm, val, min, .desc = TRUE),
y = val,
fill = group
)) +
geom_col(position = "dodge") +
scale_y_continuous(expand = c(0,0)) +
theme(axis.text.x = element_blank(),
axis.ticks.x = element_blank())
p <- ggplotly(p)
}
w$hide()
p
})
output$plot <- renderPlotly({
print(flag$val)
temp_plot()
})
observeEvent(input$rows, {
showModal(modalDialog(
title = paste("Plot:", input$rows),
plotlyOutput("plot",
width = "100%"),
size = "l",
easyClose = FALSE,
footer = modalActionButton("close",
"Close")
))
})
}
)