使用 ggvis 绘制数据框的子集时如何使填充颜色一致
How to make fill color consistent when plotting subsets of a dataframe with ggvis
每当根据这些因素重新绘制数据时，我试图使 ggvis 图中的颜色保持一致（不幸的是，我显然缺乏足够的声誉来包含图片来向您展示）。
我只能找到另一个 post 关于这个 controlling-color-of-factor-group-in-ggvis-r 但他的 none 解决方案或变通方法适用于我的情况。
我的数据是这样的：
month year date entity_name prefix module module_entry_key entity_table_name count
0 January 2011 2011.000 AbLibrary LIB Base BS AB_LIBRARY 0
1 February 2011 2011.083 AbLibrary LIB Base BS AB_LIBRARY 0
2 March 2011 2011.167 AbLibrary LIB Base BS AB_LIBRARY 0
3 April 2011 2011.250 AbLibrary LIB Base BS AB_LIBRARY 0
4 May 2011 2011.333 AbLibrary LIB Base BS AB_LIBRARY 0
5 June 2011 2011.417 AbLibrary LIB Base BS AB_LIBRARY 0
3000 January 2011 2011.000 Vector VEC Base BS VECTOR 0
3001 February 2011 2011.083 Vector VEC Base BS VECTOR 0
3002 March 2011 2011.167 Vector VEC Base BS VECTOR 0
3003 April 2011 2011.250 Vector VEC Base BS VECTOR 569
3004 May 2011 2011.333 Vector VEC Base BS VECTOR 664
3005 June 2011 2011.417 Vector VEC Base BS VECTOR 775
我正在使用闪亮的应用程序在浏览器中显示页面，相关代码是：
# render the plot, filtering for entities within the module minus any entities selected from the exclude panel
plot <- reactive({
if (input$filter==1){
data <- dplyr::filter(.data=melted, module_entry_key %in% input$module)
}
else{
data <- dplyr::filter(.data=melted, entity_name == input$entity)
}
data <- dplyr::filter(.data=data, !entity_name %in% input$excluded)
data$entity_name <- factor(data$entity_name)
data %>%
ggvis(x = ~date, y = ~count, fill = ~entity_name, key := ~id, fillOpacity := 0.5, fillOpacity.hover := 0.9) %>%
add_legend("fill", title="Entities") %>%
layer_points() %>%
add_tooltip(tooltipText, "hover") %>%
add_axis("y", title = "Count", title_offset = 50) %>%
add_axis("x", title="Date", title_offset=50, subdivide=6, tick_size_minor=3, format=parseDate(~year, ~month))
})
过滤器正在根据 UI 中的过滤器将 "melted" 的子集创建为 "data"（见图）
因为据我所知，每当我制作新的数据子集时，都无法将填充颜色与一个因素（实体名称）显式相关联，并且颜色是按因素的字母顺序选择的颜色改变了。
有什么办法解决这个问题吗？
（完整的闪亮代码）
server.R
library(ggvis)
library(shiny)
library(dplyr)
shinyServer(function(input, output, session){
modules_list <- as.character(c("Base" = "BS",
"Screening" = "SC",
"Protein Engineering" = "EN",
"Protein Production" = "PP",
"CD",
"PT",
"PD"))
#melted <- read.table(file="~/dataOut.txt", sep="\t", strip.white=TRUE, row.names=1, header=TRUE);
modules <- as.character(as.vector(unique(melted$module_entry_key)))
modules <- modules[modules != "null"]
entities <- as.character(as.vector(unique(melted$entity_name)))
entities <- entities[entities != "null"]
for (i in entities){
melted <- rbind(melted, data.frame(month=NA, year=NA, date=NA, entity_name=i, prefix=NA, module=NA, module_entry_key=NA, entity_table_name=NA, count=NA))
}
melted$id <- 1:nrow(melted)
#create ui checkbox for modules in the data
output$module_list <- renderUI({
checkboxGroupInput(inputId = "module",
label = "Module",
choices = modules,
selected = "BS")
})
#create the ui list for entities
output$entity_list <- renderUI({
checkboxGroupInput(
inputId = "entity",
label = "Entity",
choices = entities,
selected = "Vector"
)
})
#ex <- entities
#create the checkboxGroupInput with entities to 'exclude'
output$exclusion_entities <- renderUI({
checkboxGroupInput(inputId = "excluded", label = "Exclude",
choices = entities)
})
#update the excluded entities list with entities within a particular module
observe({
if (input$filter==1)
ex1 <- as.character(as.vector(unique(dplyr::filter(.data=melted, module_entry_key %in% input$module)$entity_name)))
updateCheckboxGroupInput(session, inputId = "excluded", "Exclude", choices=ex1, selected = input$excluded )
})
# render the plot, filtering for entities within the module minus any entities selected from the exclude panel
plot <- reactive({
if (input$filter==1){
data <- dplyr::filter(.data=melted, module_entry_key %in% input$module)
}
else{
data <- dplyr::filter(.data=melted, entity_name == input$entity)
}
data <- dplyr::filter(.data=data, !entity_name %in% input$excluded)
data$entity_name <- factor(data$entity_name)
data %>%
ggvis(x = ~date, y = ~count, fill = ~entity_name, key := ~id, fillOpacity := 0.5, fillOpacity.hover := 0.9) %>%
add_legend("fill", title="Entities") %>%
layer_points() %>%
add_tooltip(tooltipText, "hover") %>%
add_axis("y", title = "Count", title_offset = 50) %>%
add_axis("x", title="Date", title_offset=50, subdivide=6, tick_size_minor=3, format=parseDate(~year, ~month))
})
#function to add color and mouse-over effect to layer_points() (unused in this code)
points <- reactive({
layer_points(fillOpacity := 0.5, fillOpacity.hover := 1, fill.hover := "red")
})
#d3 date format for formatting x-axis text
parseDate <- function(year, month){
paste("d3.time.format(\"%Y\").parse(", year, ")", sep="")
}
#function for what to display in mouse-hover tooltip
tooltipText <- function(x) {
if(is.null(x)) return(NULL)
row <- melted[melted$id == x$id, ]
paste(row$entity_name, ": ", row$count, sep="")
}
#bind the plot to the UI
plot %>% #layer_points(fill = ~factor(entity_name)) %>%
bind_shiny("ggvis")
#select all button for modules
observe({
if (input$selectall ==0){
return(NULL)
}
else if ((input$selectall%%2)==0){
updateCheckboxGroupInput(session, inputId = "module", "Module", choices = modules)
}
else{
updateCheckboxGroupInput(session, inputId = "module", "Module", choices=modules, selected=modules)
}
})
#select all button for excluded entities
observe({
list <- as.character(as.vector(unique(dplyr::filter(.data=melted, module_entry_key %in% input$module)$entity_name)))
if (input$exclude_all ==0){
return(NULL)
}
else if ((input$exclude_all%%2)==0){
updateCheckboxGroupInput(session, inputId = "excluded", "Exclude", choices=list )
}
else{
updateCheckboxGroupInput(session, inputId = "excluded", "Exclude", choices=list, selected=list )
}
})
#---general output / debugging stuff ----#
output$table <- renderTable({dataInput()})
output$entity_selected = renderPrint({
list <- as.character(as.vector(unique(dplyr::filter(.data=melted, module_entry_key %in% input$module)$entity_name)))
entities[!entities %in% input$excluded & entities %in% list]
})
output$filter_value = renderPrint({input$filter})
output$modules = renderPrint({input$module})
output$link = renderPrint(input$selectall%%2)
#----------------------------------------#
})
ui.R
library(shiny)
shinyUI(fluidPage(
titlePanel("DB Analysis"),
sidebarLayout(
sidebarPanel(
width=3,
radioButtons(inputId="filter",
label="Filter",
choices = list("By Module" = 1, "By Entity" = 2),
selected = 1),
conditionalPanel(condition = "input.filter == 1",
uiOutput("module_list"),
actionButton("selectall", "Select All"),
uiOutput("exclusion_entities"),
actionButton("exclude_all", "Select All")
),
conditionalPanel(condition = "input.filter == 2",
uiOutput("entity_list")
)
),
mainPanel(
h2("Cumulative Entity Counts over Time (years)", align="center"),
#verbatimTextOutput("value"),
#verbatimTextOutput("filter_value"),
#verbatimTextOutput("modules"),
#tableOutput("table"),
ggvisOutput("ggvis"),
verbatimTextOutput("link"),
verbatimTextOutput("entity_selected")
#textOutput("entities_plot")
)
)
)
)
这可能是最好的方法。尝试这样的事情：
df[which(df$entity_name == "AbLibrary"),]$color <- "FF0000"
df[which(df$entity_name == "Vector"),]$color <- "#FFB90F"
对于数据框中的每一个。然后每次都将填充设置为颜色。唯一的问题是试图创造一个传奇。 （我一直在努力弄清楚，所以如果我找到它，我会编辑这个 post。
每当根据这些因素重新绘制数据时，我试图使 ggvis 图中的颜色保持一致（不幸的是，我显然缺乏足够的声誉来包含图片来向您展示）。
我只能找到另一个 post 关于这个 controlling-color-of-factor-group-in-ggvis-r 但他的 none 解决方案或变通方法适用于我的情况。
我的数据是这样的：
month year date entity_name prefix module module_entry_key entity_table_name count
0 January 2011 2011.000 AbLibrary LIB Base BS AB_LIBRARY 0
1 February 2011 2011.083 AbLibrary LIB Base BS AB_LIBRARY 0
2 March 2011 2011.167 AbLibrary LIB Base BS AB_LIBRARY 0
3 April 2011 2011.250 AbLibrary LIB Base BS AB_LIBRARY 0
4 May 2011 2011.333 AbLibrary LIB Base BS AB_LIBRARY 0
5 June 2011 2011.417 AbLibrary LIB Base BS AB_LIBRARY 0
3000 January 2011 2011.000 Vector VEC Base BS VECTOR 0
3001 February 2011 2011.083 Vector VEC Base BS VECTOR 0
3002 March 2011 2011.167 Vector VEC Base BS VECTOR 0
3003 April 2011 2011.250 Vector VEC Base BS VECTOR 569
3004 May 2011 2011.333 Vector VEC Base BS VECTOR 664
3005 June 2011 2011.417 Vector VEC Base BS VECTOR 775
我正在使用闪亮的应用程序在浏览器中显示页面，相关代码是：
# render the plot, filtering for entities within the module minus any entities selected from the exclude panel
plot <- reactive({
if (input$filter==1){
data <- dplyr::filter(.data=melted, module_entry_key %in% input$module)
}
else{
data <- dplyr::filter(.data=melted, entity_name == input$entity)
}
data <- dplyr::filter(.data=data, !entity_name %in% input$excluded)
data$entity_name <- factor(data$entity_name)
data %>%
ggvis(x = ~date, y = ~count, fill = ~entity_name, key := ~id, fillOpacity := 0.5, fillOpacity.hover := 0.9) %>%
add_legend("fill", title="Entities") %>%
layer_points() %>%
add_tooltip(tooltipText, "hover") %>%
add_axis("y", title = "Count", title_offset = 50) %>%
add_axis("x", title="Date", title_offset=50, subdivide=6, tick_size_minor=3, format=parseDate(~year, ~month))
})
过滤器正在根据 UI 中的过滤器将 "melted" 的子集创建为 "data"（见图）
因为据我所知，每当我制作新的数据子集时，都无法将填充颜色与一个因素（实体名称）显式相关联，并且颜色是按因素的字母顺序选择的颜色改变了。
有什么办法解决这个问题吗？
（完整的闪亮代码）
server.R
library(ggvis)
library(shiny)
library(dplyr)
shinyServer(function(input, output, session){
modules_list <- as.character(c("Base" = "BS",
"Screening" = "SC",
"Protein Engineering" = "EN",
"Protein Production" = "PP",
"CD",
"PT",
"PD"))
#melted <- read.table(file="~/dataOut.txt", sep="\t", strip.white=TRUE, row.names=1, header=TRUE);
modules <- as.character(as.vector(unique(melted$module_entry_key)))
modules <- modules[modules != "null"]
entities <- as.character(as.vector(unique(melted$entity_name)))
entities <- entities[entities != "null"]
for (i in entities){
melted <- rbind(melted, data.frame(month=NA, year=NA, date=NA, entity_name=i, prefix=NA, module=NA, module_entry_key=NA, entity_table_name=NA, count=NA))
}
melted$id <- 1:nrow(melted)
#create ui checkbox for modules in the data
output$module_list <- renderUI({
checkboxGroupInput(inputId = "module",
label = "Module",
choices = modules,
selected = "BS")
})
#create the ui list for entities
output$entity_list <- renderUI({
checkboxGroupInput(
inputId = "entity",
label = "Entity",
choices = entities,
selected = "Vector"
)
})
#ex <- entities
#create the checkboxGroupInput with entities to 'exclude'
output$exclusion_entities <- renderUI({
checkboxGroupInput(inputId = "excluded", label = "Exclude",
choices = entities)
})
#update the excluded entities list with entities within a particular module
observe({
if (input$filter==1)
ex1 <- as.character(as.vector(unique(dplyr::filter(.data=melted, module_entry_key %in% input$module)$entity_name)))
updateCheckboxGroupInput(session, inputId = "excluded", "Exclude", choices=ex1, selected = input$excluded )
})
# render the plot, filtering for entities within the module minus any entities selected from the exclude panel
plot <- reactive({
if (input$filter==1){
data <- dplyr::filter(.data=melted, module_entry_key %in% input$module)
}
else{
data <- dplyr::filter(.data=melted, entity_name == input$entity)
}
data <- dplyr::filter(.data=data, !entity_name %in% input$excluded)
data$entity_name <- factor(data$entity_name)
data %>%
ggvis(x = ~date, y = ~count, fill = ~entity_name, key := ~id, fillOpacity := 0.5, fillOpacity.hover := 0.9) %>%
add_legend("fill", title="Entities") %>%
layer_points() %>%
add_tooltip(tooltipText, "hover") %>%
add_axis("y", title = "Count", title_offset = 50) %>%
add_axis("x", title="Date", title_offset=50, subdivide=6, tick_size_minor=3, format=parseDate(~year, ~month))
})
#function to add color and mouse-over effect to layer_points() (unused in this code)
points <- reactive({
layer_points(fillOpacity := 0.5, fillOpacity.hover := 1, fill.hover := "red")
})
#d3 date format for formatting x-axis text
parseDate <- function(year, month){
paste("d3.time.format(\"%Y\").parse(", year, ")", sep="")
}
#function for what to display in mouse-hover tooltip
tooltipText <- function(x) {
if(is.null(x)) return(NULL)
row <- melted[melted$id == x$id, ]
paste(row$entity_name, ": ", row$count, sep="")
}
#bind the plot to the UI
plot %>% #layer_points(fill = ~factor(entity_name)) %>%
bind_shiny("ggvis")
#select all button for modules
observe({
if (input$selectall ==0){
return(NULL)
}
else if ((input$selectall%%2)==0){
updateCheckboxGroupInput(session, inputId = "module", "Module", choices = modules)
}
else{
updateCheckboxGroupInput(session, inputId = "module", "Module", choices=modules, selected=modules)
}
})
#select all button for excluded entities
observe({
list <- as.character(as.vector(unique(dplyr::filter(.data=melted, module_entry_key %in% input$module)$entity_name)))
if (input$exclude_all ==0){
return(NULL)
}
else if ((input$exclude_all%%2)==0){
updateCheckboxGroupInput(session, inputId = "excluded", "Exclude", choices=list )
}
else{
updateCheckboxGroupInput(session, inputId = "excluded", "Exclude", choices=list, selected=list )
}
})
#---general output / debugging stuff ----#
output$table <- renderTable({dataInput()})
output$entity_selected = renderPrint({
list <- as.character(as.vector(unique(dplyr::filter(.data=melted, module_entry_key %in% input$module)$entity_name)))
entities[!entities %in% input$excluded & entities %in% list]
})
output$filter_value = renderPrint({input$filter})
output$modules = renderPrint({input$module})
output$link = renderPrint(input$selectall%%2)
#----------------------------------------#
})
ui.R
library(shiny)
shinyUI(fluidPage(
titlePanel("DB Analysis"),
sidebarLayout(
sidebarPanel(
width=3,
radioButtons(inputId="filter",
label="Filter",
choices = list("By Module" = 1, "By Entity" = 2),
selected = 1),
conditionalPanel(condition = "input.filter == 1",
uiOutput("module_list"),
actionButton("selectall", "Select All"),
uiOutput("exclusion_entities"),
actionButton("exclude_all", "Select All")
),
conditionalPanel(condition = "input.filter == 2",
uiOutput("entity_list")
)
),
mainPanel(
h2("Cumulative Entity Counts over Time (years)", align="center"),
#verbatimTextOutput("value"),
#verbatimTextOutput("filter_value"),
#verbatimTextOutput("modules"),
#tableOutput("table"),
ggvisOutput("ggvis"),
verbatimTextOutput("link"),
verbatimTextOutput("entity_selected")
#textOutput("entities_plot")
)
)
)
)
这可能是最好的方法。尝试这样的事情：
df[which(df$entity_name == "AbLibrary"),]$color <- "FF0000"
df[which(df$entity_name == "Vector"),]$color <- "#FFB90F"
对于数据框中的每一个。然后每次都将填充设置为颜色。唯一的问题是试图创造一个传奇。 （我一直在努力弄清楚，所以如果我找到它，我会编辑这个 post。