RShiny中的表格的條件格式

我試圖想象一個隊列分析，並且想用閃亮的RenderDataTable來獲得這種類型的可視化，其中我可以基於單獨的列來突出顯示所有單元格值1/0，其中1表示陰影，0表示沒有陰影。RShiny中的表格的條件格式

我試了幾件事情，其中包括試圖ggplot2使用geom_tile，但它是沒有用的。我也試過看rpivotTable，但我無法弄清楚如何遮蔽某些細胞。

示例數據：

df <- " 
cohort wk value flag 
1 1 24 0 
1 2 12 0 
1 3 10 0 
1 4 5 0 
1 5 2 0 
2 1 75 0 
2 2 43 1 
2 3 11 0 
2 4 14 0 
3 1 97 0 
3 2 35 0 
3 3 12 1 
4 1 9 0 
4 2 4 0 
5 1 5 0" 

df <- read.table(text = df, header = TRUE)

來源

2015-08-08 Karthik g

你能提供一個最小[重複的例子（http://stackoverflow.com/questions/5963269/how-to-make-a-great-r-reproducible-example）？您的示例圖像沒有0/1列，它有陰影的單元格，而不是行。它是否真的代表您的預期產出？ – Molx

感謝@Molx，根據您的意見進行了編輯 –

@Karthikg最好的是使用DT（使用數據表JS庫）。它允許使用條件格式。 – Enzo

這應該讓你在創建情節開始ggplot2：

library(ggplot2) 

ggplot(df, aes(x = wk, y = cohort, fill = factor(flag))) + 
    geom_tile(color = "white") + 
    geom_text(aes(label = value), color = "white") + 
    scale_y_reverse()

呈現閃亮的情節應該是微不足道的。既然你有沒有提供任何閃亮的代碼（例如服務器或用戶界面），很難說哪裏可以遇到問題。

來源

2015-10-28 19:20:56 JasonAizkalns

如果你要的顏色數據表中，你可以做這樣的：

require(plyr) 

# Create matrix 
m.val <- max(unlist(lapply(unique(df$cohort),function(ch){ length(which(df$cohort==ch)) }))) 
cohort.df <- do.call(rbind, lapply(unique(df$cohort),function(ch){ 
    v <- df$value[which(df$cohort==ch)] 
    c(v,rep(NA,m.val-length(v))) 
    })) 

ui <- fluidPage(
    tags$head(
    tags$script(
     HTML(" 
     Shiny.addCustomMessageHandler ('colorTbl',function (message) { 
      console.log(message.row); 
      var row = parseInt(message.row); var col = parseInt(message.col); 
      $('#tbl').find('tbody').find('tr').eq(row).find('td').eq(col).css('background',message.color); 
     }); 
      ") 
    ) 
), 
    dataTableOutput("tbl") 
) 

color <- "#6CAEC4" 
server <- function(input, output, session) { 
    colorTbl <- function(){ 
    # Get rows we want to color 
    sel.d <- df[df$flag==1,] 
    for(i in 1:nrow(sel.d)){ 
     row <- as.numeric(sel.d[i,sel.d$cohort]) -1 
     col <- as.numeric(sel.d[i,sel.d$wk]) - 1 
     session$sendCustomMessage(type = 'colorTbl', message = list(row=row,col=col,color=color)) 
    } 
    } 

    output$tbl <- renderDataTable({ 
    # Wait until table is rendered, then color 
    reactiveTimer(200,{colorTbl()}) 
    as.data.frame(cohort.df) 
    }) 
} 

runApp(shinyApp(ui,server))

這裏我使用jQuery顏色根據您的條件的行。

來源

2015-10-29 21:38:38

隨着DT-package：

＃global.R

library(shiny) 
library(DT) 

sketch = htmltools::withTags(table(
    class = 'display', 
    thead(
     tr(
     th(rowspan = 2, ''), 
     th(rowspan = 2, 'Cohort'), 
     th(colspan = 10, 'Wk') 
     ), 
     tr(lapply(paste(c('', 'f'), rep(1:5, each=2), sep=''), th)) 
    ) 
))

＃ui.R

shinyUI(fluidPage(DT::dataTableOutput(outputId="table")))

＃server.R

shinyServer(function(input, output, session) { 
    output$table <- DT::renderDataTable({ 
     df$flag <- as.factor(df$flag) 
     x <- reshape(df, timevar = 'wk', sep = '_', direction = 'wide',idvar ='cohort') 
     row.names(x) <- NULL 
     colnames(x)[-1] <- paste(c('', 'f'), rep(1:5, each = 2), sep = '') 
     datatable(x, rownames = T, container = sketch, 
      options = list(dom = 'C<"clear">rti', pageLength = -1, 
         columnDefs = list(list(visible = F, targets = c(3,5,7,9,11)))) 
    )%>% 
     formatStyle('1', 'f1', backgroundColor = styleEqual(c(0, 1), c('white','lightblue'))) %>% 
     formatStyle('2', 'f2', backgroundColor = styleEqual(c(0, 1), c('white','lightblue'))) %>% 
     formatStyle('3', 'f3', backgroundColor = styleEqual(c(0, 1), c('white','lightblue'))) %>% 
     formatStyle('4', 'f4', backgroundColor = styleEqual(c(0, 1), c('white','lightblue'))) %>% 
     formatStyle('5', 'f5', backgroundColor = styleEqual(c(0, 1), c('white','lightblue'))) 
    }) 
})

來源

2015-11-03 21:22:28 user5029763

RShiny中的表格的條件格式

回答

相關問題