寻找一种更合乎逻辑的方式来在闪亮的应用程序中表示 96 孔板的条件

Question

我有一张 96 孔板的俯视图，其中板的底部已制成透明。我最终想做的是，当我的 Shiny 应用程序的用户单击代表实验条件的某个按钮（这是某种颜色并标有条件名称）时，让单元格或列改变颜色，然后某个孔或列号上（见下文）。

我目前的想法是制作一个 HTML 表格并将其渲染在 96 孔板图像后面。一旦按下颜色选择按钮并选择某个表格单元格或列，这些单元格就会将背景更改为该颜色。我只是想确保我以尽可能最明智的方式处理这件事。这也将是用户为数据分析和图表制作目的向孔分配条件的方式。本质上，在分析脚本中为孔分配了一个条件，类似于下图所示。一旦 HTML 表格单元格更改为反映某种条件/颜色，R 脚本中相应的孔也将反映该条件（这是另一件“最终”的事情）。

# Add condition information specific to this experiment

sum_tab[, loc_id:=str_extract(location, "\\d{2}")]

sum_tab$loc_id = as.integer(sum_tab$loc_id)

sum_tab[, condition:="empty"]

sum_tab[loc_id %in% 1:12, condition:=paste("Wild Type")]
sum_tab[loc_id %in% 13:24, condition:=paste("3_fish_gse1_(-16/+)")]
sum_tab[loc_id %in% 25:36, condition:=paste("3_fish_cox8a (-75/+0)")]
sum_tab[loc_id %in% 37:48, condition:=paste("3_fish_fam171a1 (-10/+)")]
sum_tab[loc_id %in% 49:60, condition:=paste("3_fish_clec19a (-14/+)")]

简而言之，我的问题是：有没有办法调用 HTML 表格中各个单元格的标识？或者是否有一种更智能的方法来跟踪用于 Shiny 应用程序可视化目的的颜色，以及用于 R 脚本分析目的的条件标签？

我想我应该先问一下，然后再尝试花几个小时来弄清楚，然后可能会感到失望并不得不重新开始。

谢谢你！

Answer 1

这是一个非常有趣的问题，所以我花了2个小时让它100%看起来像你的图片：

library(shiny)
library(dplyr)
library(DT)

# funcs
plate96 <- function(id) {
    div(
        style = "position: relative; height: 500px",
        tags$style(HTML(
            '
        .wells {
            height: 490px;
            width: 750px;
            overflow: hidden;
            min-height: 20px;
            padding: 19px;
            margin-bottom: 20px;
            border: 1px solid #e3e3e3;
            border-radius: 4px;
            -webkit-box-shadow: inset 0 1px 1px rgb(0 0 0 / 5%);
            box-shadow: inset 0 1px 1px rgb(0 0 0 / 5%);
            position: relative;
            transform: translateX(50%);
        }
        
        .wells:after {
            content: "";
            height: 450px;
            width: 690px;
            border: 1px solid;
            position: absolute;
            transform: translate(15px, -100%);
            z-index: -1;
        }
        
        .wells .corner-top {
            position: absolute;
            margin: -20px;
            width: 43px;
            height: 34px;
            transform: rotate(45deg);
            background-color: white;
            z-index: 1;
            left: 30px;
            border-right: 1px solid;
        }
        
        .wells .corner-bot {
            position: absolute;
            margin: -20px;
            width: 40px;
            height: 40px;
            transform: rotate(45deg);
            background-color: white;
            z-index: 1;
            left: 35px;
            bottom: 20px;
            border-top: 1px solid;
        }
        
        .wells .html-widget {
            transform: translateX(20px);
        }
        
        .wells thead tr th {
            font-weight: 100;
        }
        
        .wells table:after {
            content: "";
            border: 1px solid #ccc;
            position: absolute;
            height: 410px;
            width: 635px;
            z-index: -1;
            transform: translate(33px, -99%);
        }

        .wells table.dataTable.no-footer {
            border-spacing: 3px;
            border-bottom: unset;
        }
        
        .wells table.dataTable thead th {
            border-bottom: unset;
        }
        
        
        .wells tbody tr td:not(:first-of-type) {
            border-radius: 50%;
            border: 1px solid black;
            height: 15px;
            width: 15px;
            padding: 15px;
            font-size: 0;
        }
        
        .wells table.dataTable.cell-border tbody tr td:first-of-type {
            border: unset;
            border-right: 1px solid #ccc;
            font-weight: 900;
        }
        '
        )),
        div(
            style = "position: absolute; left: 50%; transform: translateX(-100%);",
            div(
                class = "wells",
                div(class = "corner-top"),
                div(class = "corner-bot"),
                DT::dataTableOutput(id, width = "90%", height= "100%")
            )
        )
    )
}

renderPlate96 <- function(id, colors = rep("white", 96), byrow = TRUE) {
    stopifnot(is.character(colors) && length(colors) == 96)
    plate <- matrix(1:96, nrow = 8, ncol = 12, byrow = byrow, dimnames = list(LETTERS[1:8], 1:12))
    colnames(plate) <- stringr::str_pad(colnames(plate), 2, "left", "0")
    renderDataTable({
        datatable(
            plate,
            options = list(dom = 't', ordering = F),
            selection = list(target = 'cell'),
            class = 'cell-border compact'
        ) %>%
            formatStyle(
                1:12, 
                cursor = 'pointer', 
                backgroundColor = styleEqual(1:96, colors, default = NULL)
            )
    })
}

# app code
ui <- fluidPage(
    plate96("plate"),
    tags$b("Wells Selected:"),
    verbatimTextOutput("well_selected")
)

server <- function(input, output, session){
    output$plate <- renderPlate96(
        "plate",
        colors = c(
            rep("#eeeeee", 12),
            rep("#27408b", 12),
            rep("#0f8b44", 12),
            rep("#9400d3", 12),
            rep("#0701ff", 12),
            rep("white", 36)
        )
    )
    
    output$well_selected <- renderPrint({
        input$plate_cells_selected
    })
}



shinyApp(ui = ui, server = server)

1. plate96您所需要的只是在 UI 和renderPlate96服务器上使用。
2. 对于孔的颜色，您需要输入renderPlate96，colors参数需要正好96 种颜色作为向量。默认为全白色。
3. 您可以在同一个应用程序中拥有多个车牌。只需记住更改id.
4. 使用了很多 CSS 技巧，无法逐一解释。不懂的可以尝试搜索或者留言。

按栏目

    output$plate <- renderPlate96(
        "plate",
        colors = c(
            rep("#eeeeee", 8),
            rep("#27408b", 8),
            rep("#0f8b44", 8),
            rep("#9400d3", 8),
            rep("#0701ff", 8),
            rep("white", 56)
        ),
        byrow = FALSE
    )