Я пытаюсь создать приложение, которое создает 3 разных графика на основе одного загруженного пользователем файла.Мой подход состоит в том, чтобы создать 3 различных реактивных фрейма данных, которые берут исходные загруженные исходные данные, но трансформируют их по-разному в зависимости от параметров, необходимых для графика.Кроме того, я использую dplyr для фильтрации / выбора столбцов для каждого кадра реактивных данных.
Однако каждый раз, когда я пытаюсь вызвать исходные загруженные данные в реактивных функциях, я получаю следующие ошибки: «нетприменимый метод для 'select_', примененный к объекту класса "function" "Результат должен иметь длину 6, а не 0"
Для контекста мои загруженные данные имеют 6 строк. Просмотреть данные здесь
Я пытаюсь: 1. получить доступ к таблице данных из фрейма реактивных данных, data () 2. выбрать определенные строки в этом фрейме реактивных данных, поэтому идентификатор столбца = input $ slider_piechart. Круговая диаграмма будетпостроено на основе строки #, выбранной в числовом ползунке ввода.
#define UI
ui <- fluidPage(
# Application title
titlePanel("Data Visualization -- 2x2 Analysis"),
tabsetPanel(
#----------------------------------------------------------------------------------------------------------------------------------------------------------
#Data upload tab
tabPanel("Upload File",
titlePanel("Upload CSV File"),
#sidebar layout with input and output definitions--
sidebarLayout(
#sidebar panel for inputs ---
sidebarPanel(
#input-- select file
fileInput('file1', 'Choose CSV File', multiple = FALSE,
accept=c('text/csv',
'text/comma-separated-values,text/plain',
'.csv')),
# Horizontal line ----
tags$hr(),
checkboxInput('header', 'Header', TRUE),
radioButtons('sep', 'Separator',
c(Comma=',',
Semicolon=';',
Tab='\t'),
','),
radioButtons('quote', 'Quote',
c(None='',
'Double Quote'='"',
'Single Quote'="'"),
'"'),
tags$hr(),
# Input: Select number of rows to display ----
radioButtons("disp", "Display",
choices = c(Head = "head",
All = "all"),
selected = "head")
),
#main panel to display outputs
mainPanel(
#output-- data file
dataTableOutput('contents')
)
)
),
#--------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
#point estimate line plot
tabPanel("Point Estimate Line Plot",
pageWithSidebar(
headerPanel('Point Estimate Line Plot'),
sidebarPanel(
#drop down menu inputs
selectInput('xcol','X Variable',""),
selectInput('ycol','Y Variable',""),
sliderInput("slider_lineplot", label = h3("Select range of samples by Column ID"), min = 0,
max = 20, value = 1),
selectInput("specimen","Select Specimen Type column",""),
selectInput("LCI","Lower Confidence Interval(LCI):",""),
selectInput("UCI","Upper Confidence Interval(UCI):",""),
#label inputs
textInput("title_lineplot",label="Plot Title",value="Enter text..."),
textInput("xlabel_lineplot",label="x-axis label",value="Enter text..."),
textInput("ylabel_lineplot",label="y-axis label",value="Enter text..."),
numericInput("referenceline","Reference value",0.95,min=0,max=1,step=0.01)
),
mainPanel(
plotOutput('lineplot'),
br(),
br(),
dataTableOutput('lineplot_table')
)
)
),
#--------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
#concentric pie chart
tabPanel("Concentric Pie Chart",
pageWithSidebar(
headerPanel('Pie Chart'),
sidebarPanel(
#label inputs
textInput("title",label="Plot Title",value="Enter text..."),
sliderInput("slider_piechart", label = h3("Select Column ID"), min = 0,
max = 20, value = 1),
selectInput('fill','Select Result Column',""),
selectInput('upperbound','Select YMAX Column',""),
selectInput('lowerbound','Select YMIN Column',""),
selectInput('ref','Select Type Column',"")
),
mainPanel(
plotOutput('piechart'),
dataTableOutput('piechart_table')
)
)
),
#--------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
#MOSAIC PLOT
tabPanel("Mosaic Plot",
pageWithSidebar(
headerPanel('2x2 Table Mosaic Plot'),
sidebarPanel(
#label inputs
textInput("title_mosaic",label="Plot Title",value="Enter text..."),
selectInput('REF','Select Reference column',""),
selectInput('SampleType','Select Sample Type column',""),
selectInput('GX','Select GX column',"")
),
mainPanel(
plotOutput('mosaic'),
dataTableOutput('mosaic_table')
)
)
)
)
)
#--------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
# Define server logic required to read file, and display all the different plots
server<- function(input, output,session) {
# added "session" because updateSelectInput requires it
data <- reactive({
req(input$file1) ## ?req # require that the input is available
inFile <- input$file1
# tested with a following dataset: write.csv(mtcars, "mtcars.csv")
# and write.csv(iris, "iris.csv")
df <- read.csv(inFile$datapath, header = input$header, sep = input$sep,
quote = input$quote)
#augment data set. Add Sensitivity(PPA), Specificity(NPA), False Positive Rate(1-specificity), and 95% confidence intervals for PPA and NPA
#Tp = true positive, Fp = false positive, Fn = false negative, Tn = True negative
#add PPA and NPA
df$PPA <- round((df$TP)/(df$TP+df$FN),3) #sensitivity = Tp/(Tp+Fn)
df$NPA <- round((df$TN)/(df$TN+df$FP),3) #specificity = Tn/(Tn+Fp)
#----------------------------------------------------------------------------------------------------------------------------------------------------------------------
#add wilson confidence intervals
#----------------------------------------------------------------------------------------------------------------------------------------------------------------------
#Sensitivity(PPA) calculations-- first calculate Q1, Q2, Q3 quantiles
Q1_se <- (2*df$TP)+3.84
FNR <- (df$FN)/(df$TP+df$FN) #false negative rate(FNR) = Fn/(Fn+Tp)
Q2_se <- 1.96 * sqrt(3.84 + (4*df$TP*FNR))
Q3_se <- (2*(df$TP+df$FN))+7.68
#95% confidence intervals
#lower bound CI(LCI) and upper bound CI(UCI) for PPA
df$PPA_LCI <- round((Q1_se-Q2_se)/(Q3_se),3)
df$PPA_UCI <- round((Q1_se+Q2_se)/(Q3_se),3)
#----------------------------------------------------------------------------------------------------------------------------------------------------------------------
#Specificity(NPA)calculations-- first calculate Q1, Q2, Q3 quantiles
Q1_sp <- (2*df$TN)+3.84
TNR <- (df$TN)/(df$TN+df$FP) #false negative rate(FNR) = Fn/(Fn+Tp)
Q2_sp <- 1.96 * sqrt(3.84 + (4*df$FP*TNR))
Q3_sp <- (2*(df$FP+df$TN))+7.68
#95% confidence intervals
#lower bound CI(LCI) and upper bound CI(UCI) for NPA
df$NPA_LCI <- round((Q1_sp-Q2_sp)/(Q3_sp),3)
df$NPA_UCI <- round((Q1_sp+Q2_sp)/(Q3_sp),3)
df <- as.data.frame(df)
#datalist <- list(df=df, PPA=df$PPA, NPA=df$NPA, PPA_LCI=df$PPA_LCI, PPA_UCI=df$PPA_UCI,NPA_LCI=df$NPA_LCI,NPA_UCI=df$NPA_UCI,ColumnID=df$`Column ID`)
#datalist
return(df)
})
#---------------------------------------------------------------
lineplot_dataframe <- reactive({
#df_lineplot <- filter(data(),data()$`Column ID`==1:input$slider_lineplot)
#df_lineplot <- filter(datalist$df,datalist$ColumnID==1:input$slider_lineplot)
df_lineplot <- subset(df,df$`Column ID`==1:input$slider_lineplot)
#line plot create data frame
df2_lineplot <- data.frame(matrix(nrow=dim(df_lineplot)[1],ncol=7))
colnames(df2_lineplot) <- c("SpecimenType","PPA","NPA","PPA_upper","PPA_lower","NPA_upper","NPA_lower")
df2_lineplot$SpecimenType <- df_lineplot$`Specimen Type`
df2_lineplot$PPA<- round(df_lineplot$PPA,3)
df2_lineplot$NPA<- round(df_lineplot$NPA,3)
df2_lineplot$PPA_lower <- round(df_lineplot$PPA_LCI,3)
df2_lineplot$PPA_upper <- round(df_lineplot$PPA_UCI,3)
df2_lineplot$NPA_lower <- round(df_lineplot$NPA_LCI,3)
df2_lineplot$NPA_upper <- round(df_lineplot$NPA_UCI,3)
df2_lineplot <- as.data.frame(df2_lineplot)
#update select input for line plot
updateSelectInput(session, inputId = 'xcol', label = 'X Variable',
choices = names(df2_lineplot), selected = "")
updateSelectInput(session, inputId = 'ycol', label = 'Y Variable',
choices = names(df2_lineplot), selected = "")
updateSelectInput(session, inputId = 'specimen', label = 'Select Specimen Type column',
choices = names(df2_lineplot), selected = "")
updateSelectInput(session, inputId = 'LCI', label = 'Lower Confidence Interval(LCI):',
choices = names(df2_lineplot), selected = "")
updateSelectInput(session, inputId = 'UCI', label = 'Upper Confidence Interval(UCI):',
choices = names(df2_lineplot), selected = "")
return(df2_lineplot)
})
#---------------------------------------------------------------
#create reactive table for pie chart information
PieData_extracted <- reactive({
#PF <- filter(select(data(),1,6:9),data()$`Column ID`==input$slider_piechart)
PF <- subset(df,select=c(1,6:9),df$`Column ID`==input$slider_piechart)
#PF <- data(df) %>%
#dplyr::select(1, 6:9) %>%
#dplyr::filter(data(df)$`Column ID` == input$slider_piechart)
PF2 <- data.frame(matrix(nrow=4, ncol=7))
colnames(PF2) <- c("Type","Result","Result_transformed","Value","Percent","YMIN","YMAX")
PF2$Result <- colnames(PF)[2:5]
PF2$Value <- c(PF$TP,PF$FN,PF$TN,PF$FP)
PF2$Result_transformed <- c(0,0,1,1)
PF2$Type <- ifelse(PF2$Result_transformed==0,"Reference Positive","Reference Negative")
#percentage calculations
PF2$Percent <- round((PF2$Value/sum(PF2$Value))*100,2)
PF2$YMAX <- cumsum(PF2$Percent)
PF2$YMIN <- c(0,cumsum(PF2$Percent)[1:3])
#update select input for pie chart
updateSelectInput(session, inputId = 'fill', label = 'Select result(i.e TP, FN)',
choices = names(PF2)[2], selected = "")
updateSelectInput(session, inputId = 'upperbound', label = 'Select YMAX Column',
choices = names(PF2)[7], selected = "")
updateSelectInput(session, inputId = 'lowerbound', label = 'Select YMIN Column',
choices = names(PF2)[6], selected = "")
updateSelectInput(session, inputId = 'ref', label = 'Select Reference Column',
choices = names(PF2)[1], selected = "")
return(PF2)
})
#---------------------------------------------------------------
#mosaic plot table
MosaicDF <- reactive({
#display mosaic
Mosaic_filtered <- select(PieData_extracted(),-c(3,5:7))
#change data frame sample type according to column ID
Mosaic_sample <- filter(select(df,1,4,6:9),df$`Column ID`==input$slider_piechart)
#data transformation
names(Mosaic_filtered)[1]<-"REF"
Mosaic_filtered$SampleType <- Mosaic_sample$`Specimen Type`
Mosaic_filtered$GX <- c("POS","NEG","NEG","POS")
Mosaic_filtered$REF <- c("POS","POS","NEG","NEG")
Mosaic_filtered$F2 <- factor(as.character(Mosaic_filtered$Value))
MYRaw <- Mosaic_filtered[rep(rownames(Mosaic_filtered),as.numeric(as.character(Mosaic_filtered$F2))), ]
MYRaw <- as.data.frame(MYRaw)
#update select input for mosaic plot
updateSelectInput(session, inputId = 'REF', label = 'Select Reference column',
choices = names(Mosaic_filtered), selected = "")
updateSelectInput(session, inputId = 'SampleType', label = 'Select Sample Type column',
choices = names(Mosaic_filtered), selected = "")
updateSelectInput(session, inputId = 'GX', label = 'Select GX column',
choices = names(Mosaic_filtered), selected = "")
return(Mosaic_filtered)
})
#____________________________________________________
#display the data you uploaded
output$contents <- renderDataTable({
data()
})
output$lineplot_table <- renderDataTable({
lineplot_dataframe()
})
output$piechart_table <- renderDataTable({
PieData_extracted()
})
output$mosaic_table <- renderDataTable({
MosaicDF()
})
#_____________________________________________________________
#display the line plots
output$lineplot <- renderPlot({
#ggplot
ggplot(data = lineplot_dataframe(), aes_string(x =1:dim(lineplot_dataframe())[1], y = input$ycol)) + geom_line(data=lineplot_dataframe(),color='red')+geom_point(data=lineplot_dataframe(),color='blue')+
geom_segment(aes_string(x=1,y=input$referenceline,xend=dim(lineplot_dataframe())[1],yend=input$referenceline),linetype="dashed",data=lineplot_dataframe())+
geom_errorbar(aes_string(ymin=input$LCI,ymax=input$UCI),width=0.3)+
labs(title=input$title_lineplot,x=input$xlabel_lineplot,y=input$ylabel_lineplot)+
theme_update(plot.title = element_text(hjust = 0.5,size=16,face="bold"),axis.text=element_text(size=14),axis.title=element_text(size=14,face="bold"))+
annotate("text",x=1.5,y=input$referenceline+0.002,label=paste("Reference Line =",input$referenceline))+
scale_x_discrete("Specimen Type",limits=SpecimenType)
})
#________________________________________________________________________
#display the pie chart
#PIE CHART
output$piechart <- renderPlot({
#treechart
patch <- ggplot(data=PieData_extracted()) + geom_rect(aes_string(fill=input$fill, ymax=input$upperbound, ymin=input$lowerbound, xmax=4, xmin=3)) +geom_rect(aes_string(fill=input$ref, ymax=input$upperbound, ymin=input$lowerbound, xmax=3, xmin=0)) +xlim(c(0, 4)) + theme(aspect.ratio=1)
#convert to polar coordinates
piechart <- patch + coord_polar(theta="y",start=0,direction=1)
#add chart title
piechart_labeled <- piechart + labs(title=input$title,subtitle="PPA vs NPA",x="",y="")
#print result
piechart_labeled+scale_fill_discrete(name="Diagnostic Result")
})
#__________________________________________________________________________
#display mosaic plot
output$mosaic <- renderPlot({
ggplot(data=MosaicDF())+geom_mosaic(aes(weight = Value, x = product(!!sym(input$REF), !!sym(input$GX)), fill = !!sym(input$REF)))+labs(title=input$title_mosaic,x="REF",y="GX")
})
}
# Run the application
shinyApp(ui = ui, server = server)
"нет применимого метода для 'select_', примененного к объекту класса" function "" Результат должен иметь длину 6, а не0"