on click moving to other tab panels

[b-tierney]

Hi again, Left an issue earlier today and resolved it almost immediately; this one is more challenging, though.

I have a shiny app with a series of tab panels – ideally, on the landing page, I'd have a carousel where you could click on the image in the carousel and be taken to any of the panels.

Since shiny doesn't have standardized urls associated with panels this is very hard...but maybe you've bumped into this problem before?

[yonicd]

there are shiny observers on the slider that will give you the index of the current slide.

[yonicd]

library(svglite)
library(lattice)
library(ggplot2)
library(shiny)

server <- function(input, output) {
  output$distPlot <- renderSlickR({
    slickR(s.in())
  })

  s.in=reactive({
    sapply(
      list(
        xmlSVG({hist(rnorm(input$obs), col = 'darkgray', border = 'white')},standalone=TRUE)
        ,xmlSVG({print(xyplot(x~x,data.frame(x=1:10),type="l"))},standalone=TRUE)
        ,xmlSVG({show(ggplot(iris,aes(x=Sepal.Length,y=Sepal.Width,colour=Species))+geom_point())},standalone=TRUE)
        ,xmlSVG({
          print(
            dotplot(variety ~ yield | site , data = barley, groups = year,
                    key = simpleKey(levels(barley$year), space = "right"),
                    xlab = "Barley Yield (bushels/acre) ",
                    aspect=0.5, layout = c(1,6), ylab=NULL)        
          )
        },standalone=TRUE
        )
      )
      ,function(sv){
        paste0(
          "data:image/svg+xml;utf8,"
          ,as.character(sv)
        )
      }
    )
  })

  reactive_slide <- shiny::reactiveValues()

  shiny::observeEvent(input$distPlot_current,{

    current_slide <- input$distPlot_current$.clicked

    if(!is.null(current_slide)) 
      reactive_slide$current <- current_slide

  })

  output$results <- shiny::renderPrint({

    str.out <- ''

    if(length(reactive_slide$current)>0)
      str.out=reactive_slide$current

    return(str.out)
  })    

  output$chosen <- shiny::renderUI({

    list(shiny::h3('Selected Items'),

         shiny::verbatimTextOutput(outputId = "results"))

  })

}

ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(
      sliderInput("obs", "Number of observations:", min = 10, max = 500, value = 100),
      shiny::uiOutput('chosen')
    ),
    mainPanel(slickROutput("distPlot",width='200px',height='200px'))
  )
)

shinyApp(ui = ui, server = server)

[b-tierney]

Thank you so much for the quick response, I really appreciate it.

Your code functions, but it's not quite what I was going for. I think I didn't explain my issue clearly. What I'm looking for is the ability to click on an image in the slider and be routed to a separate tab entirely. So each image has to have an ID associated with it that I can link to a different portion of the UI.

Maybe the index you mentioned can do that?

[yonicd]

yes. build you tabs with id's that have indexes in them ie tab1,tab2,tab3... then in shiny do observeEvent on the current_index of the slider. within that update the active tab.

[yonicd]

here is a working example

library(svglite)
library(lattice)
library(ggplot2)
library(shiny)

ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(
      sliderInput("obs", "Number of observations:", min = 10, max = 500, value = 100),
      shiny::uiOutput('chosen')
    ),
    mainPanel(
      slickROutput("distPlot",width='80%',height='200px'),
      tabsetPanel(id = "inTabset",
                  tabPanel(title = "Panel 1", value = "panel1", "Panel 1 content"),
                  tabPanel(title = "Panel 2", value = "panel2", "Panel 2 content"),
                  tabPanel(title = "Panel 3", value = "panel3", "Panel 3 content"),
                  tabPanel(title = "Panel 4", value = "panel4", "Panel 4 content")
      ))
  )
)

server <- function(input, output,session) {
  output$distPlot <- renderSlickR({
    slickR(s.in(),slickOpts = list(centerMode=TRUE,slidesToShow=2))
  })

  s.in=reactive({
    sapply(
      list(
        xmlSVG({hist(rnorm(input$obs), col = 'darkgray', border = 'white')},standalone=TRUE)
        ,xmlSVG({print(xyplot(x~x,data.frame(x=1:10),type="l"))},standalone=TRUE)
        ,xmlSVG({show(ggplot(iris,aes(x=Sepal.Length,y=Sepal.Width,colour=Species))+geom_point())},standalone=TRUE)
        ,xmlSVG({
          print(
            dotplot(variety ~ yield | site , data = barley, groups = year,
                    key = simpleKey(levels(barley$year), space = "right"),
                    xlab = "Barley Yield (bushels/acre) ",
                    aspect=0.5, layout = c(1,6), ylab=NULL)        
          )
        },standalone=TRUE
        )
      )
      ,function(sv){
        paste0(
          "data:image/svg+xml;utf8,"
          ,as.character(sv)
        )
      }
    )
  })

  reactive_slide <- shiny::reactiveValues()

  shiny::observeEvent(input$distPlot_current,{

    current_slide <- input$distPlot_current$.clicked
    relative_slide <- input$distPlot_current$.relative_clicked
    center_slide <- input$distPlot_current$.center
    total_slide <- input$distPlot_current$.total
    id_slide <- input$distPlot_current$.slider_index

    if(!is.null(current_slide))
      reactive_slide$current <- current_slide
    if(!is.null(relative_slide))
      reactive_slide$relative <- relative_slide
    if(!is.null(center_slide))
      reactive_slide$center <- center_slide
    if(!is.null(total_slide))
      reactive_slide$total <- total_slide
    if(!is.null(id_slide))
      reactive_slide$id <- id_slide
  })

  output$results <- shiny::renderTable({

      data.frame(SliderId=reactive_slide$id,
                            TotalSlides=reactive_slide$total,
                            CurrentSlide=reactive_slide$current,
                            RelativeSlide=reactive_slide$relative,
                            CenterSlide=reactive_slide$center)

    })

    output$chosen <- shiny::renderUI({
          list(shiny::h3('Slider Info'),
               shiny::tableOutput(outputId = "results"))
      })

  observeEvent(reactive_slide$current, {

    updateTabsetPanel(session, "inTabset",
                      selected = paste0("panel", reactive_slide$current)
    )

  })

}

shinyApp(ui = ui, server = server)

[b-tierney]

Great, this works! Thank you so much, really appreciate it. I have one other question, but it's a different topic, so I'll open another case.