Skip to content Skip to sidebar Skip to footer

refer to user uploaded data frame shiny

Dynamic UI

So far, nosotros've seen a make clean separation between the user interface and the server role: the user interface is defined statically when the app is launched so it can't respond to anything that happens in the app. In this chapter, yous'll learn how to create dynamic user interfaces, changing the UI using code run in the server function.

There are three cardinal techniques for creating dynamic user interfaces:

  • Using the update family of functions to modify parameters of input controls.

  • Using tabsetPanel() to conditionally testify and hibernate parts of the user interface.

  • Using uiOutput() and renderUI() to generate selected parts of the user interface with code.

These 3 tools give you considerable power to respond to the user by modifying inputs and outputs. I'll demonstrate some of the more useful ways in which you tin use them, but ultimately you're but constrained by your creativity. At the aforementioned time, these tools can make your app substantially more difficult to reason about, so deploy them sparingly, and e'er strive to use the simplest technique that solves your problem.

Updating inputs

We'll begin with a elementary technique that allows you to modify an input after it has been created: the update family of functions. Every input command, e.thou.textInput(), is paired with an update function, eastward.g.updateTextInput(), that allows y'all to alter the control after it has been created.

Accept the example in the code below, with the results shown in Figure x.1. The app has two inputs that control the range (the min and max) of another input, a slider. The cardinal idea is to employ observeEvent() 32 to trigger updateSliderInput() whenever the min or max inputs change.

                              ui                <-                fluidPage                (                numericInput                (                "min",                "Minimum",                0                ),                numericInput                (                "max",                "Maximum",                3                ),                sliderInput                (                "due north",                "n", min                =                0, max                =                3, value                =                i                )                )                server                <-                function                (                input,                output,                session                )                {                observeEvent                (                input                $                min,                {                updateSliderInput                (inputId                =                "n", min                =                input                $                min                )                }                )                observeEvent                (                input                $                max,                {                updateSliderInput                (inputId                =                "northward", max                =                input                $                max                )                }                )                }                          

The update functions look a piddling dissimilar to other Shiny functions: they all accept name of the input (as a cord) as the the inputId argument33. The remaining arguments represent to the arguments to the input constructor that can exist modified after creation.

To help you go the hang of the update functions, I'll testify a couple more simple examples, then we'll dive into a more complicated example written report using hierarchical select boxes, and finish off by discussing the problem of round references.

Simple uses

The simplest uses of the update functions are to provide small conveniences for the user. For example, maybe you want to make information technology easy to reset parameters back to their initial value. The post-obit snippet shows how yous might combine an actionButton(), observeEvent() and updateSliderInput(), with the output shown in Effigy x.2.

                                  ui                  <-                  fluidPage                  (                  sliderInput                  (                  "x1",                  "x1",                  0, min                  =                  -                  10, max                  =                  10                  ),                  sliderInput                  (                  "x2",                  "x2",                  0, min                  =                  -                  10, max                  =                  10                  ),                  sliderInput                  (                  "x3",                  "x3",                  0, min                  =                  -                  10, max                  =                  x                  ),                  actionButton                  (                  "reset",                  "Reset"                  )                  )                  server                  <-                  office                  (                  input,                  output,                  session                  )                  {                  observeEvent                  (                  input                  $                  reset,                  {                  updateSliderInput                  (inputId                  =                  "x1", value                  =                  0                  )                  updateSliderInput                  (inputId                  =                  "x2", value                  =                  0                  )                  updateSliderInput                  (inputId                  =                  "x3", value                  =                  0                  )                  }                  )                  }                              

A similar awarding is to tweak the text of an activeness button then you know exactly what it's going to do. Effigy 10.3 shows the results of the code below.

                                  ui                  <-                  fluidPage                  (                  numericInput                  (                  "n",                  "Simulations",                  10                  ),                  actionButton                  (                  "simulate",                  "Simulate"                  )                  )                  server                  <-                  function                  (                  input,                  output,                  session                  )                  {                  observeEvent                  (                  input                  $                  n,                  {                  label                  <-                  paste0                  (                  "Simulate ",                  input                  $                  n,                  " times"                  )                  updateActionButton                  (inputId                  =                  "simulate", characterization                  =                  characterization                  )                  }                  )                  }                              

There are many ways to use update functions in this mode; be on the look out for ways to give more information to the user when you are working on sophisticated applications. A specially important awarding is making it easier to select from a long listing of possible options, through step-by-step filtering. That's often a trouble for "hierarchical select boxes".

Hierarchical select boxes

A more complicated, only particularly useful, application of the update functions is to permit interactive drill down across multiple categories. I'll illustrate their usage with some imaginary data for a sales dashboard that comes from https://www.kaggle.com/kyanyoga/sample-sales-data.

                                  sales                  <-                  vroom                  ::                  vroom                  (                  "sales-dashboard/sales_data_sample.csv", col_types                  =                  list                  (                  ), na                  =                  ""                  )                  sales                  %>%                  select                  (                  TERRITORY,                  CUSTOMERNAME,                  ORDERNUMBER,                  everything                  (                  )                  )                  %>%                  conform                  (                  ORDERNUMBER                  )                  #> # A tibble: 2,823 × 25                  #>    TERRITORY CUSTOMERNAME   ORDERNUMBER QUANTITYORDERED PRICEEACH ORDERLINENUMBER                  #>    <chr>     <chr>                <dbl>           <dbl>     <dbl>           <dbl>                  #>  1 NA        Online Diecas…       10100              30     100                 3                  #>  2 NA        Online Diecas…       10100              l      67.eight               2                  #>  3 NA        Online Diecas…       10100              22      86.five               iv                  #>  4 NA        Online Diecas…       10100              49      34.5               ane                  #>  5 EMEA      Blauer Encounter Au…       10101              25     100                 iv                  #>  6 EMEA      Blauer See Au…       10101              26     100                 1                  #>  seven EMEA      Blauer Encounter Au…       10101              45      31.ii               3                  #>  8 EMEA      Blauer See Au…       10101              46      53.8               two                  #>  9 NA        Vitachrome In…       10102              39     100                 2                  #> x NA        Vitachrome In…       10102              41      50.1               1                  #> # … with two,813 more rows, and xix more than variables: SALES <dbl>, ORDERDATE <chr>,                  #> #   STATUS <chr>, QTR_ID <dbl>, MONTH_ID <dbl>, YEAR_ID <dbl>,                  #> #   PRODUCTLINE <chr>, MSRP <dbl>, PRODUCTCODE <chr>, Telephone <chr>,                  #> #   ADDRESSLINE1 <chr>, ADDRESSLINE2 <chr>, CITY <chr>, STATE <chr>,                  #> #   POSTALCODE <chr>, Land <chr>, CONTACTLASTNAME <chr>,                  #> #   CONTACTFIRSTNAME <chr>, DEALSIZE <chr>                              

For this demo, I'm going to focus on a natural hierarchy in the data:

  • Each territory contains customers.
  • Each customer has multiple orders.
  • Each club contains rows.

I want to create a user interface where you can:

  • Select a territory to see all customers.
  • Select a customer to run across all orders.
  • Select an order to see the underlying rows.

The essence of the UI is simple: I'll create 3 select boxes and one output tabular array. The choices for the customername and ordernumber select boxes volition be dynamically generated, then I gear up choices = NULL.

In the server office, I piece of work peak-down:

  1. I create a reactive, territory(), that contains the rows from sales that match the selected territory.

  2. Whenever territory() changes, I update the list of choices in the input$customername select box.

  3. I create some other reactive, customer(), that contains the rows from territory() that match the selected customer.

  4. Whenever customer() changes, I update the list of choices in the input$ordernumber select box.

  5. I display the selected orders in output$data.

You lot can see that organisation below:

                                  server                  <-                  role                  (                  input,                  output,                  session                  )                  {                  territory                  <-                  reactive                  (                  {                  filter                  (                  sales,                  TERRITORY                  ==                  input                  $                  territory                  )                  }                  )                  observeEvent                  (                  territory                  (                  ),                  {                  choices                  <-                  unique                  (                  territory                  (                  )                  $                  CUSTOMERNAME                  )                  updateSelectInput                  (inputId                  =                  "customername", choices                  =                  choices                  )                  }                  )                  client                  <-                  reactive                  (                  {                  req                  (                  input                  $                  customername                  )                  filter                  (                  territory                  (                  ),                  CUSTOMERNAME                  ==                  input                  $                  customername                  )                  }                  )                  observeEvent                  (                  customer                  (                  ),                  {                  choices                  <-                  unique                  (                  customer                  (                  )                  $                  ORDERNUMBER                  )                  updateSelectInput                  (inputId                  =                  "ordernumber", choices                  =                  choices                  )                  }                  )                  output                  $                  information                  <-                  renderTable                  (                  {                  req                  (                  input                  $                  ordernumber                  )                  customer                  (                  )                  %>%                  filter                  (                  ORDERNUMBER                  ==                  input                  $                  ordernumber                  )                  %>%                  select                  (                  QUANTITYORDERED,                  PRICEEACH,                  PRODUCTCODE                  )                  }                  )                  }                              

Attempt out this simple example at https://hadley.shinyapps.io/ms-update-nested, or see a more fully fleshed out awarding at https://github.com/hadley/mastering-shiny/tree/chief/sales-dashboard.

Freezing reactive inputs

Sometimes this sort of hierarchical pick can briefly create an invalid set of inputs, leading to a flicker of undesirable output. For example, consider this unproblematic app where yous select a dataset and so select a variable to summarise:

                                  ui                  <-                  fluidPage                  (                  selectInput                  (                  "dataset",                  "Cull a dataset",                  c                  (                  "pressure",                  "cars"                  )                  ),                  selectInput                  (                  "column",                  "Choose cavalcade",                  character                  (                  0                  )                  ),                  verbatimTextOutput                  (                  "summary"                  )                  )                  server                  <-                  function                  (                  input,                  output,                  session                  )                  {                  dataset                  <-                  reactive                  (                  get                  (                  input                  $                  dataset,                  "packet:datasets"                  )                  )                  observeEvent                  (                  input                  $                  dataset,                  {                  updateSelectInput                  (inputId                  =                  "column", choices                  =                  names                  (                  dataset                  (                  )                  )                  )                  }                  )                  output                  $                  summary                  <-                  renderPrint                  (                  {                  summary                  (                  dataset                  (                  )                  [[                  input                  $                  cavalcade                  ]                  ]                  )                  }                  )                  }                              

If you try out the live app at https://hadley.shinyapps.io/ms-freeze, you'll detect that when y'all switch datasets the summary output will briefly flicker. That'due south because updateSelectInput() just has an affect after all outputs and observers take run, and then in that location's temporarily a state where yous have dataset B and a variable from dataset A, so that the output contains summary(NULL).

Y'all can resolve this problem by "freezing" the input with freezeReactiveValue(). This ensures that any reactives or outputs that use the input won't be updated until the side by side total round of invalidation34.

Note that there's no need to "thaw" the input value; this happens automatically after Shiny detects that the session and server are once more in sync.

You lot might wonder when yous should utilize freezeReactiveValue(): it's actually good practice to e'er utilize it when you dynamically modify an input value. The actual modification takes some fourth dimension to flow to the browser and then dorsum to Shiny, and in the interim any reads of the value are at best wasted, and at worst lead to errors. Apply freezeReactiveValue() to tell all downstream calculations that an input value is stale and they should save their endeavour until it's useful.

Circular references

There's an important consequence nosotros need to hash out if you desire to employ the update functions to change the electric current value 35 of an input. From Shiny's perspective, using an update function to modify value is no dissimilar to the user modifying the value by clicking or typing. That ways an update part can trigger reactive updates in exactly the same way that a human can. This ways that y'all are at present stepping outside of the bounds of pure reactive programming, and you need to start worrying about circular references and infinite loops.

For instance, take the following simple app. Information technology contains a single input command and an observer that increments its value past one. Every fourth dimension updateNumericInput() runs, it changes input$northward, causing updateNumericInput() to run again, so the app gets stuck in an space loop constantly increasing the value of input$n.

You're unlikely to create such an obvious problem in your own app, but it tin can crop upward if you lot update multiple controls that depend on one another, equally in the side by side instance.

Exercises

  1. Consummate the user interface beneath with a server office that updates input$date so that you can just select dates in input$yr.

  2. Consummate the user interface below with a server function that updates input$county choices based on input$state. For an added challenge, too modify the label from "County" to "Parish" for Louisiana and "Borough" for Alaska.

                                              library                      (                      openintro, warn.conflicts                      =                      FALSE                      )                      #> Loading required package: airports                      #> Loading required parcel: cherryblossom                      #> Loading required package: usdata                      #> Registered S3 methods overwritten by 'readr':                      #>   method                    from                                            #>   as.information.frame.spec_tbl_df vroom                      #>   as_tibble.spec_tbl_df     vroom                      #>   format.col_spec           vroom                      #>   print.col_spec            vroom                      #>   impress.collector           vroom                      #>   impress.date_names          vroom                      #>   print.locale              vroom                      #>   str.col_spec              vroom                      states                      <-                      unique                      (                      county                      $                      state                      )                      ui                      <-                      fluidPage                      (                      selectInput                      (                      "state",                      "State", choices                      =                      states                      ),                      selectInput                      (                      "canton",                      "County", choices                      =                      Zilch                      )                      )                                      
  3. Complete the user interface below with a server function that updates input$country choices based on the input$continent. Utilise output$data to display all matching rows.

  4. Extend the previous app so that you can also choose to select all continents, and hence run into all countries. You'll need to add together "(All)" to the list of choices, then handle that specially when filtering.

  5. What is at the heart of the problem described at https://customs.rstudio.com/t/29307?

Dynamic visibility

The next step up in complexity is to selectively evidence and hide parts of the UI. There are more sophisticated approaches if you know a fiddling JavaScript and CSS, only there's a useful technique that doesn't require whatever extra knowledge: concealing optional UI with a tabset (as introduced in Department 6.iii.1). This is a clever hack that allows you to show and hide UI as needed, without having to re-generate information technology from scratch (as you lot'll larn in the adjacent section).

                              ui                <-                fluidPage                (                sidebarLayout                (                sidebarPanel                (                selectInput                (                "controller",                "Show", choices                =                paste0                (                "panel",                1                :                3                )                )                ),                mainPanel                (                tabsetPanel                (                id                =                "switcher",         blazon                =                "hidden",                tabPanelBody                (                "panel1",                "Panel 1 content"                ),                tabPanelBody                (                "panel2",                "Panel 2 content"                ),                tabPanelBody                (                "panel3",                "Console 3 content"                )                )                )                )                )                server                <-                function                (                input,                output,                session                )                {                observeEvent                (                input                $                controller,                {                updateTabsetPanel                (inputId                =                "switcher", selected                =                input                $                controller                )                }                )                }                          

There are ii primary ideas here:

  • Use tabset panel with subconscious tabs.
  • Utilise updateTabsetPanel() to switch tabs from the server.

This is a simple idea, simply when combined with a little creativity, it gives y'all a considerable amount of power. The following two sections illustrate a couple of small examples of how you might use it in practice.

Conditional UI

Imagine that you desire an app that allows the user to simulate from the normal, uniform, and exponential distributions. Each distribution has dissimilar parameters, so we'll need some way to show dissimilar controls for different distributions. Here, I'll put the unique user interface for each distribution in its ain tabPanel(), and and so arrange the three tabs into a tabsetPanel().

                                  parameter_tabs                  <-                  tabsetPanel                  (                  id                  =                  "params",   type                  =                  "subconscious",                  tabPanel                  (                  "normal",                  numericInput                  (                  "hateful",                  "mean", value                  =                  ane                  ),                  numericInput                  (                  "sd",                  "standard deviation", min                  =                  0, value                  =                  1                  )                  ),                  tabPanel                  (                  "uniform",                  numericInput                  (                  "min",                  "min", value                  =                  0                  ),                  numericInput                  (                  "max",                  "max", value                  =                  1                  )                  ),                  tabPanel                  (                  "exponential",                  numericInput                  (                  "rate",                  "rate", value                  =                  ane, min                  =                  0                  ),                  )                  )                              

I'll then embed that inside a fuller UI which allows the user to option the number of samples and shows a histogram of the results:

                                  ui                  <-                  fluidPage                  (                  sidebarLayout                  (                  sidebarPanel                  (                  selectInput                  (                  "dist",                  "Distribution",          choices                  =                  c                  (                  "normal",                  "uniform",                  "exponential"                  )                  ),                  numericInput                  (                  "n",                  "Number of samples", value                  =                  100                  ),                  parameter_tabs,                  ),                  mainPanel                  (                  plotOutput                  (                  "hist"                  )                  )                  )                  )                              

Note that I've carefully matched the choices in input$dist to the names of the tab panels. That makes it easy to write the observeEvent() code beneath that automatically switches controls when the distribution changes. The residue of the app uses techniques that you lot're already familiar with. See the concluding outcome in Figure x.vi.

                                  server                  <-                  role                  (                  input,                  output,                  session                  )                  {                  observeEvent                  (                  input                  $                  dist,                  {                  updateTabsetPanel                  (inputId                  =                  "params", selected                  =                  input                  $                  dist                  )                  }                  )                  sample                  <-                  reactive                  (                  {                  switch                  (                  input                  $                  dist,       normal                  =                  rnorm                  (                  input                  $                  n,                  input                  $                  mean,                  input                  $                  sd                  ),       uniform                  =                  runif                  (                  input                  $                  northward,                  input                  $                  min,                  input                  $                  max                  ),       exponential                  =                  rexp                  (                  input                  $                  n,                  input                  $                  rate                  )                  )                  }                  )                  output                  $                  hist                  <-                  renderPlot                  (                  hist                  (                  sample                  (                  )                  ), res                  =                  96                  )                  }                              

Note that the value of (e.1000.) input$mean is contained of whether or not its visible to the user. The underlying HTML control however exists; you simply tin can't see it.

Magician interface

You can as well utilize this thought to create a "wizard", a type of interface that makes it easier to collect a bunch of information by spreading it across multiple pages. Hither we embed action buttons within each "page", making it easy to go forward and dorsum. The results are shown in Figure 10.vii.

                                  ui                  <-                  fluidPage                  (                  tabsetPanel                  (                  id                  =                  "wizard",     type                  =                  "hidden",                  tabPanel                  (                  "page_1",                  "Welcome!",                  actionButton                  (                  "page_12",                  "next"                  )                  ),                  tabPanel                  (                  "page_2",                  "Just one folio to get",                  actionButton                  (                  "page_21",                  "prev"                  ),                  actionButton                  (                  "page_23",                  "next"                  )                  ),                  tabPanel                  (                  "page_3",                  "You're done!",                  actionButton                  (                  "page_32",                  "prev"                  )                  )                  )                  )                  server                  <-                  function                  (                  input,                  output,                  session                  )                  {                  switch_page                  <-                  part                  (                  i                  )                  {                  updateTabsetPanel                  (inputId                  =                  "magician", selected                  =                  paste0                  (                  "page_",                  i                  )                  )                  }                  observeEvent                  (                  input                  $                  page_12,                  switch_page                  (                  two                  )                  )                  observeEvent                  (                  input                  $                  page_21,                  switch_page                  (                  one                  )                  )                  observeEvent                  (                  input                  $                  page_23,                  switch_page                  (                  3                  )                  )                  observeEvent                  (                  input                  $                  page_32,                  switch_page                  (                  2                  )                  )                  }                              

A wizard interface portions complex UI over multiple pages. Here we demonstrate the idea with a very elementary instance, clicking side by side to accelerate to the next page. Encounter alive at <https://hadley.shinyapps.io/ms-wizard>. A wizard interface portions circuitous UI over multiple pages. Hither nosotros demonstrate the idea with a very unproblematic instance, clicking adjacent to advance to the next page. Come across alive at <https://hadley.shinyapps.io/ms-wizard>. A wizard interface portions complex UI over multiple pages. Here we demonstrate the thought with a very unproblematic instance, clicking next to advance to the next folio. See live at <https://hadley.shinyapps.io/ms-wizard>.

Figure 10.7: A wizard interface portions complex UI over multiple pages. Here we demonstrate the idea with a very simple instance, clicking next to advance to the next page. See live at https://hadley.shinyapps.io/ms-wizard.

Note the apply of the switch_page() function to reduce the amount of duplication in the server code. We'll come back to this idea in Chapter xviii, and then create a module to automate wizard interfaces in Section nineteen.iv.2.

Exercises

  1. Employ a subconscious tabset to show boosted controls just if the user checks an "advanced" bank check box.
  2. Create an app that plots ggplot(diamonds, aes(carat)) but allows the user to choose which geom to use: geom_histogram(), geom_freqpoly(), or geom_density(). Utilize a subconscious tabset to allow the user to select unlike arguments depending on the geom: geom_histogram() and geom_freqpoly() have a binwidth argument; geom_density() has a bw argument.
  3. Modify the app you created in the previous do to allow the user to choose whether each geom is shown or non (i.eastward. instead of always using one geom, they can picked 0, 1, 2, or iii). Brand sure that you tin control the binwidth of the histogram and frequency polygon independently.

Creating UI with code

Sometimes none of the techniques described above gives you the level of dynamism that you demand: the update functions only allow you to change existing inputs, and a tabset only works if you lot take a stock-still and known prepare of possible combinations. Sometimes you need to create different types or numbers of inputs (or outputs), depending on other inputs. This final technique gives you the ability to do and then.

It's worth noting that you've ever created your user interface with code, but and so far you've always done it before the app starts. This technique gives you the power to create and modify the user interface while the app is running. There are two parts to this solution:

  • uiOutput() inserts a placeholder in your ui. This leaves a "hole" that your server lawmaking tin can later make full in.

  • renderUI() is called within server() to fill in the placeholder with dynamically generated UI.

We'll see how this works with a elementary example, and so swoop into some realistic uses.

Getting started

Allow'southward begin with a simple app that dynamically creates an input control, with the type and label control past ii other inputs. The resulting app is shown in Figure ten.eight.

                                  ui                  <-                  fluidPage                  (                  textInput                  (                  "label",                  "label"                  ),                  selectInput                  (                  "type",                  "type",                  c                  (                  "slider",                  "numeric"                  )                  ),                  uiOutput                  (                  "numeric"                  )                  )                  server                  <-                  function                  (                  input,                  output,                  session                  )                  {                  output                  $                  numeric                  <-                  renderUI                  (                  {                  if                  (                  input                  $                  blazon                  ==                  "slider"                  )                  {                  sliderInput                  (                  "dynamic",                  input                  $                  characterization, value                  =                  0, min                  =                  0, max                  =                  ten                  )                  }                  else                  {                  numericInput                  (                  "dynamic",                  input                  $                  label, value                  =                  0, min                  =                  0, max                  =                  ten                  )                  }                  }                  )                  }                              

If you lot run this code yourself, you'll notice that it takes a fraction of a second to appear later on the app loads. That's because information technology'southward reactive: the app must load, trigger a reactive consequence, which calls the server function, yielding HTML to insert into the page. This is one of the downsides of renderUI(); relying on it too much can create a laggy UI. For good performance, strive to keep fixed as much of the user interface every bit possible, using the techniques described earlier in the chapter.

At that place's i other trouble with this approach: when you alter controls, yous lose the currently selected value. Maintaining existing state is one of the large challenges of creating UI with code. This is one reason that selectively showing and hiding UI is a better approach if information technology works for you — because you lot're not destroying and recreating the controls, you don't need to do anything to preserve the values. Even so, in many cases, we tin can fix the problem by setting the value of the new input to the current value of the existing control:

                                  server                  <-                  part                  (                  input,                  output,                  session                  )                  {                  output                  $                  numeric                  <-                  renderUI                  (                  {                  value                  <-                  isolate                  (                  input                  $                  dynamic                  )                  if                  (                  input                  $                  type                  ==                  "slider"                  )                  {                  sliderInput                  (                  "dynamic",                  input                  $                  label, value                  =                  value, min                  =                  0, max                  =                  x                  )                  }                  else                  {                  numericInput                  (                  "dynamic",                  input                  $                  label, value                  =                  value, min                  =                  0, max                  =                  10                  )                  }                  }                  )                  }                              

The use of isolate() is important. We'll come back to what it does in Section fifteen.4.one, merely here it ensures that we don't create a reactive dependency that would cause this code to re-run every time input$dynamic changes (which will happen whenever the user modifies the value). We only desire it to change when input$type or input$label changes.

Multiple controls

Dynamic UI is most useful when you are generating an arbitrary number or type of controls. That ways that you'll be generating UI with lawmaking, and I recommend using functional programming for this sort of task. Hither I'll utilise purrr::map() and purrr::reduce(), merely you could certainly do the same with the base lapply() and Reduce() functions.

If you're not familiar with the map() and reduce() of functional programming, you might want to take a cursory detour to read Functional programming before continuing. We'll also come back to this idea in Affiliate 18. These are complex ideas, so don't stress out if it doesn't make sense on your start read through.

To make this concrete, imagine that you'd like the user to be able to supply their own colour palette. They'll first specify how many colours they want, and then supply a value for each colour. The ui is pretty unproblematic: nosotros accept a numericInput() that controls the number of inputs, a uiOutput() where the generated text boxes volition go, and a textOutput() that demonstrates that nosotros've plumbed everything together correctly.

The server function is brusk but contains some large ideas:

  • I utilise a reactive, col_names(), to store the names of each of the colour inputs I'k about to generate.

  • I then apply map() to create a listing of textInput()southward, ane each for each proper noun in col_names(). renderUI() so takes this list of HTML components and adds information technology to UI.

  • I demand to utilise a new trick to admission the values the input values. So far nosotros've always accessed the components of input with $, eastward.g.input$col1. But here nosotros accept the input names in a character vector, similar var <- "col1". $ no longer works in this scenario, so we demand to swich to [[, i.e.input[[var]].

  • I use map_chr() to collect all values into a character vector, and display that in output$palette. Unfortunately there'south a cursory menses, just before the new inputs are rendered past the browser, where their values are Zip. This causes map_chr() to error, which we set up past using the handy %||% role: it returns the correct-hand side whenever the left-hand side is NULL.

Y'all can see the results in Figure x.ix.

If you lot run this app, yous'll discover a really annoying behaviour: whenever you change the number of colours, all the data you've entered disappears. We can fix this problem by using the aforementioned technique as before: setting value to the (isolated) current value. I'll also tweak the appearance to wait a petty nicer, including displaying the selected colours in a plot. Sample screenshots are shown in Figure x.10.

                                  ui                  <-                  fluidPage                  (                  sidebarLayout                  (                  sidebarPanel                  (                  numericInput                  (                  "n",                  "Number of colours", value                  =                  5, min                  =                  ane                  ),                  uiOutput                  (                  "col"                  ),                  ),                  mainPanel                  (                  plotOutput                  (                  "plot"                  )                  )                  )                  )                  server                  <-                  role                  (                  input,                  output,                  session                  )                  {                  col_names                  <-                  reactive                  (                  paste0                  (                  "col",                  seq_len                  (                  input                  $                  n                  )                  )                  )                  output                  $                  col                  <-                  renderUI                  (                  {                  map                  (                  col_names                  (                  ),                  ~                  textInput                  (                  .ten,                  Cypher, value                  =                  isolate                  (                  input                  [[                  .x                  ]                  ]                  )                  )                  )                  }                  )                  output                  $                  plot                  <-                  renderPlot                  (                  {                  cols                  <-                  map_chr                  (                  col_names                  (                  ),                  ~                  input                  [[                  .x                  ]                  ]                  %||%                  ""                  )                  # convert empty inputs to transparent                  cols                  [                  cols                  ==                  ""                  ]                  <-                  NA                  barplot                  (                  rep                  (                  ane,                  length                  (                  cols                  )                  ),        col                  =                  cols,       space                  =                  0,        axes                  =                  Fake                  )                  }, res                  =                  96                  )                  }                              

Dynamic filtering

To finish off the affiliate, I'one thousand going to create an app that lets you dynamically filter any data frame. Each numeric variable will get a range slider and each factor variable will get a multi-select, so (east.g.) if a data frame has 3 numeric variables and ii factors, the app will accept three sliders and two select boxes.

I'll kickoff with a function that creates the UI for a single variable. Information technology'll return a range slider for numeric inputs, a multi-select for gene inputs, and NULL (nothing) for all other types.

                                  make_ui                  <-                  function                  (                  10,                  var                  )                  {                  if                  (                  is.numeric                  (                  10                  )                  )                  {                  rng                  <-                  range                  (                  10, na.rm                  =                  True                  )                  sliderInput                  (                  var,                  var, min                  =                  rng                  [                  one                  ], max                  =                  rng                  [                  2                  ], value                  =                  rng                  )                  }                  else                  if                  (                  is.factor                  (                  x                  )                  )                  {                  levs                  <-                  levels                  (                  ten                  )                  selectInput                  (                  var,                  var, choices                  =                  levs, selected                  =                  levs, multiple                  =                  True                  )                  }                  else                  {                  # Not supported                  NULL                  }                  }                              

Then I'll write the server side equivalent of this part: it takes the variable and value of the input control, and returns a logical vector saying whether or not to include each observation. Using a logical vector makes it easy to combine the results from multiple columns.

                                  filter_var                  <-                  function                  (                  x,                  val                  )                  {                  if                  (                  is.numeric                  (                  x                  )                  )                  {                  !                  is.na                  (                  x                  )                  &                  x                  >=                  val                  [                  1                  ]                  &                  x                  <=                  val                  [                  2                  ]                  }                  else                  if                  (                  is.factor                  (                  x                  )                  )                  {                  ten                  %in%                  val                  }                  else                  {                  # No control, so don't filter                  TRUE                  }                  }                              

I tin then employ these functions "by mitt" to generate a unproblematic filtering UI for the iris dataset:

                                  ui                  <-                  fluidPage                  (                  sidebarLayout                  (                  sidebarPanel                  (                  make_ui                  (                  iris                  $                  Sepal.Length,                  "Sepal.Length"                  ),                  make_ui                  (                  iris                  $                  Sepal.Width,                  "Sepal.Width"                  ),                  make_ui                  (                  iris                  $                  Species,                  "Species"                  )                  ),                  mainPanel                  (                  tableOutput                  (                  "data"                  )                  )                  )                  )                  server                  <-                  function                  (                  input,                  output,                  session                  )                  {                  selected                  <-                  reactive                  (                  {                  filter_var                  (                  iris                  $                  Sepal.Length,                  input                  $                  Sepal.Length                  )                  &                  filter_var                  (                  iris                  $                  Sepal.Width,                  input                  $                  Sepal.Width                  )                  &                  filter_var                  (                  iris                  $                  Species,                  input                  $                  Species                  )                  }                  )                  output                  $                  data                  <-                  renderTable                  (                  head                  (                  iris                  [                  selected                  (                  ),                  ],                  12                  )                  )                  }                              

Simple filter interface for the iris dataset

Figure 10.eleven: Simple filter interface for the iris dataset

You might observe that I got sick of copying and pasting so the app only works with 3 columns. I can arrive work with all the columns by using a little functional programming:

  • In ui use map() to generate 1 control for each variable.

  • In server(), I use map() to generate the selection vector for each variable. And so I use reduce() to take the logical vector for each variable and combine into a single logical vector by &-ing each vector together.

Again, don't worry too much if y'all don't understand exactly what's happening here. The master take away is that once you master functional programming, you can write very succinct code that generate complex, dynamic apps.

                                  ui                  <-                  fluidPage                  (                  sidebarLayout                  (                  sidebarPanel                  (                  map                  (                  names                  (                  iris                  ),                  ~                  make_ui                  (                  iris                  [[                  .x                  ]                  ],                  .x                  )                  )                  ),                  mainPanel                  (                  tableOutput                  (                  "data"                  )                  )                  )                  )                  server                  <-                  function                  (                  input,                  output,                  session                  )                  {                  selected                  <-                  reactive                  (                  {                  each_var                  <-                  map                  (                  names                  (                  iris                  ),                  ~                  filter_var                  (                  iris                  [[                  .x                  ]                  ],                  input                  [[                  .x                  ]                  ]                  )                  )                  reduce                  (                  each_var,                  ~                  .x                  &                  .y                  )                  }                  )                  output                  $                  data                  <-                  renderTable                  (                  head                  (                  iris                  [                  selected                  (                  ),                  ],                  12                  )                  )                  }                              

Using functional programming to build a filtering app for the `iris` dataset.

Effigy 10.12: Using functional programming to build a filtering app for the iris dataset.

From there, information technology's a simple generalisation to work with whatever data frame. Here I'll illustrate information technology using the data frames in the datasets package, simply you lot can easily imagine how you might extend this to user uploaded data. Run into the outcome in Figure ten.13.

                                  dfs                  <-                  keep                  (                  ls                  (                  "parcel:datasets"                  ),                  ~                  is.data.frame                  (                  become                  (                  .x,                  "package:datasets"                  )                  )                  )                  ui                  <-                  fluidPage                  (                  sidebarLayout                  (                  sidebarPanel                  (                  selectInput                  (                  "dataset", label                  =                  "Dataset", choices                  =                  dfs                  ),                  uiOutput                  (                  "filter"                  )                  ),                  mainPanel                  (                  tableOutput                  (                  "data"                  )                  )                  )                  )                  server                  <-                  office                  (                  input,                  output,                  session                  )                  {                  data                  <-                  reactive                  (                  {                  become                  (                  input                  $                  dataset,                  "package:datasets"                  )                  }                  )                  vars                  <-                  reactive                  (                  names                  (                  data                  (                  )                  )                  )                  output                  $                  filter                  <-                  renderUI                  (                  map                  (                  vars                  (                  ),                  ~                  make_ui                  (                  data                  (                  )                  [[                  .x                  ]                  ],                  .ten                  )                  )                  )                  selected                  <-                  reactive                  (                  {                  each_var                  <-                  map                  (                  vars                  (                  ),                  ~                  filter_var                  (                  data                  (                  )                  [[                  .x                  ]                  ],                  input                  [[                  .ten                  ]                  ]                  )                  )                  reduce                  (                  each_var,                  `&`                  )                  }                  )                  output                  $                  data                  <-                  renderTable                  (                  head                  (                  data                  (                  )                  [                  selected                  (                  ),                  ],                  12                  )                  )                  }                              

Dialog boxes

Before we finish up, wanted to mention a related technique: dialog boxes. Yous've seen them already in Section 8.iv.i, where the contents of the dialog was a fixed text string. But considering modalDialog() is chosen from within the server role, you tin can actually dynamically generate content in the same fashion as renderUI(). This is a useful technique to take in your back pocket if yous want to force the user to make some determination before standing on with the regular app flow.

Exercises

  1. Accept this very unproblematic app based on the initial example in the section:

                                              ui                      <-                      fluidPage                      (                      selectInput                      (                      "type",                      "type",                      c                      (                      "slider",                      "numeric"                      )                      ),                      uiOutput                      (                      "numeric"                      )                      )                      server                      <-                      role                      (                      input,                      output,                      session                      )                      {                      output                      $                      numeric                      <-                      renderUI                      (                      {                      if                      (                      input                      $                      type                      ==                      "slider"                      )                      {                      sliderInput                      (                      "n",                      "n", value                      =                      0, min                      =                      0, max                      =                      100                      )                      }                      else                      {                      numericInput                      (                      "due north",                      "n", value                      =                      0, min                      =                      0, max                      =                      100                      )                      }                      }                      )                      }                                      

    How could yous instead implement it using dynamic visibility? If you lot implement dynamic visibility, how could y'all go on the values in sync when you lot change the controls?

  2. Explain how this app works. Why does the password disappear when yous click the enter password push button a second time?

  3. In the app in Section ten.3.1, what happens if you lot drop the isolate() from value <- isolate(input$dynamic)?

  4. Add support for date and date-time columns make_ui() and filter_var().

  5. (Advanced) If you know the S3 OOP system, consider how you could replace the if blocks in make_ui() and filter_var() with generic functions.

Summary

Before reading this chapter, you were express to creating the user interface statically, before the server office was run. Now you lot've learned how to both modify the user interface and completely recreate it in response to user actions. A dynamic user interface will dramatically increases the complexity of your app, so don't be surprised if you find yourself struggling to debug what'due south going in. Always remember to use to the simplest technique that solves your problem, and fall dorsum to the debugging advice in Section v.ii.

The next chapter switches tack to talk virtually bookmarking, make it possible to share the electric current country of an app with others.

ramirezwetter.blogspot.com

Source: https://mastering-shiny.org/action-dynamic.html

Post a Comment for "refer to user uploaded data frame shiny"