将观察者放入我的闪亮应用程序后，无法显示趋势线
你好我有一个闪亮的应用程序，它将数据集作为输入，从NA清除它，然后从中创建一个图。我给用户选择在该图中添加趋势线。 这就是我的数据集的样子：
gene_symbol Entrez_ID Ensembl_ID Lex1 Lex2 Lex3 Lex4 Lex5 Lex6 Lex7 Lex8 Lex9 Lex10
<chr> <int> <chr> <int> <int> <int> <int> <int> <int> <int> <int> <int> <int>
1 A1BG 5171 ENSG00000121~ 9 1 12 8 9 1 32 126 29 24
2 A1BG-AS1 52447 ENSG00000268~ 30 46 58 94 53 11 125 142 67 67
3 A1CF 9119 ENSG00000148~ 0 0 0 0 0 87 0 0 0 0
4 A2M 14002 ENSG00000175~ 273 520 1387 1549 2064 1101 2508 6420 3269 4475
5 A2M-AS1 38572 ENSG00000245~ 2 2 7 11 14 8 13 6 20 16
6 A2ML1 11899 ENSG00000166~ 0 0 0 0 0 2 0 2 1 0
7 A2ML1-AS1 44904 ENSG00000256~ 0 0 0 0 0 1 0 0 0 0
8 A2ML1-AS2 45000 ENSG00000256~ 0 0 0 0 0 0 0 0 0 0
9 A2MP1 44659 ENSG00000256~ 1 1 4 4 2 1 0 9 1 0
10 A3GALT2 15764 ENSG00000184~ 0 0 0 0 0 0 0 0 0 0
这是工作应用程序。
#ui.r
library(shiny)
library(ggplot2)
library(plotly)
fluidPage(
# App title ----
titlePanel(div("CROSS CORRELATION",style = "color:blue")),
# Sidebar layout with input and output definitions ----
sidebarLayout(
# Sidebar panel for inputs ----
sidebarPanel(
# Input: Select a file ----
fileInput("file1", "Input CSV-File",
multiple = TRUE,
accept = c("text/csv",
"text/comma-separated-values,text/plain",
".csv")),
# Horizontal line ----
tags$hr(),
# Input: Checkbox if file has header ----
checkboxInput("header", "Header", TRUE),
# Input: Select separator ----
radioButtons("sep", "Separator",
choices = c(Comma = ",",
Semicolon = ";",
Tab = "\t"),
selected = ","),
# Horizontal line ----
tags$hr(),
# Input: Select number of rows to display ----
radioButtons("disp", "Display",
choices = c(Head = "head",
All = "all"),
selected = "head")
),
# Main panel for displaying outputs ----
mainPanel(
tabsetPanel(type = "tabs",
tabPanel("Table",
shiny::dataTableOutput("contents")),
tabPanel("Correlation Plot",
tags$style(type="text/css", "
#loadmessage {
position: fixed;
top: 0px;
left: 0px;
width: 100%;
padding: 5px 0px 5px 0px;
text-align: center;
font-weight: bold;
font-size: 100%;
color: #000000;
background-color: #CCFF66;
z-index: 105;
}
"),conditionalPanel(condition="$('html').hasClass('shiny-busy')",
tags$div("Loading...",id="loadmessage")
),
fluidRow(
column(3, uiOutput("lx1")),
column(3,uiOutput("lx2"))),
hr(),
fluidRow(
tags$style(type="text/css",
".shiny-output-error { visibility: hidden; }",
".shiny-output-error:before { visibility: hidden; }"
),
column(3,uiOutput("td")),
column(3,uiOutput("an"))),
fluidRow(
plotlyOutput("sc"))
))
)))
#server.r
function(input, output) {
rt<-reactive({
req(input$file1)
csvdata <- read.csv(input$file1$datapath,
header = input$header
)
if(input$disp == "head"){
head(csvdata)
} else{
csvdata
}
csvdata$Lex1=as.numeric(levels(csvdata$Lex1))[csvdata$Lex1]
csvdata$Lex2=as.numeric(levels(csvdata$Lex2))[csvdata$Lex2]
csvdata$Lex3=as.numeric(levels(csvdata$Lex3))[csvdata$Lex3]
csvdata$Lex4=as.numeric(levels(csvdata$Lex4))[csvdata$Lex4]
csvdata$Lex5=as.numeric(levels(csvdata$Lex5))[csvdata$Lex5]
csvdata$Lex6=as.numeric(levels(csvdata$Lex6))[csvdata$Lex6]
csvdata$Lex7=as.numeric(levels(csvdata$Lex7))[csvdata$Lex7]
csvdata$Lex8=as.numeric(levels(csvdata$Lex8))[csvdata$Lex8]
csvdata$Lex9=as.numeric(levels(csvdata$Lex9))[csvdata$Lex9]
csvdata$Lex10=as.numeric(levels(csvdata$Lex10))[csvdata$Lex10]
csvdata$Lex11=as.numeric(levels(csvdata$Lex11))[csvdata$Lex11]
csvdata$Lex12=as.numeric(levels(csvdata$Lex12))[csvdata$Lex12]
capture.output(csvdata[rowSums(is.na(csvdata)) > 0,],file = "Missing_genes.csv")
row.has.na <- apply(csvdata, 1, function(x){any(is.na(x))})
csvdata2 <- csvdata[!row.has.na,]
csvdata2
})
output$contents <- shiny::renderDataTable({
rt()
})
output$lx1<-renderUI({
selectInput("lx1", label = h4("Select 1st Expression Profile"),
choices = colnames(rt()[,4:15]),
selected = "Lex1")
})
output$lx2<-renderUI({
selectInput("lx2", label = h4("Select 2nd Expression Profile"),
choices = colnames(rt()[,4:15]),
selected = "Lex2")
})
output$td<-renderUI({
radioButtons("td", label = h4("Trendline"),
choices = list("Add Trendline" = "lm", "Remove Trendline" = ""),
selected = "")
})
output$an<-renderUI({
radioButtons("an", label = h4("Correlation Coefficient"),
choices = list("Add Cor.Coef" = cor(subset(rt(), select=c(input$lx1)),subset(rt(), select=c(input$lx2))), "Remove Cor.Coef" = ""),
selected = "")
})
output$sc<-renderPlotly({
p1 <- ggplot(rt(), aes_string(x = input$lx1, y = input$lx2))+
# Change the point options in geom_point
geom_point(color = "darkblue") +
# Change the title of the plot (can change axis titles
# in this option as well and add subtitle)
labs(title = "Cross Correlation") +
# Change where the tick marks are
scale_x_continuous(breaks = seq(0, 80000, 10000)) +
scale_y_continuous(breaks = seq(0, 120000, 20000)) +
# Change how the text looks for each element
theme(title = element_text(family = "Calibri",
size = 10,
face = "bold"),
axis.title = element_text(family = "Calibri Light",
size = 16,
face = "bold",
color = "darkgrey"),
axis.text = element_text(family = "Calibri",
size = 11))+
theme_bw()+
geom_smooth(method = input$td)+
annotate("text", x = 50000, y = 50000, label = as.character(input$an))
ggplotly(p1,source = "select", tooltip = c("key")) %>%
layout(hoverlabel = list(bgcolor = "white",
font = list(family = "Calibri",
size = 9,
color = "black")))
})
}
这是我为了在我的情节中使数据标签持久而添加的代码。
# 1. create reactive values
vals <- reactiveValues()
# 2. create df to store clicks
vals$click_all <- data.frame(x = numeric(),
y = numeric(),
label = character())
# 3. add points upon plot click
observe({
# get clicked point
click_data <- event_data("plotly_click", source = "select")
# get data for current point
label_data <- data.frame(x = click_data[["x"]],
y = click_data[["y"]],
label = click_data[["key"]],
stringsAsFactors = FALSE)
# add current point to df of all clicks
vals$click_all <- merge(vals$click_all,
label_data,
all = TRUE)
})
# 4. add labels for clicked points
geom_text(data = vals$click_all,
aes(x = x, y = y, label = label),
inherit.aes = FALSE, nudge_x = 0.25)
这是新的非功能性server.r，它提供了阻止趋势线显示的问题。我知道它们不是错误而是警告，但它们仍会导致问题：
Warning in qt((1 - level)/2, df) : NaNs produced
Warning in qt((1 - level)/2, df) : NaNs produced
Warning in qt((1 - level)/2, df) : NaNs produced
Warning in qt((1 - level)/2, df) : NaNs produced
Warning in qt((1 - level)/2, df) : NaNs produced
Warning in qt((1 - level)/2, df) : NaNs produced
Warning in qt((1 - level)/2, df) : NaNs produced
#server.r
function(input, output) {
rt<-reactive({
req(input$file1)
csvdata <- read.csv(input$file1$datapath,
header = input$header
)
if(input$disp == "head"){
head(csvdata)
} else{
csvdata
}
csvdata$Lex1=as.numeric(levels(csvdata$Lex1))[csvdata$Lex1]
csvdata$Lex2=as.numeric(levels(csvdata$Lex2))[csvdata$Lex2]
csvdata$Lex3=as.numeric(levels(csvdata$Lex3))[csvdata$Lex3]
csvdata$Lex4=as.numeric(levels(csvdata$Lex4))[csvdata$Lex4]
csvdata$Lex5=as.numeric(levels(csvdata$Lex5))[csvdata$Lex5]
csvdata$Lex6=as.numeric(levels(csvdata$Lex6))[csvdata$Lex6]
csvdata$Lex7=as.numeric(levels(csvdata$Lex7))[csvdata$Lex7]
csvdata$Lex8=as.numeric(levels(csvdata$Lex8))[csvdata$Lex8]
csvdata$Lex9=as.numeric(levels(csvdata$Lex9))[csvdata$Lex9]
csvdata$Lex10=as.numeric(levels(csvdata$Lex10))[csvdata$Lex10]
csvdata$Lex11=as.numeric(levels(csvdata$Lex11))[csvdata$Lex11]
csvdata$Lex12=as.numeric(levels(csvdata$Lex12))[csvdata$Lex12]
capture.output(csvdata[rowSums(is.na(csvdata)) > 0,],file = "Missing_genes.csv")
row.has.na <- apply(csvdata, 1, function(x){any(is.na(x))})
csvdata2 <- csvdata[!row.has.na,]
csvdata2
})
output$contents <- shiny::renderDataTable({
rt()
})
output$lx1<-renderUI({
selectInput("lx1", label = h4("Select 1st Expression Profile"),
choices = colnames(rt()[,4:15]),
selected = "Lex1")
})
output$lx2<-renderUI({
selectInput("lx2", label = h4("Select 2nd Expression Profile"),
choices = colnames(rt()[,4:15]),
selected = "Lex2")
})
output$td<-renderUI({
radioButtons("td", label = h4("Trendline"),
choices = list("Add Trendline" = "lm", "Remove Trendline" = ""),
selected = "")
})
output$an<-renderUI({
radioButtons("an", label = h4("Correlation Coefficient"),
choices = list("Add Cor.Coef" = cor(subset(rt(), select=c(input$lx1)),subset(rt(), select=c(input$lx2))), "Remove Cor.Coef" = ""),
selected = "")
})
# 1. create reactive values
vals <- reactiveValues()
# 2. create df to store clicks
vals$click_all <- data.frame(x = numeric(),
y = numeric(),
label = character())
# 3. add points upon plot click
observe({
# get clicked point
click_data <- event_data("plotly_click", source = "select")
# get data for current point
label_data <- data.frame(x = click_data[["x"]],
y = click_data[["y"]],
label = click_data[["key"]],
stringsAsFactors = FALSE)
# add current point to df of all clicks
vals$click_all <- merge(vals$click_all,
label_data,
all = TRUE)
})
output$sc<-renderPlotly({
p1 <- ggplot(rt(), aes_string(x = input$lx1, y = input$lx2,key = "gene_symbol"))+
# Change the point options in geom_point
geom_point(color = "darkblue") +
# Change the title of the plot (can change axis titles
# in this option as well and add subtitle)
labs(title = "Cross Correlation") +
# Change where the tick marks are
scale_x_continuous(breaks = seq(0, 80000, 10000)) +
scale_y_continuous(breaks = seq(0, 120000, 20000)) +
# Change how the text looks for each element
theme(title = element_text(family = "Calibri",
size = 10,
face = "bold"),
axis.title = element_text(family = "Calibri Light",
size = 16,
face = "bold",
color = "darkgrey"),
axis.text = element_text(family = "Calibri",
size = 11))+
theme_bw()+
geom_smooth(method = input$td)+
annotate("text", x = 50000, y = 50000, label = as.character(input$an))+
# 4. add labels for clicked points
geom_text(data = vals$click_all,
aes(x = x, y = y, label = label),
inherit.aes = FALSE, nudge_x = 0.25)
ggplotly(p1,source = "select", tooltip = c("key")) %>%
layout(hoverlabel = list(bgcolor = "white",
font = list(family = "Calibri",
size = 9,
color = "black")))
})
}
我使用iris数据集运行此功能，因此我认为这是NAs的问题。但正如你在我的代码开头所看到的那样，我摆脱了它们。那么为什么他们仍然会导致问题并阻止趋势线显示？
1 个答案:
答案 0 :(得分：3)
让我们将您的问题提炼下来：图表按照您对iris数据集的预期工作，但不适用于您的数据集。
据我所知，您想要一张带有所有数据的平滑线的情节。让我们看一下iris情节：
p1 <- ggplot(iris, aes(x = Sepal.Length, y = Sepal.Width, key = Species)) +
geom_point() +
geom_smooth()
ggplotly(p1, tooltip = c("key"))
我们看到三条geom_smooth()行，而不是一行。我们<{>>每Species 一行，因为 geom_smooth()正在使用从key初始化时ggplot审美。
与iris数据集不同，您的数据集对每行都有唯一的key（即gene_symbol）。一个分析数据集是mtcars - 每一行都是不同的汽车模型。现在，让我们用mtcars：
mtcars$car <- row.names(mtcars)
p1 <- ggplot(mtcars, aes(x = mpg, y = cyl, key = car)) +
geom_point() +
geom_smooth()
ggplotly(p1, tooltip = c("key"))
我们没有看到任何平滑的线条。 geom_smooth按汽车模型进行平滑处理，每个汽车模型只有一个数据点。同样，在您的数据集中，每gene_symbol只有一个数据点。
因此，我们需要使geom_smooth使用所有数据点。我们有三种选择：
- 仅在需要时设置
key美学（类似于this answer） - 重新映射
geom_smooth图层 的美学效果
- 提供
group（类似于this answer）
以下是每个选项的代码：
# 1. set the key aesthetic only where needed
# from: https://stackoverflow.com/a/47883636/8099834
mtcars$car <- row.names(mtcars)
p1 <- ggplot(mtcars, aes(x = mpg, y = cyl)) +
geom_point(aes(key = car)) +
geom_smooth()
ggplotly(p1, tooltip = c("key"))
# 2. re-map aesthetics for `geom_smooth`
mtcars$car <- row.names(mtcars)
p1 <- ggplot(mtcars, aes(x = mpg, y = cyl, key = car)) +
geom_point() +
geom_smooth(data = mtcars, aes(x = mpg, y = cyl), inherit.aes = FALSE)
ggplotly(p1, tooltip = c("key"))
# 3. provide a group
# from: https://stackoverflow.com/a/9769836/8099834
mtcars$car <- row.names(mtcars)
p1 <- ggplot(mtcars, aes(x = mpg, y = cyl, key = car, group = car)) +
geom_point() +
geom_smooth(aes(group = 1))
ggplotly(p1, tooltip = c("key"))
如果您使用其中一个选项调整代码，我相信您的应用应该按照您的预期运作。
相关问题
最新问题
- 我写了这段代码，但我无法理解我的错误
- 我无法从一个代码实例的列表中删除 None 值，但我可以在另一个实例中。为什么它适用于一个细分市场而不适用于另一个细分市场？
- 是否有可能使 loadstring 不可能等于打印？卢阿
- java中的random.expovariate()
- Appscript 通过会议在 Google 日历中发送电子邮件和创建活动
- 为什么我的 Onclick 箭头功能在 React 中不起作用？
- 在此代码中是否有使用“this”的替代方法？
- 在 SQL Server 和 PostgreSQL 上查询，我如何从第一个表获得第二个表的可视化
- 每千个数字得到
- 更新了城市边界 KML 文件的来源？