Подтвердить что ты не робот

Блестящие сберегательные URL-адреса и вкладки состояния URL

Я хотел бы иметь блестящий веб-сайт, который сохраняет динамический выбор в URL как вывод, поэтому вы можете копировать и публиковать URL. Я взял этот код в качестве примера: https://gist.github.com/amackey/6841cf03e54d021175f0

И изменил его на мой случай, который представляет собой веб-страницу с navbarPage и несколькими вкладками для каждого элемента в панели.

Я бы хотел, чтобы URL-адрес направлял пользователя в нужный элемент в первом уровне tabPanel и правой вкладке второго уровня tabPanel.

Это, если пользователь перешел к "Delta Foxtrot", а затем "Отель", затем изменили параметры на #beverage=Tea;milk=TRUE;sugarLumps=3;customer=mycustomer, я бы как URL-адрес для отправки пользователя в "Delta Foxtrot" → "Hotel", вместо этого начиная с первой вкладки первого элемента панели.

В идеале я бы хотел, чтобы рабочий пример, поскольку все, что я пробовал до сих пор, не сработало.

Любые идеи?

enter image description here

# ui.R
library(shiny)

hashProxy <- function(inputoutputID) {
  div(id=inputoutputID,class=inputoutputID,tag("div",""));
}

# Define UI for shiny d3 chatter application
shinyUI(navbarPage('URLtests', id="page", collapsable=TRUE, inverse=FALSE,
 tabPanel("Alfa Bravo",
   tabsetPanel(
    tabPanel("Charlie",
    tags$p("Nothing to see here. Everything is in the 'Delta Foxtrot' 'Hotel' tab")
             )
       )
    )
 ,tabPanel("Delta Foxtrot",
    tabsetPanel(
    tabPanel("Golf",
    tags$p("Nothing to see here. Everything is in the 'Delta Foxtrot' 'Hotel' tab")
             )
    ,tabPanel("Hotel",

    tags$p("This widget is a demonstration of how to preserve input state across sessions, using the URL hash."),
    selectInput("beverage", "Choose a beverage:",
                choices = c("Tea", "Coffee", "Cocoa")),
    checkboxInput("milk", "Milk"),
    sliderInput("sugarLumps", "Sugar Lumps:",
                min=0, max=10, value=3),
    textInput("customer", "Your Name:"),
    includeHTML("URL.js"),
    h3(textOutput("order")),
    hashProxy("hash")
       )
     )
   )
))


# server.R
library(shiny)
url_fields_to_sync <- c("beverage","milk","sugarLumps","customer");

# Define server logic required to respond to d3 requests
shinyServer(function(input, output, clientData) {

  # Generate a plot of the requested variable against mpg and only
  # include outliers if requested
  output$order <- reactiveText(function() {
    paste(input$beverage,
          if(input$milk) "with milk" else ", black",
          "and",
          if (input$sugarLumps == 0) "no" else input$sugarLumps,
          "sugar lumps",
          "for",
          if (input$customer == "") "next customer" else input$customer)
  })

  firstTime <- TRUE

  output$hash <- reactiveText(function() {

    newHash = paste(collapse=";",
                    Map(function(field) {
                          paste(sep="=",
                                field,
                                input[[field]])
                        },
                        url_fields_to_sync))

    # the VERY FIRST time we pass the input hash up.
    return(
      if (!firstTime) {
        newHash
      } else {
        if (is.null(input$hash)) {
          NULL
        } else {
          firstTime<<-F;
          isolate(input$hash)
        }
      }
    )
  })
})


# URL.js
<script type="text/javascript">
(function(){

  this.countValue=0;

  var changeInputsFromHash = function(newHash) {
    // get hash OUTPUT
    var hashVal = $(newHash).data().shinyInputBinding.getValue($(newHash))
    if (hashVal == "") return
    // get values encoded in hash
    var keyVals = hashVal.substring(1).split(";").map(function(x){return x.split("=")})
    // find input bindings corresponding to them
    keyVals.map(function(x) {
      var el=$("#"+x[0])

      if (el.length > 0 && el.val() != x[1]) {

        console.log("Attempting to update input " + x[0] + " with value " + x[1]);
        if (el.attr("type") == "checkbox") {
            el.prop('checked',x[1]=="TRUE")
            el.change()
        } else if(el.attr("type") == "radio") {
          console.log("I don't know how to update radios")
        } else if(el.attr("type") == "slider") {
          // This case should be setValue but it not implemented in shiny
          el.slider("value",x[1])
          //el.change()
        } else { 
            el.data().shinyInputBinding.setValue(el[0],x[1])
            el.change()
        }
      }
    })
  }

  var HashOutputBinding = new Shiny.OutputBinding();
  $.extend(HashOutputBinding, {
    find: function(scope) {
      return $(scope).find(".hash");
    },
    renderError: function(el,error) {
      console.log("Shiny app failed to calculate new hash");
    },
    renderValue: function(el,data) {
      console.log("Updated hash");
      document.location.hash=data;
      changeInputsFromHash(el);
    }
  });
  Shiny.outputBindings.register(HashOutputBinding);

  var HashInputBinding = new Shiny.InputBinding();
  $.extend(HashInputBinding, {
    find: function(scope) {
      return $(scope).find(".hash");
    },
    getValue: function(el) {
      return document.location.hash;
    },
    subscribe: function(el, callback) {
      window.addEventListener("hashchange",
        function(e) {
          changeInputsFromHash(el);
          callback();
        }
        , false);
    }
  });
  Shiny.inputBindings.register(HashInputBinding);


})()
</script>

EDITED: я отвел пример кода в ответе, но не смог заставить его работать. См. Снимок экрана.

enter image description here

4b9b3361

Ответ 1

UPDATE

Теперь Shiny.14, доступный в CRAN, поддерживает сохранение состояния приложения в URL-адресе. См. в этой статье


Этот ответ является более подробным ответом, чем мой первый, который использует весь образец кода, предоставленный OP. Я решил добавить его в качестве нового ответа в свете щедрости. Мой оригинальный ответ использовал упрощенную версию этого, чтобы кто-то другой, приходящий на ответ, не должен был читать какой-либо посторонний код, чтобы найти то, что он ищет. Надеемся, что эта расширенная версия устранит любые трудности, с которыми вы сталкиваетесь. Части, которые я добавил к вашему R-коду, окружены ### ... ###.

server.r

# server.R
library(shiny)
url_fields_to_sync <- c("beverage","milk","sugarLumps","customer");

# Define server logic required to respond to d3 requests
shinyServer(function(input, output, session) { # session is the common name for this variable, not clientData

  # Generate a plot of the requested variable against mpg and only
  # include outliers if requested
  output$order <- reactiveText(function() {
    paste(input$beverage,
          if(input$milk) "with milk" else ", black",
          "and",
          if (input$sugarLumps == 0) "no" else input$sugarLumps,
          "sugar lumps",
          "for",
          if (input$customer == "") "next customer" else input$customer)
  })

  firstTime <- TRUE

  output$hash <- reactiveText(function() {

    newHash = paste(collapse=";",
                    Map(function(field) {
                          paste(sep="=",
                                field,
                                input[[field]])
                        },
                        url_fields_to_sync))

    # the VERY FIRST time we pass the input hash up.
    return(
      if (!firstTime) {
        newHash
      } else {
        if (is.null(input$hash)) {
          NULL
        } else {
          firstTime<<-F;
          isolate(input$hash)
        }
      }
    )
  })

  ###

  # whenever your input values change, including the navbar and tabpanels, send
  # a message to the client to update the URL with the input variables.
  # setURL is defined in url_handler.js
  observe({
      reactlist <- reactiveValuesToList(input)
      reactvals <- grep("^ss-|^shiny-", names(reactlist), value=TRUE, invert=TRUE) # strip shiny related URL parameters
      reactstr <- lapply(reactlist[reactvals], as.character) # handle conversion of special data types
      session$sendCustomMessage(type='setURL', reactstr)
  })

  observe({ # this observer executes once, when the page loads

      # data is a list when an entry for each variable specified 
      # in the URL. We'll assume the possibility of the following 
      # variables, which may or may not be present:
      #   nav= The navbar tab desired (either Alfa Bravo or Delta Foxtrot)
      #   tab= The desired tab within the specified nav bar tab, e.g., Golf or Hotel
      #   beverage= The desired beverage selection
      #   sugar= The desired number of sugar lumps
      # 
      # If any of these variables aren't specified, they won't be used, and 
      # the tabs and inputs will remain at their default value.
      data <- parseQueryString(session$clientData$url_search)
      # the navbar tab and tabpanel variables are two variables 
      # we have to pass to the client for the update to take place
      # if nav is defined, send a message to the client to set the nav tab
      if (! is.null(data$page)) {
          session$sendCustomMessage(type='setNavbar', data)
      }

      # if the tab variable is defined, send a message to client to update the tab
      if (any(sapply(data[c('alfa_bravo_tabs', 'delta_foxtrot_tabs')], Negate(is.null)))) {
          session$sendCustomMessage(type='setTab', data)
      }

      # the rest of the variables can be set with shiny update* methods
      if (! is.null(data$beverage)) { # if a variable isn't specified, it will be NULL
          updateSelectInput(session, 'beverage', selected=data$beverage)
      }

      if (! is.null(data$sugarLumps)) {
          sugar <- as.numeric(data$sugarLumps) # variables come in as character, update to numeric
          updateNumericInput(session, 'sugarLumps', value=sugar)
      }
  })

  ###
})

ui.r

library(shiny)

hashProxy <- function(inputoutputID) {
  div(id=inputoutputID,class=inputoutputID,tag("div",""));
}

# Define UI for shiny d3 chatter application
shinyUI(navbarPage('URLtests', id="page", collapsable=TRUE, inverse=FALSE,
 tabPanel("Alfa Bravo",
   tabsetPanel(
    ###
    id='alfa_bravo_tabs', # you need to set an ID for your tabpanels
    ###
    tabPanel("Charlie",
    tags$p("Nothing to see here. Everything is in the 'Delta Foxtrot' 'Hotel' tab")
             )
       )
    )
 ,tabPanel("Delta Foxtrot",
    tabsetPanel(
    ###
    id='delta_foxtrot_tabs', # you need to set an ID for your tabpanels
    ###
    tabPanel("Golf",
    tags$p("Nothing to see here. Everything is in the 'Delta Foxtrot' 'Hotel' tab")
             )
    ,tabPanel("Hotel", id='hotel',

    tags$p("This widget is a demonstration of how to preserve input state across sessions, using the URL hash."),
    selectInput("beverage", "Choose a beverage:",
                choices = c("Tea", "Coffee", "Cocoa")),
    checkboxInput("milk", "Milk"),
    sliderInput("sugarLumps", "Sugar Lumps:",
                min=0, max=10, value=3),
    textInput("customer", "Your Name:"),
    #includeHTML("URL.js"),
    ###
    includeHTML('url_handler.js'), # include the new script
    ###
    h3(textOutput("order")),
    hashProxy("hash")
       )
     )
   )
))

url_handler.js

<script>
Shiny.addCustomMessageHandler('setNavbar',
    function(data) {
        // create a reference to the desired navbar tab. page is the 
        // id of the navbarPage. a:contains says look for 
        // the subelement that contains the contents of data.nav
        var nav_ref = '#page a:contains(\"' + data.page + '\")';
        $(nav_ref).tab('show');
    }
)

Shiny.addCustomMessageHandler('setTab',
    function(data) {
       // pick the right tabpanel ID based on the value of data.nav
       if (data.page == 'Alfa Bravo') {
            var tabpanel_id = 'alfa_bravo_tabs';
       } else {
            var tabpanel_id = 'delta_foxtrot_tabs';
       }
       // combine this with a reference to the desired tab itself.
       var tab_ref = '#' + tabpanel_id + ' a:contains(\"' + data[tabpanel_id] + '\")';
       $(tab_ref).tab('show');
    }
)

Shiny.addCustomMessageHandler('setURL',
    function(data) {
        // make each key and value URL safe (replacing spaces, etc.), then join
        // them and put them in the URL
        var search_terms = [];
        for (var key in data) {
            search_terms.push(encodeURIComponent(key) + '=' + encodeURIComponent(data[key]));
        }
        window.history.pushState('object or string', 'Title', '/?' + search_terms.join('&'));
    }
);

</script>

Чтобы проверить это, вызовите runApp(port=5678) в каталог с исходными файлами. По умолчанию в URL-адресе не указаны параметры, поэтому по умолчанию будет выбран первый элемент навигационной панели и первая вкладка в этом элементе. Чтобы проверить его с помощью параметров URL, укажите браузеру: http://127.0.0.1:5678/?nav=Delta%20Foxtrot&tab=Hotel&beverage=Coffee. Это должно указывать на вторую вкладку навигационной панели и вторую вкладку в этом навигационном элементе с кофе в качестве выбранного напитка.

Ответ 2

Вот пример, демонстрирующий, как обновить выбор навигатора, выбор табуляции и выбор виджета с использованием переменных, определенных в URL

ui <- navbarPage('TEST', id='page', collapsable=TRUE, inverse=FALSE,
    # define a message handler that will receive the variables on the client side
    # from the server and update the page accordingly.
    tags$head(tags$script("
        Shiny.addCustomMessageHandler('updateSelections',
            function(data) {
                var nav_ref = '#page a:contains(\"' + data.nav + '\")';
                var tabpanel_id = data.nav == 'Alpha' ? '#alpha_tabs' : '#beta_tabs';
                var tab_ref = tabpanel_id + ' a:contains(\"' + data.tab + '\")';
                $(nav_ref).tab('show');
                $(tab_ref).tab('show');
            }
        )
    ")),
    tabPanel('Alpha',
        tabsetPanel(id='alpha_tabs',
            tabPanel('Tab')
        )
    ),
    tabPanel('Beta',
        tabsetPanel(id='beta_tabs',
            tabPanel('Golf'),
            tabPanel('Hotel',
                selectInput("beverage", "Choose a beverage:", choices = c("Tea", "Coffee", "Cocoa"))
            )
        )
    )
)

server <- function(input, output, session) {
    observe({
        data <- parseQueryString(session$clientData$url_search)
        session$sendCustomMessage(type='updateSelections', data)
        updateSelectInput(session, 'beverage', selected=data$beverage)
    })

}

runApp(list(ui=ui, server=server), port=5678, launch.browser=FALSE)

Направьте свой браузер на этот URL после запуска приложения: http://127.0.0.1:5678/?nav=Beta&tab=Hotel&beverage=Coffee