Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Jump to bottom

Feature branch PR #1253

Merged
merged 231 commits into from
Aug 13, 2024
Merged

Feature branch PR #1253

merged 231 commits into from
Aug 13, 2024

Conversation

gogonzo
Copy link
Contributor

@gogonzo gogonzo commented Jun 27, 2024 •
edited by averissimo
Loading

Closes #669 #860 insightsengineering/teal.slice#62 #1228

  • needs teal.slice branch 669_insertUI@main

to check:

ddl app 
options(
  teal.log_level = "TRACE",
  teal.show_js_log = TRUE,
  # teal.bs_theme = bslib::bs_theme(version = 5),
  shiny.bookmarkStore = "server"
)
library(scda)
pkgload::load_all("teal")
# pkgload::load_all("teal.slice")

data <- teal_data_module(
  ui = function(id) {
    ns <- NS(id)
    tagList(
      textInput(ns("username"), label = "Username"),
      passwordInput(ns("password"), label = "Password"),
      actionButton(ns("submit"), label = "Submit")
    )
  },
  server = function(id, ...) {
    moduleServer(id, function(input, output, session) {
      eventReactive(input$submit, {
        data <- teal_data() |>
          within(
            {
              logger::log_trace("Loading data")
              ADSL <- scda::synthetic_cdisc_data("latest")$adsl
              ADTTE <- scda::synthetic_cdisc_data("latest")$adtte
              iris <- iris
            },
            username = input$username,
            password = input$password
          )

        join_keys(data) <- default_cdisc_join_keys[c("ADSL", "ADTTE")]

        data
      })
    })
  }
)

app <- teal::init(
  data = data,
  modules = modules(
    teal.modules.general::tm_data_table("Data Table"),
    example_module("Example Module", datanames = "ADTTE"),
    module(
      ui = function(id) {
        ns <- NS(id)
        tagList(
          tableOutput(ns("filter_summary"))
        )
      },
      server = function(id, datasets) {
        moduleServer(id, function(input, output, session) {
          output$filter_summary <- renderTable({
            datasets$get_filter_overview(datanames = datasets$datanames())
          })
        })
      }
    )
  ),
  filter = teal_slices(
    teal_slice("ADSL", "SEX"),
    teal_slice("ADSL", "AGE", selected = c(18L, 65L)),
    module_specific = TRUE,
    mapping = list(
      global_filters = "ADSL AGE",
      `Example Module` = "ADSL SEX"
    )
  )
)

shinyApp(app$ui, app$server)
teal as a module 
options(
  teal.log_level = "TRACE",
  teal.show_js_log = TRUE,
  # teal.bs_theme = bslib::bs_theme(version = 5),
  shiny.bookmarkStore = "server"
)
library(scda)
pkgload::load_all("teal")
# pkgload::load_all("teal.slice")

ui_data <- function(id) {
  ns <- NS(id)
  tagList(
    textInput(ns("username"), label = "Username"),
    passwordInput(ns("password"), label = "Password"),
    actionButton(ns("submit"), label = "Submit")
  )
}
srv_data <- function(id, ...) {
  moduleServer(id, function(input, output, session) {
    eventReactive(input$submit, {
      data <- teal_data() |>
        within(
          {
            logger::log_trace("Loading data")
            ADSL <- scda::synthetic_cdisc_data("latest")$adsl
            ADTTE <- scda::synthetic_cdisc_data("latest")$adtte
            iris <- iris
          },
          username = input$username,
          password = input$password
        )

      join_keys(data) <- default_cdisc_join_keys[c("ADSL", "ADTTE")]

      data
    })
  })
}

modules <- modules(
  teal.modules.general::tm_data_table("Data Table"),
  example_module("Example Module", datanames = "ADTTE"),
  module(
    ui = function(id) {
      ns <- NS(id)
      tagList(
        tableOutput(ns("filter_summary"))
      )
    },
    server = function(id, datasets) {
      moduleServer(id, function(input, output, session) {
        output$filter_summary <- renderTable({
          datasets$get_filter_overview(datanames = datasets$datanames())
        })
      })
    }
  )
)

filter <- teal_slices(
  teal_slice("ADSL", "SEX"),
  teal_slice("ADSL", "AGE", selected = c(18L, 65L)),
  module_specific = TRUE,
  mapping = list(
    global_filters = "ADSL AGE",
    `Example Module` = "ADSL SEX"
  )
)

shinyApp(
  ui = function(request) {
    fluidPage(
      ui_data("data"),
      ui_teal_1.0(id = "teal", modules = modules)
    )
  },
  server = function(input, output, session) {
    data_rv <- srv_data("data", data = data, modules = modules, filter = filter)
    srv_teal_1.0(id = "teal", data = data_rv, modules = modules, filter = filter)
  }
)

Example transformers

Run one or more of the chunks below and use with example_module(transformer = list(...))

Using it on other modules needs a redefinition of the module with extra transformer argument. That is it.

Full example extending `tmg::tm_g_scatterplot` to support transformers 
options(
  teal.log_level = "TRACE",
  teal.log_layout = paste(
    "{crayon::bold(logger::colorize_by_log_level(level, levelr))}",
    "{crayon::silver('from')} {namespace}",
    "{crayon::silver(crayon::italic(format(time, \"[%Y-%m-%d %H:%M:%S]\")))}",
    "{logger::grayscale_by_log_level(msg, levelr)}"
  ),
  teal.show_js_log = TRUE,
  # teal.bs_theme = bslib::bs_theme(version = 5),
  shiny.bookmarkStore = "server"
)

pkgload::load_all("../teal")

# Tranformer definition -------------------------------------------------------

transformer_head <- teal_data_module(
  label = "Keep first half of datasets",
  ui = function(id) actionButton(NS(id, "button"), "Click to keep first half"),
  server = function(id, data) {
    moduleServer(id, function(input, output, session) {
      button_count <- reactive({
        tryCatch(req(input$button), error = function(e) 0)
      })
      data_new <- reactive({
        data_out <- data()
        if (button_count() %% 2 == 0) {
          updateActionButton(session, "button", label = "Click to keep first half")
          data_out # do nothing
        } else {
          updateActionButton(session, "button", label = "Click to restore full dataset")
          Reduce(
            function(x, name) within(x, dat_ref <- head(dat_ref, n = NROW(dat_ref) / 2), dat_ref = as.name(name)),
            init = data_out,
            teal.data::datanames(data_out)
          )
        }
      })
    })
  }
)

my_transformers <- list(transformer_head)

# Transformer modules definition ----------------------------------------------

data <- teal_data_module(
  ui = function(id) {
    ns <- NS(id)
    tagList(
      textInput(ns("username"), label = "Username"),
      passwordInput(ns("password"), label = "Password"),
      actionButton(ns("submit"), label = "Submit")
    )
  },
  server = function(id, ...) {
    moduleServer(id, function(input, output, session) {
      eventReactive(input$submit, {
        data <- teal_data() |>
          within(
            {
              logger::log_trace("Loading data")
              ADSL <- teal.data::rADSL
              ADTTE <- teal.data::rADTTE
              iris <- iris
              
              CO2 <- CO2
              factors <- names(Filter(isTRUE, vapply(CO2, is.factor, logical(1L))))
              CO2[factors] <- lapply(CO2[factors], as.character)
            },
            username = input$username,
            password = input$password
          )
        join_keys(data) <- default_cdisc_join_keys[c("ADSL", "ADTTE")]
        teal.data::datanames(data) <- c("ADSL", "ADTTE", "iris", "CO2")
        data
      })
    })
  }
)

tt_tm_g_scatterplot <- function(..., transformers = list()) {
  mod <- teal.modules.general::tm_g_scatterplot(...)
  mod$transformers = transformers
  mod
}

library(teal.transform)
library(teal.widgets)
library(ggplot2)

init(
  data = data,
  modules = tt_tm_g_scatterplot(
    label = "Scatterplot Choices",
    transformers = my_transformers,
    x = data_extract_spec(
      dataname = "CO2",
      select = select_spec(
        label = "Select variable:",
        choices = variable_choices("CO2", c("conc", "uptake")),
        selected = "conc",
        multiple = FALSE,
        fixed = FALSE
      )
    ),
    y = data_extract_spec(
      dataname = "CO2",
      select = select_spec(
        label = "Select variable:",
        choices = variable_choices("CO2", c("conc", "uptake")),
        selected = "uptake",
        multiple = FALSE,
        fixed = FALSE
      )
    ),
    color_by = data_extract_spec(
      dataname = "CO2",
      select = select_spec(
        label = "Select variable:",
        choices = variable_choices(
          "CO2",
          c("Plant", "Type", "Treatment", "conc", "uptake")
        ),
        selected = NULL,
        multiple = FALSE,
        fixed = FALSE
      )
    ),
    size_by = data_extract_spec(
      dataname = "CO2",
      select = select_spec(
        label = "Select variable:",
        choices = variable_choices("CO2", c("conc", "uptake")),
        selected = "uptake",
        multiple = FALSE,
        fixed = FALSE
      )
    ),
    row_facet = data_extract_spec(
      dataname = "CO2",
      select = select_spec(
        label = "Select variable:",
        choices = variable_choices("CO2", c("Plant", "Type", "Treatment")),
        selected = NULL,
        multiple = FALSE,
        fixed = FALSE
      )
    ),
    col_facet = data_extract_spec(
      dataname = "CO2",
      select = select_spec(
        label = "Select variable:",
        choices = variable_choices("CO2", c("Plant", "Type", "Treatment")),
        selected = NULL,
        multiple = FALSE,
        fixed = FALSE
      )
    ),
    ggplot2_args = ggplot2_args(
      labs = list(subtitle = "Plot generated by Scatterplot Module")
    )
  ),
  filter = teal_slices(
    teal_slice("ADSL", "SEX"),
    teal_slice("ADSL", "AGE", selected = c(18L, 65L))
  )
) |>
  shiny::runApp()

Individual transformer definitions

ANL merge transform 
transformer_merge_anl <- teal_data_module(
  label = "Merge ANL",
  ui = function(id) {
    ns <- NS(id)
    tagList(
      div("UI for merge transform"),
      teal.widgets::optionalSelectInput(ns("merge_a"), "Merge A", choices = NULL),
      teal.widgets::optionalSelectInput(ns("merge_b"), "Merge B", choices = NULL)
    )
  },
  server = function(id, data) {
    checkmate::assert_class(data, "reactive")
    moduleServer(id, function(input, output, session) {
      iv <- shinyvalidate::InputValidator$new()
      iv$add_rule("merge_a", shinyvalidate::sv_required("Please select dataset A"))
      iv$add_rule("merge_b", shinyvalidate::sv_required("Please select dataset B"))
      iv$enable()

      reactive_datanames <- reactive({
        req(data())
        teal.data::datanames(data())
      })
      observeEvent(reactive_datanames(), {
        selected_a <- isolate(input$merge_a)
        if (identical(selected_a, "")) selected_a <- restoreInput(session$ns("merge_a"), NULL)
        teal.widgets::updateOptionalSelectInput(
          session = session,
          inputId = "merge_a",
          choices = reactive_datanames(),
          selected = restoreInput(session$ns("merge_a"), selected_a)
        )

        selected_b <- isolate(input$merge_b)
        if (identical(selected_b, "")) selected <- restoreInput(session$ns("merge_b"), NULL)
        teal.widgets::updateOptionalSelectInput(
          session = session,
          inputId = "merge_b",
          choices = reactive_datanames(),
          selected = restoreInput(session$ns("merge_b"), selected_b)
        )
      })

      merge_a <- reactive(input$merge_a)
      merge_b <- reactive(input$merge_b)

      reactive({
        logger::log_info("re-merging transform")
        new_data <- within(
          data(),
          ANL <- dplyr::left_join(merge_a, merge_b),
          merge_a = tryCatch(as.name(merge_a()), error = function(e) as.name("DatasetA")),
          merge_b = tryCatch(as.name(merge_b()), error = function(e) as.name("DatasetA"))
        )
        teal.data::datanames(new_data) <- c(teal.data::datanames(new_data), "ANL")

        logger::log_info("Number of rows in ADSL: {nrow(data()[['ADSL']])}")

        new_data
      })
    })
  }
)
Head transformer 
transformer_head <- teal_data_module(
  label = "Keep first half of datasets",
  ui = function(id) actionButton(NS(id, "button"), "Click to keep first half"),
  server = function(id, data) {
    moduleServer(id, function(input, output, session) {
      button_count <- reactive({
        tryCatch(req(input$button), error = function(e) 0)
      })
      data_new <- reactive({
        data_out <- data()
        if (button_count() %% 2 == 0) {
          updateActionButton(session, "button", label = "Click to keep first half")
          data_out # do nothing
        } else {
          updateActionButton(session, "button", label = "Click to restore full dataset")
          Reduce(
            function(x, name) within(x, dat_ref <- head(dat_ref, n = NROW(dat_ref) / 2), dat_ref = as.name(name)),
            init = data_out,
            teal.data::datanames(data_out)
          )
        }
      })
    })
  }
)
Error transformer 
transformer_error <- teal_data_module(
  label = "Add (optional) error",
  ui = function(id) checkboxInput(NS(id, "add_error"), "Add error?", value = FALSE),
  server = function(id, data) {
    moduleServer(id, function(input, output, session) {
      add_error_rv <- reactive(tryCatch(req(input$add_error), error = function(e) FALSE))

      reactive({
        if (add_error_rv()) {
          data() |> within(stop("Manual error here"))
        } else {
          data()
        }
      })
    })
  }
)
Dummy transformer 
transformer_dummy <- teal_data_module(
  label = "Dummy",
  ui = function(id) div("(does nothing)"),
  server = function(id, data) {
    moduleServer(id, function(input, output, session) data)
  }
)

gogonzo and others added 18 commits June 26, 2024 08:49
@gogonzo
WIP
e0405b9 
- reactive data
- initialize modules ui
@gogonzo
remove bslib::card
5ba1325
@gogonzo
minor changes
74d4cd9
@gogonzo
call modules and filter-panel
8c18a37
@gogonzo
comments
81ba5aa
@gogonzo
linking teal_data -> filter panel -> teal_module
e434c6d
@gogonzo
passing filters to module-specific
719a28e
@gogonzo
missing stuff from srv_teal
e84caed
@gogonzo
Merge remote-tracking branch 'origin/main' into 669_insertUI@main
7621ae1
@gogonzo
todos
916e1f7
@vedhav
feat: add teal_data_module inside a popup during init
0c42abe
@gogonzo
Merge branch 'data_module_popup@669_insertUI@main' into 669_insertUI@…
91e8c9a 
…main
@gogonzo
comment
7758a4f
@gogonzo
another todo
bd53634
@vedhav
fix: allow the popup modal to be closed when opened again
fc6e27a
@vedhav
feat: add the filter_hamburger
080e863
@vedhav
fix: append reporter module when reporter is used in any of the modules
a599d8d
@vedhav
chore: remove the todo, reporter modules is appended in init
5f98a9a
@github-actions GitHub Actions
Copy link
Contributor

github-actions bot commented Jun 27, 2024 •
edited
Loading

✅ All contributors have signed the CLA
Posted by the CLA Assistant Lite bot.

@vedhav vedhav force-pushed the 669_insertUI@main branch from b101156 to 8e78255 Compare June 27, 2024 09:06
averissimo and others added 8 commits August 9, 2024 15:45
@averissimo
tests: add test for expected behavior on fallback and recovery
c12b083
@averissimo
tests: update tests with modified transform code
cbb3070
@gogonzo
All datanames to transform@669 insert UI@main (#1302)
202dbbd 
Changed the way how datanames are passed between teal_data instances
@vedhav @m7pr @donyunardi
Extend teal transform vignette (#1301)
ba83d53 
Changes:

1. Adds the section on how to place the transform UI in the custom
position inside the module.
2. Formats the `_pkgdown.yml` file (No change made to the file, just
styling)
3. Extend the `example_module()` to handle the selection when datasets
change (This can happen when using DDL to change datasets completely,
such an example will be added to `teal.gallery`)

---------

Signed-off-by: Vedha Viyash <[email protected]>
Co-authored-by: Marcin <[email protected]>
Co-authored-by: m7pr <[email protected]>
Co-authored-by: Dony Unardi <[email protected]>
@vedhav
chore: make teal_data_utilities docs internal
20ff375
@vedhav
chore: fix spellcheck
174577a
@gogonzo
update NEWS with issues reference
971dd59
@averissimo
Improves datanames error message (#1297)
a6b21f8 
Part of #1253

### Changes description

- `check_modules_datanames` returns a string and HTML generator for:
    - **string**: to be used with logger 
    - **HTML**: function to be used in teal UI
- Message is generated in the same way. This adds complexity, but is
consistent
- `c("one", "two", "three")` renders as "one, two and three" (note the
comma and `and`)
- In the module context it doesn't show the current module label

<details>

<summary>Sample app</summary>

```r
options(
  teal.log_level = "TRACE",
  teal.show_js_log = TRUE,
  # teal.bs_theme = bslib::bs_theme(version = 5),
  shiny.bookmarkStore = "server"
)

pkgload::load_all("teal.data")
pkgload::load_all("teal.slice")
pkgload::load_all("teal")

my_transformers <- list(
  teal_transform_module(
    label = "reactive ADSL",
    ui = function(id) {
      ns <- NS(id)
      tagList(
        div("Some UI for transform (merge)"),
        actionButton(ns("btn"), "Reload data")
      )
    },
    server = function(id, data) {
      moduleServer(id, function(input, output, session) {
        eventReactive(input$btn, {
          data()
        })
      })
    }
  ),
  teal_transform_module(
    label = "Keep first 6 from IRIS",
    ui = function(id) {
      ns <- NS(id)
      div(
        span("Some UI for transform (1)"),
        textInput(ns("obs"), label = "Number of rows", value = 6)
      )
    },
    server = function(id, data) {
      moduleServer(id, function(input, output, session) {
        reactive({
          req(data())
          obs <- as.numeric(input$obs)
          if (!is.finite(obs)) stop("NOT NUMERIC.")
          within(data(), iris <- head(iris, n), n = as.numeric(input$obs))
        })
      })
    }
  ),
  teal_transform_module(
    label = "Keep first 6 from ADTTE",
    ui = function(id) div("Some UI for transform 2"),
    server = function(id, data) {
      moduleServer(id, function(input, output, session) {
        reactive({
          req(data())
          within(data(), ADTTE <- head(ADTTE))
        })
      })
    }
  )
)

data <- teal_data_module(
  once = FALSE,
  ui = function(id) {
    ns <- NS(id)
    tagList(
      numericInput(ns("obs"), "Number of observations to show", 1000),
      actionButton(ns("submit"), label = "Submit")
    )
  },
  server = function(id, ...) {
    moduleServer(id, function(input, output, session) {
      logger::log_trace("example_module_transform2 initializing.")
      eventReactive(input$submit, {
        data <- teal_data() |>
          within(
            {
              logger::log_trace("Loading data")
              ADSL <- head(teal.data::rADSL, n = n)
              ADTTE <- teal.data::rADTTE
              iris <- iris
              
              CO2 <- CO2
              factors <- names(Filter(isTRUE, vapply(CO2, is.factor, logical(1L))))
              CO2[factors] <- lapply(CO2[factors], as.character)
            },
            n = as.numeric(input$obs)
          )
        join_keys(data) <- default_cdisc_join_keys[c("ADSL", "ADTTE")]
        teal.data::datanames(data) <- c("ADSL", "ADTTE", "iris", "CO2")
        data
      })
    })
  }
)

teal::init(
  data = data,
  modules = list(
    example_module("mod-1", datanames = "all"),
    example_module("mod-2", transformers = my_transformers, datanames = c("ADSL", "ADTTE", "iris", "elo")),
    modules(
      label = "sub-modules",
      example_module("mod-2-sub1", transformers = my_transformers, datanames = c("ADSL", "ADTTE", "iris", "elo", "elo2")),
      example_module("mod-2-sub2", transformers = my_transformers, datanames = c("ADSL", "ADTTE", "iris", "elo"))
    ),
    example_module("mod-2", transformers = my_transformers[2:3])
  ),
  filter = teal_slices(
    teal_slice("ADSL", "SEX"),
    teal_slice("ADSL", "AGE", selected = c(18L, 65L))
  )
) |>
  runApp()
```

</details>


![image](https://github.com/user-attachments/assets/9a6c09a6-2ce4-4c2b-b7f6-0cce7ab8670c)


![image](https://github.com/user-attachments/assets/2b4a8dd1-f7e7-44f8-80d3-9cb45dd3909b)
m7pr added a commit to insightsengineering/teal.data that referenced this pull request Aug 12, 2024
@m7pr @averissimo
@github-actions @dependabot-preview @gogonzo
Add topological_sort() to datanames(teal_data()) and also extend …
d240c22 
…`datanames()` with parent dataset when it is provided in `join_keys` (#319)

Part of insightsengineering/teal#1253

This PR introduced below changes
- `teal_data()` constructor does not put `names(join_keys)` in default
`datanames(teal_data())` to maintain consistency with other features,
where we do not allow `datanames()` to contain names of objects that do
not exist in `@env`
- `datanames()` now sorts names topologically based on provided
`join_keys()`
- each time `datanames()` and `join_keys()` is overwritten the sort is
applied to `teal_data()@datanames`
- provided few more tests
- adjusted 2 tests that assumed extraction of `datanames()` from
`join_keys` is fine - but it's not right now as we do not allow
`datanames()` to contain names of objects that do not exists in `@env`

Will provide testing in this PR in teal as well
https://github.com/insightsengineering/teal/pull/1280/files

---------

Signed-off-by: Marcin <[email protected]>
Co-authored-by: André Veríssimo <[email protected]>
Co-authored-by: github-actions <41898282+github-actions[bot]@users.noreply.github.com>
Co-authored-by: 27856297+dependabot-preview[bot]@users.noreply.github.com <27856297+dependabot-preview[bot]@users.noreply.github.com>
Co-authored-by: go_gonzo <[email protected]>
@gogonzo gogonzo enabled auto-merge (squash) August 12, 2024 15:49
averissimo
averissimo approved these changes Aug 12, 2024
View reviewed changes
Copy link
Contributor

@averissimo averissimo left a comment

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Let's go!

Fixed one small error on tests

@gogonzo gogonzo merged commit 6fc5421 into main Aug 13, 2024
29 checks passed
@gogonzo gogonzo deleted the 669_insertUI@main branch August 13, 2024 03:49
@github-actions github-actions bot locked and limited conversation to collaborators Aug 13, 2024
Sign up for free to subscribe to this conversation on GitHub. Already have an account? Sign in.
Reviewers

@m7pr m7pr m7pr left review comments

@vedhav vedhav vedhav left review comments

@pawelru pawelru pawelru left review comments

@donyunardi donyunardi donyunardi left review comments

@averissimo averissimo averissimo approved these changes

Assignees
No one assigned
Labels
core
Projects
None yet
Milestone
No milestone
Development

Successfully merging this pull request may close these issues.

Remove insertUI in the teal::init
7 participants
@gogonzo @donyunardi @kumamiao @vedhav @m7pr @averissimo @pawelru