Validation module

Check that a dataset respect some validation expectations.

Usage

validation_ui(id, max_height = NULL, ...)

validation_server(id, data)

Arguments

id

Module's ID.

max_height

Maximum height for validation results element, useful if you have many rules.

...

Arguments passed to actionButton or uiOutput depending on display mode, you cannot use inputId/outputId, label or icon (button only).

data

a reactive function returning a data.frame.

Value

• UI: HTML tags that can be included in shiny's UI

• Server: a list with two slots:

  • status: a reactive function returning the best status available between "OK", "Failed" or "Error".

  • details: a reactive function returning a list with validation details.

Examples

#' Data and analyses validation demo
#'
#' @returns
#' @export
#'
#' @examples
#' \dontrun{
#' validation_demo_app()
#' }
validation_demo_app <- function() {
  ui <- shiny::fluidPage(
    shiny::tags$h2("Validation"),
    IDEAFilter::IDEAFilter_ui("data_filter"),
    shiny::br(),
    DT::DTOutput("data_final"),
    shiny::br(),
    validation_ui("validation_demo_2")
  )

  server <- function(input, output, session) {
    rv <- shiny::reactiveValues(
      data_original = shiny::reactive(mtcars),
      data_filtered = NULL
    )

    rv_validation <- shiny::reactiveValues(
      obs_filter = NULL,
      vars_filter = NULL
    )

    data_filter <- IDEAFilter::IDEAFilter(
      id = "data_filter",
      data = mtcars,
      verbose = TRUE
    )

    shiny::observeEvent(
      data_filter(),
      {
        rv$data_filtered <- data_filter()
      }
    )

    output$data_final <- DT::renderDT(
      data_filter()
    )

    shiny::observeEvent(
      list(
        data_filter()
      ),
      {
        to_make_validation <- data_filter()
        ## Validation
        if (!is.null(to_make_validation)) {
          validation <-
            make_validation(
              ls = validation_lib("obs_filter"),
              list(
                x = mtcars,
                y = to_make_validation
              )
            )

        rv_validation$vars_filter <- validation

        validation_server(id = "validation_demo_2", data = rv_validation$vars_filter)

        }


      }
    )

    # shiny::observeEvent(
    #   list(
    #     shiny::reactive(rv_validation$vars_filter)(),
    #     data_filter()
    #   ),
    #   {
    #     # browser()
    #     # to_make_alert <- shiny::isolate(rv_validation$vars_filter)
    #     to_make_alert <- shiny::reactive(rv_validation$vars_filter)()
    #     if (!is.null(rv_validation$vars_filter)) {
    #       validation_server(id = "validation_demo_2", data = to_make_alert)
    #     }
    #   }
    # )
  }
  shiny::shinyApp(ui, server)
}


#' Title
#'
#' @returns
#' @export
#'
#' @examples
#' validation_nr_demo_app()
validation_nr_demo_app <- function() {
  ui <- shiny::fluidPage(
    shiny::tags$h2("Validation"),
    shiny::br(),
    validation_ui("validation_demo_1", max_height = "30px"),
    shiny::br(),
    validation_ui("validation_demo_2")
  )

  server <- function(input, output, session) {
    df_original <- mtcars

    df_obs <- mtcars |> dplyr::filter(mpg > 20)

    df_vars <- df_obs[1:6]

    val1 <- purrr::map2(
      .x = validation_lib()[1],
      .y = list(list(x = df_original, y = df_obs)),
      make_validation
    )

    val2 <- make_validation(
      ls = validation_lib()[[2]],
      list(x = df_original, y = df_vars)
    )

    validation_server(id = "validation_demo_1", data = val1)

    validation_server(id = "validation_demo_2", data = val2)
  }
  shiny::shinyApp(ui, server)
}