From e7413613c5f3fb8382ca5ce9bacf2b1b7f43e45e Mon Sep 17 00:00:00 2001 From: John Harrold Date: Sun, 14 Apr 2024 17:00:00 -0700 Subject: [PATCH] Initial compact UI for CTS module. --- R/CTS_Server.R | 430 ++++++++++++++++--------- R/MB_Server.R | 2 +- R/NCA_Server.R | 3 +- inst/templates/CTS.yaml | 38 ++- inst/templates/CTS_module_components.R | 3 +- inst/templates/ruminate_devel.R | 26 +- vignettes/deployment.Rmd | 2 + 7 files changed, 323 insertions(+), 181 deletions(-) diff --git a/R/CTS_Server.R b/R/CTS_Server.R index 95990b7..d640a07 100644 --- a/R/CTS_Server.R +++ b/R/CTS_Server.R @@ -480,56 +480,51 @@ CTS_Server <- function(id, rx_details = current_ele[["rx_details"]] uiele = NULL - if(is.null(current_ele[["simres"]])){ - uiele = state[["MC"]][["errors"]][["no_sim_found"]] - } else if(current_ele[["simres"]][["isgood"]]){ - # JMH generate simulation output - - # Current simulation results - simres = current_ele[["simres"]][["capture"]][[ current_ele[["simres_object_name"]] ]] - - #------------------------------------ - # This creates a switch to change from the interactive and report - # views of tables and figures: - choiceValues = c("report", "interactive") - choiceNames = c(state[["MC"]][["labels"]][["switch_output_report"]], - state[["MC"]][["labels"]][["switch_output_interactive"]]) - - switch_selected = state[["CTS"]][["ui"]][["switch_output"]] - if(!(switch_selected %in% choiceValues)){ - switch_selected = "report" - } + # Current simulation results + simres = current_ele[["simres"]][["capture"]][[ current_ele[["simres_object_name"]] ]] + + #------------------------------------ + # This creates a switch to change from the interactive and report + # views of tables and figures: + choiceValues = c("report", "interactive") + choiceNames = c(state[["MC"]][["labels"]][["switch_output_report"]], + state[["MC"]][["labels"]][["switch_output_interactive"]]) + + switch_selected = state[["CTS"]][["ui"]][["switch_output"]] + if(!(switch_selected %in% choiceValues)){ + switch_selected = "report" + } - uiele_switch = - shinyWidgets::radioGroupButtons( - inputId = NS(id, "switch_output"), - label = state[["MC"]][["labels"]][["switch_output"]], - selected = switch_selected, - choiceValues = choiceValues, - choiceNames = choiceNames , - status = "primary") - #------------------------------------ - uiele_res_tabs = - shinydashboard::tabBox( - width = 10, - title = NULL, - # The id lets us use input$tabset1 on the server to find the current tab - shiny::tabPanel(id=NS(id, "tab_res_tc_figure"), - title=tagList(shiny::icon("chart-line"), - state[["MC"]][["labels"]][["tab_res_tc_figure"]]), - htmlOutput(NS(id, "ui_res_tc_figure")) - ), - shiny::tabPanel(id=NS(id, "tab_res_event_figure"), - title=tagList(shiny::icon("chart-line"), - state[["MC"]][["labels"]][["tab_res_events_figure"]]), - htmlOutput(NS(id, "ui_res_events_figure")) - ), - shiny::tabPanel(id=NS(id, "tab_sim_env"), - title=tagList(shiny::icon("puzzle-piece"), - state[["MC"]][["labels"]][["tab_sim_env"]]), - htmlOutput(NS(id, "CTS_ui_sim_env")) - ) + uiele_switch = + shinyWidgets::radioGroupButtons( + inputId = NS(id, "switch_output"), + label = state[["MC"]][["labels"]][["switch_output"]], + selected = switch_selected, + choiceValues = choiceValues, + choiceNames = choiceNames , + status = "primary") + #------------------------------------ + uiele_res_tabs = + shinydashboard::tabBox( + width = 10, + title = NULL, + # The id lets us use input$tabset1 on the server to find the current tab + shiny::tabPanel(id=NS(id, "tab_sim_env"), + title=tagList(shiny::icon("puzzle-piece"), + state[["MC"]][["labels"]][["tab_sim_env"]]), + htmlOutput(NS(id, "CTS_ui_sim_env")) + ), + shiny::tabPanel(id=NS(id, "tab_res_tc_figure"), + title=tagList(shiny::icon("chart-line"), + state[["MC"]][["labels"]][["tab_res_tc_figure"]]), + htmlOutput(NS(id, "ui_res_tc_figure")) + ), + shiny::tabPanel(id=NS(id, "tab_res_event_figure"), + title=tagList(shiny::icon("chart-line"), + state[["MC"]][["labels"]][["tab_res_events_figure"]]), + htmlOutput(NS(id, "ui_res_events_figure")) ) + ) uiele_btn_update = shinyWidgets::actionBttn( @@ -568,7 +563,7 @@ CTS_Server <- function(id, position = state[["MC"]][["formatting"]][["tc_dim"]][["tooltip_position"]]) # Figure page selection - uiele_fpage = htmlOutput(NS(id, "CTS_ui_fpage")) + uiele_fpage = htmlOutput(NS(id, "CTS_ui_fpage")) # DV cols selection choices = list() @@ -586,7 +581,7 @@ CTS_Server <- function(id, } - selected = current_ele[["ui"]][["dvcols"]] + selected = current_ele[["ui"]][["dvcols"]] # If selected gets confused because of changes in the model this will # just default to the first output @@ -604,7 +599,7 @@ CTS_Server <- function(id, options = list( size = state[["MC"]][["formatting"]][["dvcols"]][["size"]]), width = state[["MC"]][["formatting"]][["dvcols"]][["width"]]) - + uiele_dvcols = formods::FM_add_ui_tooltip(state, uiele_dvcols, tooltip = state[["MC"]][["formatting"]][["dvcols"]][["tooltip"]], @@ -619,7 +614,7 @@ CTS_Server <- function(id, value = state[["MC"]][["formatting"]][["evplot"]][["choices"]][[etype]][["value"]] choices[[ verb ]] = value } - selected = current_ele[["ui"]][["evplot"]] + selected = current_ele[["ui"]][["evplot"]] uiele_evplot = shinyWidgets::pickerInput( @@ -629,33 +624,50 @@ CTS_Server <- function(id, label = state[["MC"]][["labels"]][["evplot"]], choices = choices, width = state[["MC"]][["formatting"]][["evplot"]][["width"]]) - + uiele_evplot = formods::FM_add_ui_tooltip(state, uiele_evplot, tooltip = state[["MC"]][["formatting"]][["evplot"]][["tooltip"]], position = state[["MC"]][["formatting"]][["evplot"]][["tooltip_position"]]) - div_style ="display:inline-block;vertical-align:top;text-align:center" - uiele_btn_update = div(style=div_style, uiele_btn_update) - uiele_switch = div(style=div_style, uiele_switch) - uiele_tc_dim = div(style=div_style, uiele_tc_dim) - uiele_fpage = div(style=div_style, uiele_fpage) - uiele_dvcols = div(style=div_style, uiele_dvcols) - uiele_evplot = div(style=div_style, uiele_evplot) + uiele_btn_runsim = htmlOutput(NS(id, "ui_cts_runsim_btn")) + + div_style ="display:inline-block;vertical-align:top;align-items:center" + uiele_btn_update = div(style=div_style, uiele_btn_update) + uiele_btn_runsim = div(style=div_style, uiele_btn_runsim) + uiele_switch = div(style=div_style, uiele_switch) + uiele_tc_dim = div(style=div_style, uiele_tc_dim) + uiele_fpage = div(style=div_style, uiele_fpage) + uiele_dvcols = div(style=div_style, uiele_dvcols) + uiele_evplot = div(style=div_style, uiele_evplot) + + div_style= "width:80%;display:flex;align-items:center;justify-content:center" + + uiele_top_btn_row = + div(style=div_style, + uiele_btn_update, + HTML(' '), + uiele_tc_dim, + HTML(' '), + uiele_fpage, + HTML(' '), + uiele_dvcols, + HTML(' '), + uiele_evplot) + + uiele_switch = + div(style=div_style, + uiele_btn_runsim, + HTML(' '), + uiele_switch + ) uiele = tagList( - uiele_btn_update, - uiele_tc_dim, - uiele_fpage, - uiele_dvcols, - uiele_evplot, - tags$br(), - uiele_res_tabs, - tags$br(), - uiele_switch ) - } else{ - uiele = state[["MC"]][["errors"]][["bad_sim"]] - } + uiele_top_btn_row, + tags$br(), + uiele_res_tabs, + tags$br(), + uiele_switch ) uiele}) #------------------------------------ # The fpage is rendered separately so it can responnd to the update_plot @@ -703,7 +715,7 @@ CTS_Server <- function(id, label = state[["MC"]][["labels"]][["fpage"]], choices = choices, width = state[["MC"]][["formatting"]][["fpage"]][["width"]]) - + uiele_fpage = formods::FM_add_ui_tooltip(state, uiele_fpage, tooltip = state[["MC"]][["formatting"]][["fpage"]][["tooltip"]], @@ -731,33 +743,44 @@ CTS_Server <- function(id, figs_found = FALSE uiele = state[["MC"]][["errors"]][["cts_no_fig"]] - if("plotres" %in% names(current_ele)){ - if(current_ele[["plotres"]][["isgood"]]){ - figs_found = TRUE - }else{ - uiele = current_ele[["plotres"]][["msgs"]] - } + simgood = TRUE + if(is.null(current_ele[["simres"]])){ + simgood = FALSE + uiele = state[["MC"]][["errors"]][["no_sim_found"]] + } else if(!current_ele[["simres"]][["isgood"]]){ + uiele = uiele = state[["MC"]][["errors"]][["bad_sim"]] + simgood = FALSE } - if(figs_found){ - - pvw = state[["MC"]][["formatting"]][["preview"]][["width"]] - pvh = state[["MC"]][["formatting"]][["preview"]][["height"]] - pv_div_style = paste0("height:",pvh,";width:",pvw,";display:inline-block;vertical-align:top") - - output_type = state[["CTS"]][["ui"]][["switch_output"]] - if(output_type == "report"){ - uiele = - div(style=pv_div_style, - plotOutput( - NS(id, "ui_res_tc_figure_ggplot"), - width=pvw, height=pvh)) - } else { - uiele = - div(style=pv_div_style, - plotly::plotlyOutput( - NS(id, "ui_rec_tc_figure_plotly"), - width=pvw, height=pvh)) + if(simgood){ + if("plotres" %in% names(current_ele)){ + if(current_ele[["plotres"]][["isgood"]]){ + figs_found = TRUE + }else{ + uiele = current_ele[["plotres"]][["msgs"]] + } + } + + if(figs_found){ + + pvw = state[["MC"]][["formatting"]][["preview"]][["width"]] + pvh = state[["MC"]][["formatting"]][["preview"]][["height"]] + pv_div_style = paste0("height:",pvh,";width:",pvw,";display:inline-block;vertical-align:top") + + output_type = state[["CTS"]][["ui"]][["switch_output"]] + if(output_type == "report"){ + uiele = + div(style=pv_div_style, + plotOutput( + NS(id, "ui_res_tc_figure_ggplot"), + width=pvw, height=pvh)) + } else { + uiele = + div(style=pv_div_style, + plotly::plotlyOutput( + NS(id, "ui_rec_tc_figure_plotly"), + width=pvw, height=pvh)) + } } } uiele}) @@ -849,32 +872,43 @@ CTS_Server <- function(id, figs_found = FALSE uiele = state[["MC"]][["errors"]][["cts_no_fig"]] - if("plotres" %in% names(current_ele)){ - if(current_ele[["plotres"]][["isgood"]]){ - figs_found = TRUE - }else{ - uiele = current_ele[["plotres"]][["msgs"]] - } + simgood = TRUE + if(is.null(current_ele[["simres"]])){ + simgood = FALSE + uiele = state[["MC"]][["errors"]][["no_sim_found"]] + } else if(!current_ele[["simres"]][["isgood"]]){ + uiele = uiele = state[["MC"]][["errors"]][["bad_sim"]] + simgood = FALSE } - if(figs_found){ - pvw = state[["MC"]][["formatting"]][["preview"]][["width"]] - pvh = state[["MC"]][["formatting"]][["preview"]][["height"]] - pv_div_style = paste0("height:",pvh,";width:",pvw,";display:inline-block;vertical-align:top") - - output_type = state[["CTS"]][["ui"]][["switch_output"]] - if(output_type == "report"){ - uiele = - div(style=pv_div_style, - plotOutput( - NS(id, "ui_res_events_figure_ggplot"), - width=pvw, height=pvh)) - } else { - uiele = - div(style=pv_div_style, - plotly::plotlyOutput( - NS(id, "ui_rec_events_figure_plotly"), - width=pvw, height=pvh)) + if(simgood){ + if("plotres" %in% names(current_ele)){ + if(current_ele[["plotres"]][["isgood"]]){ + figs_found = TRUE + }else{ + uiele = current_ele[["plotres"]][["msgs"]] + } + } + + if(figs_found){ + pvw = state[["MC"]][["formatting"]][["preview"]][["width"]] + pvh = state[["MC"]][["formatting"]][["preview"]][["height"]] + pv_div_style = paste0("height:",pvh,";width:",pvw,";display:inline-block;vertical-align:top") + + output_type = state[["CTS"]][["ui"]][["switch_output"]] + if(output_type == "report"){ + uiele = + div(style=pv_div_style, + plotOutput( + NS(id, "ui_res_events_figure_ggplot"), + width=pvw, height=pvh)) + } else { + uiele = + div(style=pv_div_style, + plotly::plotlyOutput( + NS(id, "ui_rec_events_figure_plotly"), + width=pvw, height=pvh)) + } } } uiele}) @@ -1810,25 +1844,30 @@ CTS_Server <- function(id, } # Button with CTS elements table - uiele_cts_elements_button = NULL + #uiele_cts_elements_button = NULL # Uncomment this if your cohort has a components table - #uiele_cts_elements = rhandsontable::rHandsontableOutput(NS(id, "hot_cts_elements")) - #uiele_cts_elements_button = tagList( - # shinyWidgets::dropdownButton( - # uiele_cts_elements, - # inline = FALSE, - # right = TRUE , - # size = "sm", - # circle = FALSE, - # status = "primary btn-custom-cts", - # icon = icon("layer-group", lib="font-awesome"), - # tooltip = tooltipOptions(title = state[["MC"]][["tooltips"]][["elements"]])) - #) + uiele_cts_elements = rhandsontable::rHandsontableOutput(NS(id, "hot_current_rules")) + uiele_cts_elements_button = tagList( + shinyWidgets::dropdownButton( + uiele_cts_elements, + inline = FALSE, + right = TRUE , + size = "sm", + circle = FALSE, + status = "primary btn-custom-cts", + icon = icon("layer-group", lib="font-awesome"), + tooltip = shinyWidgets::tooltipOptions(title = state[["MC"]][["tooltips"]][["elements"]])) + ) - uiele = tagList( - div(style="display:inline-block", "Place cohort name, attributes and inputs here."), + uiele_upper = tagList( + div(style="display:inline-block", + htmlOutput(NS(id, "CTS_ui_select_element"))), + div(style="display:inline-block", + htmlOutput(NS(id, "CTS_ui_text_element_name"))), + div(style="display:inline-block", + htmlOutput(NS(id, "CTS_ui_source_model"))), tags$br(), - div(style="display:inline-block", htmlOutput(NS(id, "ui_cts_msg"))) + div(style="display:inline-block", verbatimTextOutput(NS(id, "ui_cts_msg"))) ) # We only show the clip button if it's enabled @@ -1850,26 +1889,108 @@ CTS_Server <- function(id, )) # Appending the preview + # div_style = paste0("display:inline-block;vertical-align:top;", + # "width:", state[["MC"]][["formatting"]][["preview"]][["width"]], ";", + # "height: ", state[["MC"]][["formatting"]][["preview"]][["height"]]) + div_style = paste0("display:inline-block;vertical-align:top;", - "width:", state[["MC"]][["formatting"]][["preview"]][["width"]], ";", - "height: ", state[["MC"]][["formatting"]][["preview"]][["height"]]) + "width:", state[["MC"]][["formatting"]][["preview"]][["width"]]) + uiele_preview = div(style=div_style, - "Place your module cohort preview here.") + htmlOutput(NS(id, "CTS_ui_simres"))) + + + td_style ="display:inline-block;vertical-align:top;text-align:top" + # These are the different cohort building elements + # Covariates + uiele_chrt_ele_covs = + shiny::tabPanel(id=NS(id, "tab_res_chrt_ele_covs"), + title=tagList(shiny::icon("users-between-lines"), + state[["MC"]][["labels"]][["tab_chrt_ele_covs"]]), + htmlOutput(NS(id, "CTS_ui_covariates_none")), + tags$br(), + tags$table( + tags$tr( + tags$td(style=td_style, + htmlOutput(NS(id, "CTS_ui_covariates_selection")), + htmlOutput(NS(id, "CTS_ui_covariates_type")), + htmlOutput(NS(id, "CTS_ui_covariates_value")), + htmlOutput(NS(id, "CTS_ui_covariates_button")) + ), + tags$td(HTML(' '),HTML(' '),HTML(' ')), + tags$td(style=td_style, + htmlOutput(NS(id, "CTS_ui_covariates_table")) + ) + ) + ) + ) + # Rules + uiele_chrt_ele_rules = + shiny::tabPanel(id=NS(id, "tab_res_chrt_ele_rules"), + title=tagList(shiny::icon("syringe"), + state[["MC"]][["labels"]][["tab_chrt_ele_rules"]]), + tags$table( + tags$tr( + tags$td(style=td_style, + htmlOutput(NS(id, "CTS_ui_select_rule_type")), + htmlOutput(NS(id, "CTS_ui_rule_name")), + htmlOutput(NS(id, "CTS_ui_rule_condition")), + htmlOutput(NS(id, "CTS_ui_add_rule_btn")) + ), + tags$td(HTML(' '),HTML(' '),HTML(' ')), + tags$td(style=td_style, + htmlOutput(NS(id, "CTS_ui_action_dosing_state")), + htmlOutput(NS(id, "CTS_ui_action_dosing_values")), + htmlOutput(NS(id, "CTS_ui_action_dosing_times")), + htmlOutput(NS(id, "CTS_ui_action_dosing_durations")), + htmlOutput(NS(id, "CTS_ui_action_set_state_state")), + htmlOutput(NS(id, "CTS_ui_action_set_state_value")), + htmlOutput(NS(id, "CTS_ui_action_manual_code")) + ) + ) + ) + ) + # Trial + uiele_chrt_ele_trial = + shiny::tabPanel(id=NS(id, "tab_res_chrt_ele_trial"), + title=tagList(shiny::icon("chart-gantt"), + state[["MC"]][["labels"]][["tab_chrt_ele_trial"]]), + div(style="display:inline-block", + htmlOutput(NS(id, "CTS_ui_nsub"))), + div(style="display:inline-block", + htmlOutput(NS(id, "CTS_ui_visit_times"))), + div(style="display:inline-block", + htmlOutput(NS(id, "CTS_ui_trial_end"))) + ) + # Simulation Options + uiele_chrt_ele_sim = + shiny::tabPanel(id=NS(id, "tab_res_chrt_ele_sim"), + title=tagList(shiny::icon("gear"), + state[["MC"]][["labels"]][["tab_chrt_ele_sim"]]), + htmlOutput(NS(id, "CTS_ui_sim_cfg")) + ) + + uiele_chrt_ele = + shinydashboard::tabBox( + width = 10, + title = NULL, + uiele_chrt_ele_trial, + uiele_chrt_ele_rules, + uiele_chrt_ele_covs, + uiele_chrt_ele_sim + ) + uiele = tagList( - uiele, + uiele_upper, + tags$br(), uiele_preview, uiele_buttons_right, - tags$br() + tags$br(), + uiele_chrt_ele ) - - uiele = tagList( uiele, - tags$br(), - "Place module construction elements here." - ) uiele }) - #------------------------------------ # Creating reaction if a variable has been specified if(!is.null(react_state)){ @@ -1931,7 +2052,7 @@ CTS_Server <- function(id, # Removing holds remove_hold_listen <- reactive({ list( - # react_state[[id_ASM]]) + react_state[[id_ASM]], # input$button_clk_new, # input$button_clk_del, # input$button_clk_copy, @@ -2241,13 +2362,14 @@ CTS_fetch_state = function(id, id_ASM, id_MB, input, session, FM_yaml_file, MOD_ #Pulling out the current element current_ele = CTS_fetch_current_element(state) + # Adding the covariate current_ele = CTS_add_covariate(state, current_ele) # Appending any messages that were generated. msgs = c(msgs, current_ele[["cares"]][["msgs"]]) - #browser() + selected_covariate = state[["CTS"]][["ui"]][["selected_covariate"]] if(current_ele[["cares"]][["COV_IS_GOOD"]]){ state = formods::FM_set_notification(state, @@ -3200,8 +3322,8 @@ CTS_new_element = function(state){ element_object_name = paste0(state[["MC"]][["element_object_name"]], "_", state[["CTS"]][["element_cntr"]]) - def_evplot = state[["MC"]][["formatting"]][["evplot"]][["choices"]][[ - state[["MC"]][["formatting"]][["evplot"]][["default"]] + def_evplot = state[["MC"]][["formatting"]][["evplot"]][["choices"]][[ + state[["MC"]][["formatting"]][["evplot"]][["default"]] ]][["value"]] # Default for a new element: @@ -3613,7 +3735,7 @@ CTS_set_current_element = function(state, element){ if(NSTEPS_ISGOOD & TEND_ISGOOD){ code_ot = "# Output times" code_ot = c(code_ot, - paste0( ot_object_name, " = ubiquity::linspace(0,", tmp_trial_end, ",", tmp_nsteps, ')'), + paste0( ot_object_name, " = formods::linspace(0,", tmp_trial_end, ",", tmp_nsteps, ')'), "") } else { ELE_ISGOOD = FALSE diff --git a/R/MB_Server.R b/R/MB_Server.R index 1e56a84..42efb1e 100644 --- a/R/MB_Server.R +++ b/R/MB_Server.R @@ -711,7 +711,7 @@ MB_Server <- function(id, # Removing holds remove_hold_listen <- reactive({ list( - # react_state[[id_ASM]]) + react_state[[id_ASM]], # input$button_clk_new, # input$button_clk_del, # input$button_clk_copy, diff --git a/R/NCA_Server.R b/R/NCA_Server.R index dda7fa0..5f78d79 100644 --- a/R/NCA_Server.R +++ b/R/NCA_Server.R @@ -3000,7 +3000,8 @@ NCA_Server <- function(id, #------------------------------------ # Removing holds remove_hold_listen <- reactive({ - list(input$select_current_ana, + list(react_state[[id_ASM]], + input$select_current_ana, input$select_current_view) }) observeEvent(remove_hold_listen(), { diff --git a/inst/templates/CTS.yaml b/inst/templates/CTS.yaml index d2cba2c..f579ed9 100644 --- a/inst/templates/CTS.yaml +++ b/inst/templates/CTS.yaml @@ -62,7 +62,7 @@ MC: button_clk_runsim: size: "sm" block: TRUE - tooltip: "Run the current simulation." + tooltip: "Simulate or resimulate the cohort with the current rules applied." tooltip_position: "right" button_clk_update_plot: size: "sm" @@ -86,7 +86,7 @@ MC: tooltip_position: "right" button_clk_add_rule: size: "sm" - block: FALSE + block: TRUE tooltip: "Add a new rule." tooltip_position: "right" button_clk_add_cov: @@ -102,30 +102,30 @@ MC: tooltip_position: "bottom" placeholder: "examples: TRUE will run the action at at every visit or (time > 0) & (Ac < 10) will be more selective." action_dosing_state: - width: 200 + width: 400 action_dosing_values: - width: 200 + width: 400 placeholder: "c(1, 1, 1)" tooltip: "Expression defining dosing amounts that will evaluate as a numeric vector of numbers." action_dosing_times: - width: 200 + width: 400 placeholder: "c(0, 7, 14)" tooltip: "Expression defining dosing times that will evaluate as a numeric vector of numbers." tooltip_position: "bottom" action_dosing_durations: - width: 200 + width: 400 placeholder: "c(0, 0, 0)" tooltip: "Expression containing dosing duration that will evaluate as a numeric vector of numbers (zeros for bolus dosing)." tooltip_position: "bottom" action_set_state_state: - width: 200 + width: 400 action_set_state_value: - width: 200 + width: 400 placeholder: "A value like 20 or an expression in terms of a system element such as Ac/2" tooltip: "An expression that evaluates to a new number." action_manual_code: - width: 200 - height: 75 + width: 400 + height: 200 placeholder: |- SI_interval_ev = etRbind(SI_interval_ev, et(cmt = 'Ac', @@ -135,7 +135,7 @@ MC: time = time)) tooltip: "Expression with code to manually update the event table." rule_type: - width: 100 + width: 300 options: dose: choice: "Dosing" @@ -185,13 +185,13 @@ MC: covariates: none_found: "There were no coviaraites found in this model" selected_covariate: - width: 150 + width: 200 tooltip: "Pick covariate to define." tooltip_position: "right" rule_name: - width: 150 + width: 300 placeholder: "first_dose" - tooltip: "This is a unique identifier for the current rule. It should start witha letter and can contain letters, numbers and underscores." + tooltip: "This is a unique identifier for the current rule. It should start with a letter and can contain letters, numbers and underscores." tooltip_position: "bottom" tc_dim: width: 100 @@ -251,7 +251,7 @@ MC: current_element: NULL # "Select cohort" element_name : NULL # "cohort name" save_btn: "Save" - runsim_btn: "Run Simulation" + runsim_btn: "Simulate Cohort" update_plot_btn: "Update Plots" clip_btn: "Code" copy_btn: "Copy" @@ -282,6 +282,10 @@ MC: tab_res_tc_figure: "Timecourse" tab_res_events_figure: "Events" tab_sim_env: "Simulation Environment" + tab_chrt_ele_covs: "Covariates" + tab_chrt_ele_rules: "Create Rules" + tab_chrt_ele_trial: "Trial Options" + tab_chrt_ele_sim: "Simulation Options" errors: no_sim_found: "You need to run the simulation first." bad_sim: "There was a problem with the simulation." @@ -289,7 +293,7 @@ MC: tooltips: # Set to FALSE to disable tool tips for this module include: TRUE - elements: "Show cohort components" + elements: "Show cohort rules" show_code: "Show cohort code" # Set urls to NULL to disable the icon links. url_manual: "https://ruminate.ubiquity.tools/articles/clinical_trial_simulation.html#example-manual-code-evaluation" @@ -414,7 +418,7 @@ MC: } covariate_generation: tooltip_position: "right" - width: 150 + width: 200 # These are the types of covariates that can be constructed. You should # only change the placeholder, choice, and tooltip options. The rest are used # internally and should not be changed. diff --git a/inst/templates/CTS_module_components.R b/inst/templates/CTS_module_components.R index 38bc045..c8c3166 100644 --- a/inst/templates/CTS_module_components.R +++ b/inst/templates/CTS_module_components.R @@ -126,13 +126,12 @@ ui <- dashboardPage( ), fluidRow( box(title="Current Rules", - "ui_cts_save_btn", - htmlOutput(NS("CTS", "ui_cts_runsim_btn")), "hot_current_rules", rhandsontable::rHandsontableOutput(NS("CTS", "hot_current_rules")), width=12)), fluidRow( box(title="Simulation Results", "CTS_ui_simres", + tags$br(), htmlOutput(NS("CTS", "CTS_ui_simres")) , width=12)), fluidRow( box(title="Configuration", diff --git a/inst/templates/ruminate_devel.R b/inst/templates/ruminate_devel.R index 7f9da23..ec46682 100644 --- a/inst/templates/ruminate_devel.R +++ b/inst/templates/ruminate_devel.R @@ -21,6 +21,7 @@ DW.yaml = system.file(package="formods", "templates", "DW.yaml") FG.yaml = system.file(package="formods", "templates", "FG.yaml") MB.yaml = system.file(package="ruminate", "templates", "MB.yaml") NCA.yaml = system.file(package="ruminate", "templates", "NCA.yaml") +CTS.yaml = system.file(package="ruminate", "templates", "CTS.yaml") # Making sure that the deployed object is created if(!exists("deployed")){ @@ -48,6 +49,7 @@ CSS <- " " #https://fontawesome.com/icons?from=io +#https://fontawesome.com/search?o=r&m=free logo_url = "https://raw.githubusercontent.com/john-harrold/ruminate/main/man/figures/logo.png" data_url = @@ -89,11 +91,12 @@ ui <- shinydashboard::dashboardPage( shinydashboard::menuItem("Load/Save", tabName="loadsave", icon=icon("arrow-down-up-across-line")) , - shinydashboard::menuItem("Transform Data", tabName="wrangle", icon=icon("shuffle")), - shinydashboard::menuItem("Visualize", tabName="plot", icon=icon("chart-line")), - shinydashboard::menuItem("NCA", tabName="nca", icon=icon("chart-area")), - shinydashboard::menuItem("Models", tabName="model", icon=icon("trowel-bricks")), - shinydashboard::menuItem("App Info", tabName="sysinfo", icon=icon("book-medical")) + shinydashboard::menuItem("Transform Data", tabName="wrangle", icon=icon("shuffle")), + shinydashboard::menuItem("Visualize", tabName="plot", icon=icon("chart-line")), + shinydashboard::menuItem("NCA", tabName="nca", icon=icon("chart-area")), + shinydashboard::menuItem("Models", tabName="model", icon=icon("trowel-bricks")), + shinydashboard::menuItem("Trial Simulator", tabName="trials", icon=icon("laptop-medical")), + shinydashboard::menuItem("App Info", tabName="sysinfo", icon=icon("book-medical")) ) ), shinydashboard::dashboardBody( @@ -113,6 +116,12 @@ ui <- shinydashboard::dashboardPage( column(width=12, htmlOutput(NS("MB", "MB_ui_compact"))))) ), + shinydashboard::tabItem(tabName="trials", + shinydashboard::box(title="Define and Simulate Cohorts", width=12, + fluidRow( + column(width=12, + htmlOutput(NS("CTS", "CTS_ui_compact"))))) + ), shinydashboard::tabItem(tabName="loadsave", # shinydashboard::box(title=NULL, width=12, shinydashboard::tabBox( @@ -134,7 +143,7 @@ ui <- shinydashboard::dashboardPage( class = "wrapfig", src = logo_url, width = 150, - alt = "formods logo" ), + alt = "ruminate logo" ), intro_text )) ), @@ -259,6 +268,11 @@ server <- function(input, output, session) { MOD_yaml_file = MB.yaml, FM_yaml_file = formods.yaml) + ruminate::CTS_Server(id="CTS", id_ASM = "ASM", + deployed = deployed, + react_state = react_FM, + MOD_yaml_file = CTS.yaml, + FM_yaml_file = formods.yaml) } shinyApp(ui, server) diff --git a/vignettes/deployment.Rmd b/vignettes/deployment.Rmd index 44cf0a7..eaee22a 100644 --- a/vignettes/deployment.Rmd +++ b/vignettes/deployment.Rmd @@ -95,6 +95,8 @@ UD.yaml = system.file(package="formods", "templates", "UD.yaml") DW.yaml = system.file(package="formods", "templates", "DW.yaml") FG.yaml = system.file(package="formods", "templates", "FG.yaml") NCA.yaml = system.file(package="ruminate", "templates", "NCA.yaml") +MB.yaml = system.file(package="ruminate", "templates", "MB.yaml") +CTS.yaml = system.file(package="ruminate", "templates", "CTS.yaml") ``` Each of these controls different aspects of the module including the text displayed, icons used, certain behaviors of the app, default values, etc. These options and are described in the comments of the configuration files. To use these you need to first make a copy of the specific configuration file. For example, to customize the NCA module you would make a copy of the `NCA.yaml` file: