Я пытаюсь отрисовать график на основе входных файлов (.rds).Попытка построить, даже если один из данных не доступен.
Используется 'isTruthy', но мало помогает.
Данные, необходимые для запуска кода:
summaries <- data.frame(stringsAsFactors=FALSE,
decile_rank = c(1, 2, 3, 4, 5, 6, 7, 8, 9, 10),
sum_count = c(498, 282, 241, 302, 272, 271, 280, 321, 505, 675),
sum_apps = c(7242, 6234, 5710, 5525, 5318, 4615, 4652, 4314, 4477,3701),
sum_iss = c(7921, 6594, 6042, 5607, 5144, 4664, 4267, 3714, 2982,1572),
sum_paids = c(2332, 1815, 1594, 1379, 1112, 947, 1028, 897, 791, 580),
cml_apps = c(7242, 6234, 5710, 5525, 5318, 4615, 4652, 4314, 4477,3701),
cml_iss = c(7921, 6594, 6042, 5607, 5144, 4664, 4267, 3714, 2982,1572),
cml_paids = c(2332, 1815, 1594, 1379, 1112, 947, 1028, 897, 791, 580),
tot_profit = c(932, 628, 590, 558, 463, 380, 367, 374, 323, 237),
cml_tot_profit = c(3835.77, -64839.73, -73400.16, -64954.21, -86321.93,
-110090.35, -107799.09, -96207.38, -93987.67,
-155745.86),
mean_pctblack = c(24.89, 21.09, 19.4, 15.3, 11.99, 11.4, 10.59, 10.04,
9.08, 10.68),
Model_Num = c("V1", "V1", "V1", "V1", "V1", "V1", "V1", "V1", "V1",
"V1"),
bumpy_apps =c(1, 0, 0, 0, 0, 0, 0, 0, 0, 0),
bumpy_iss = c(1, 0, 0, 0, 0, 0, 0, 0, 0, 0),
bumpy_paids = c(1, 0, 0, 0, 0, 0, 0, 0, 0, 0)
)
write_rds(summaries,"path\\mydata.rds")
library(shiny)
library(DT)
#>
#> Attaching package: 'DT'
#> The following objects are masked from 'package:shiny':
#>
#> dataTableOutput, renderDataTable
library(plotly)
#> Loading required package: ggplot2
#>
#> Attaching package: 'plotly'
#> The following object is masked from 'package:ggplot2':
#>
#> last_plot
#> The following object is masked from 'package:stats':
#>
#> filter
#> The following object is masked from 'package:graphics':
#>
#> layout
# Define UI for data upload app ----
ui <- fluidPage(
# App title ----
titlePanel("Model Comparison"),
# Sidebar layout with input and output definitions ----
sidebarLayout(
# Sidebar panel for inputs ----
sidebarPanel(
# Input: Select a file ----
fileInput("NM_file", "Choose .Rda/.Rds file for New Model(s)",
multiple = FALSE,
accept = c(".Rda",".Rds"),
width='75%'
),
# Horizontal line ----
tags$hr(),
fileInput("CM_file", "Choose .Rda/.Rds file for Current Model(s)",
multiple = FALSE,
accept = c(".Rda",".Rds"),
width='75%'
),
# Horizontal line ----
tags$hr(),
#sliderInput("model_number", "Model Number:",min = 1, max = 500, value = 1,step=1,pre="Model #"),
numericInput("model_number", "Model Number:",value=1,min =1,max=500,step=1),
width=2
),
# Main panel for displaying outputs ----
mainPanel(
tabsetPanel(
id = 'dataset',
tabPanel("Numbers",
h4("New Model(s):"),
dataTableOutput("table1"),
hr(),
h4("Current Model(s):"),
#textOutput("testtext")
dataTableOutput("table2")
),
tabPanel("Lifts", plotlyOutput("plots")),
type="pills"
)
)
)
)
# Define server logic to read selected file ----
server <- function(input, output,session) {
NM_data <- reactive({
req(input$NM_file)
readr::read_rds(input$NM_file$datapath) %>%
filter(Model_Num==paste0("V",input$model_number))
})
CM_data <- reactive({
req(input$CM_file)
readr::read_rds(input$CM_file$datapath)
})
#output$testtext <- "x"
output$table1<- renderDataTable({
new_model_df <- NM_data()
all_col_names <- colnames(new_model_df)
cols_for_round0 <- c("decile_rank","sum_count","sum_apps","sum_iss","sum_paids","cml_apps","cml_iss","cml_paids","bumpy_apps","bumpy_iss","bumpy_paids")
cols_for_dollar <- c("tot_profit","cml_tot_profit")
cols_for_round2 <- setdiff(all_col_names,cols_for_round0)
final_dt <- datatable(new_model_df,rownames = FALSE
, extensions = c('ColReorder','KeyTable','Buttons')
, options = list(colReorder = TRUE,keys=TRUE,dom = 'Bfrtip'
,buttons = list(list(extend = 'colvis', columns = c(6:8,9))
,c('copy')
)
,pageLength = 11
,scrollX = TRUE
,autoWidth = TRUE
#,columnDefs = list(list(width = '15%', targets = "_all"))
)
) %>%
formatRound(cols_for_round0, 0) %>%
formatRound(cols_for_round2,2) %>%
formatCurrency(cols_for_dollar,'$') %>%
formatStyle('sum_apps','bumpy_apps',backgroundColor = styleEqual(c(1,0), c('yellow', 'gray'))) %>%
formatStyle('sum_iss','bumpy_iss',backgroundColor = styleEqual(c(1,0), c('yellow', 'gray'))) %>%
formatStyle('sum_paids','bumpy_paids',backgroundColor = styleEqual(c(1,0), c('yellow', 'gray')))
return(final_dt)
# datatable(NM_data())
})
output$table2<- renderDataTable({
datatable(CM_data())
})
output$plots <- renderPlotly({
new_model_df <- NM_data() %>% dplyr::mutate(new_old_flag="New")
# current_model_df <- CM_data() %>% dplyr::mutate(new_old_flag="Current")
# current_model_df$sum_apps[1] <- 7000
#binded_df <- dplyr::bind_rows(new_model_df,current_model_df)
if(isTruthy(CM_data())){
current_model_df <- CM_data() %>% dplyr::mutate(new_old_flag="Current")
current_model_df$sum_apps[1] <- 7000
binded_df <- dplyr::bind_rows(new_model_df,current_model_df)
}else{
binded_df <- new_model_df
}
apps_lift <- plotly::plot_ly(binded_df,x=~decile_rank,y=~sum_apps,color=~new_old_flag,type="scatter",mode="lines+markers")
iss_lift <- plotly::plot_ly(binded_df,x=~decile_rank,y=~sum_iss,color=~new_old_flag,type="scatter",mode="lines+markers")
paids_lift <- plotly::plot_ly(binded_df,x=~decile_rank,y=~sum_paids,color=~new_old_flag,type="scatter",mode="lines+markers")
# apps_lift <- ggplot(binded_df,aes(x=decile_rank),color=new_old_flag)+
# geom_line(aes(y=sum_apps,color=new_old_flag))+
# geom_point(aes(y=sum_apps,color=new_old_flag))+
# theme_bw()
subplot(apps_lift,iss_lift,nrows=1,shareY = TRUE)
})
session$onSessionEnded(stopApp)
}
# Create Shiny app ----
shinyApp(ui, server)
Проще говоря, я смогу создать графикдаже если доступен только один вход файла.Но в приведенном выше примере ничего не генерируется до тех пор, пока не будет выполнен второй ввод файла.В этом примере можно загрузить один и тот же файл данных mydata.rds для обоих входов файла.