Я пишу приложение Shiny, в котором у пользователя есть два входа ползунка: один для «кратного изменения», другой для «p-значения». Существует набор данных, содержащий 10 наблюдений, каждое из которых имеет кратное изменение и p-значение. Только точки, которые имеют p-значение меньше, чем входное значение ползунка «p-значение», и кратное изменение больше, чем входное значение ползунка «кратное изменение», отображаются в данный момент времени.
То, что я написал до сих пор, представлено ниже -
library(ggplot2)
library(plotly)
library(htmlwidgets)
ui <- shinyUI(fluidPage(
sliderInput("threshP", "P-value:", min = 0, max = 1, value=0.05, step=0.05),
sliderInput("threshFC", "Fold change:", min = 0, max = 10, value=5, step=0.5),
plotlyOutput("plot1"),
textOutput("selectedValues")
))
server <- shinyServer(function(input, output) {
set.seed(1)
threshP <- reactive(input$threshP)
threshFC <- reactive(input$threshFC)
dat <- data.frame(ID = paste0("ID",1:10), FC=runif(10,0,10), pval=runif(10,0,1))
dat$ID <- as.character(dat$ID)
# x-axis FC, y-axis pval
xMax = max(dat$FC)
xMin = min(dat$FC)
yMax = max(dat$pval)
yMin = min(dat$pval)
df <- data.frame()
p <- ggplot(df) + geom_point() + xlim(xMin, xMax) + ylim(yMin, yMax)
gp <- ggplotly(p)
output$plot1 <- renderPlotly({
gp %>% onRender("
function(el, x, data) {
var dat = data.dat
var selFC = [];
var selP = [];
dat.forEach(function(row){
rowFC = row['FC']
rowP = row['pval']
if (rowP <= data.thP && data.thFC <= rowFC){
selFC.push(rowFC);
selP.push(rowP);
}
});
var Traces = [];
var tracePoints = {
x: selFC,
y: selP,
mode: 'markers',
marker: {
color: 'black',
size: 6
},
};
Traces.push(tracePoints);
Plotly.addTraces(el.id, Traces);
var idRows = []
for (a=0; a<data.dat.length; a++){
idRows.push(data.dat[a]['ID'])
}
console.log(idRows)
el.on('plotly_selected', function(e) {
numSel = e.points.length
Points = e.points
selID = []
for (a=0; a<numSel; a++){
PN = Points[a].pointNumber
selRow = idRows[PN]
selID.push(selRow)
}
Shiny.onInputChange('selID', selID);
})
}", data = list(dat = dat, thP=threshP(), thFC=threshFC()))})
selID <- reactive(input$selID)
selDat <- reactive(dat[which(dat$ID %in% selID()), ])
output$selectedValues <- renderPrint({str(selDat())})
})
shinyApp(ui, server)
Это создает правильный вывод, если все десять точек нанесены на график (когда ползунок «p-value» находится в положении 1, а ползунок «fold-change» — в положении 0). Например, на изображении ниже нанесены все 10 точек данных, и пользователь выбрал ту, у которой значение p (ось Y) близко к значению 1. Под графиком находится возвращенная строка, которая имеет складку. изменить (ось x) значение 6,61 и значение p (ось y) значение 0,992. Кажется, это работает.
Однако если не нанесены все десять точек, выдается неверный вывод. Например, на изображении ниже нанесено только 6 точек данных, и пользователь выбрал ту, у которой значение p (ось Y) близко к значению 1. Под графиком находится возвращенная строка, которая имеет сгиб- значение изменения (ось x) 2,02 и значение p (ось y) 0,77. Кажется, это не работает.
Я понимаю/полагаю, что проблема возникает из-за того, что когда не все 10 точек нанесены на график, возвращаемые индексы строк могут быть только между 1-c, где c - некоторое число меньше 10. Таким образом, индексы строк больше не совпадают с исходный фрейм данных. Однако я теряюсь в том, как решить эту проблему.
Любые советы о том, как решить эту проблему? Спасибо.
РЕДАКТИРОВАТЬ:
Благодаря полезным предложениям по отладке, я думаю, проблема может быть решена. Хитрость заключается в использовании pointNumber в качестве индекса в переменной массива, которая содержит подмножество отображаемого фрейма данных. Здесь это объект sselID.
library(ggplot2)
library(plotly)
library(htmlwidgets)
ui <- shinyUI(fluidPage(
sliderInput("threshP", "P-value:", min = 0, max = 1, value=1, step=0.05),
sliderInput("threshFC", "Fold change:", min = 0, max = 10, value=0, step=0.5),
plotlyOutput("plot1"),
verbatimTextOutput("selectedValues")
))
server <- shinyServer(function(input, output) {
set.seed(1)
threshP <- reactive(input$threshP)
threshFC <- reactive(input$threshFC)
dat <- data.frame(ID = paste0("ID",1:10), FC=runif(10,0,10), pval=runif(10,0,1))
dat$ID <- as.character(dat$ID)
print(dat)
# x-axis FC, y-axis pval
xMax = max(dat$FC)
xMin = min(dat$FC)
yMax = max(dat$pval)
yMin = min(dat$pval)
df <- data.frame()
p <- ggplot(df) + geom_point() + xlim(xMin, xMax) + ylim(yMin, yMax)
gp <- ggplotly(p)
output$plot1 <- renderPlotly({
gp %>% onRender("
function(el, x, data) {
var dat = data.dat
var selFC = [];
var selP = [];
var sselID = [];
dat.forEach(function(row){
rowFC = row['FC']
rowP = row['pval']
rowID = row['ID']
if (rowP <= data.thP && data.thFC <= rowFC){
selFC.push(rowFC);
selP.push(rowP);
sselID.push(rowID);
}
});
console.log(sselID)
var Traces = [];
var tracePoints = {
x: selFC,
y: selP,
text: sselID,
mode: 'markers',
marker: {
color: 'black',
size: 6
},
};
Traces.push(tracePoints);
Plotly.addTraces(el.id, Traces);
el.on('plotly_selected', function(e) {
console.log(e.points)
numSel = e.points.length
Points = e.points
selID = []
for (a=0; a<numSel; a++){
PN = Points[a].pointNumber
selRow = sselID[PN]
selID.push(selRow)
}
Shiny.onInputChange('selID', selID);
})
}", data = list(dat = dat, thP=threshP(), thFC=threshFC()))})
selID <- reactive(input$selID)
selDat <- reactive(dat[which(dat$ID %in% selID()), ])
output$selectedValues <- renderPrint({selDat()})
})
shinyApp(ui, server)
