R Shiny 应用程序检测移动设备

5
我有一个Shiny应用(实际上是一个交互式的R Markdown报告),我想根据用户是否在移动端来进行格式化。我找到了这篇由g3rv4撰写的博客文章,其中描述了如何测试这一点,但我无法在下面的示例应用程序中使其正常工作。

https://g3rv4.com/2017/08/shiny-detect-mobile-browsers

我是一名建模师,而非程序员,所以我可能在Javascript方面有些做错了。我没有收到任何错误信息,但是我没有从 textOutput('isItMobile') 中获得任何输出。
# shiny example from
# https://shiny.rstudio.com/tutorial/written-tutorial/lesson1/
# mobile detect code from
# https://g3rv4.com/2017/08/shiny-detect-mobile-browsers
library(shiny)

onStart <- function(input, output) {

  ### function to detect mobile ####
  mobileDetect <- function(inputId, value = 0) {
    tagList(
      singleton(tags$head(tags$script(src = "js/mobile.js"))),
      tags$input(id = inputId,
                 class = "mobile-element",
                 type = "hidden")
    )
  }

}

# Define UI for app that draws a histogram ----
ui <- fluidPage(

  # App title ----
  titlePanel("Hello Shiny!"),

  mobileDetect('isMobile'),
  textOutput('isItMobile'),

  # Sidebar layout with input and output definitions ----
  sidebarLayout(

    # Sidebar panel for inputs ----
    sidebarPanel(

      # Input: Slider for the number of bins ----
      sliderInput(inputId = "bins",
                  label = "Number of bins:",
                  min = 1,
                  max = 50,
                  value = 30)

    ),

    # Main panel for displaying outputs ----
    mainPanel(

      # Output: Histogram ----
      plotOutput(outputId = "distPlot")

    )
  )
)

# Define server logic required to draw a histogram ----
server <- function(input, output) {

  output$isItMobile <- renderText({ 
    ifelse(input$isMobile, "You are on a mobile device", "You are not on a mobile device")
  })

  # Histogram of the Old Faithful Geyser Data ----
  output$distPlot <- renderPlot({

    x    <- faithful$waiting
    bins <- seq(min(x), max(x), length.out = input$bins + 1)

    hist(x, breaks = bins, col = "#75AADB", border = "white",
         xlab = "Waiting time to next eruption (in mins)",
         main = "Histogram of waiting times")

  })

}

# this is how you run it
print('Running Simple Shiny App - Hit ESC to quit.')
shinyApp(ui = ui, server = server, onStart = onStart)

这里是 www/js/mobile.js 文件:
var isMobileBinding = new Shiny.InputBinding();
$.extend(isMobileBinding, {
  find: function(scope) {
    return $(scope).find(".mobile-element");
    callback();
  },
  getValue: function(el) {
    return /((iPhone)|(iPod)|(iPad)|(Android)|(BlackBerry))/.test(navigator.userAgent)
  },
  setValue: function(el, value) {
  },
  subscribe: function(el, callback) {
  },
  unsubscribe: function(el) {
  }
});

Shiny.inputBindings.register(isMobileBinding);

1
你有考虑过使用一个提供内置框架来完成这个任务的包吗?我会建议使用 flexdashboard 来满足简单的需求,特别是因为你说这是一个交互式的 rmarkdown 报告。如果你需要更多的功能,可以看看 shinydashboard,但它有一个更陡峭的学习曲线。 - Kevin Arseneau
谢谢!我会研究一下的。 - Simon Woodward
嗨@SimonWoodward,你最终解决了这个问题吗?我也遇到了同样的问题。 - Sharma
嗨@Sharma,不好意思,我还没有把这个搞定。 - Simon Woodward
我刚刚在下面添加了另一种方法。 - ismirsehregal
2个回答

5
以下代码可以检测屏幕大小,判断是否为(小型)移动设备。需要注意的是,此方法有意排除了具有更大屏幕的平板电脑。
以下片段检查屏幕尺寸是否小于768像素,并使用onInputChange将结果发送给Shiny服务器作为名为is_mobile_device的输入。该检查仅在页面加载时进行一次,并且在Shiny UI完成加载后才完成。
将此代码放入JS文件中,并将其包含在您的UI中(例如,在问题中使用tags$script的方式)。
$(document).on('shiny:sessioninitialized', function (e) {
  var mobile = window.matchMedia("only screen and (max-width: 768px)").matches;
  Shiny.onInputChange('is_mobile_device', mobile);
});

浏览器支持: http://caniuse.com/#feat=matchmedia

在你的Shiny server函数中,你可以定义一个reactive来获取值:

server <- function(input, output, session) {
    is_mobile_device <- reactive(isTRUE(input$is_mobile_device))
    # ...
}

如果希望在JavaScript方面使用其他方法检测移动设备(例如基于用户代理以包括平板电脑),请参考这里的出色答案:


3

这里提供了一种使用shinybrowser::get_device()的替代方法来判断移动设备是否连接。

以下内容基于此示例应用程序

检测移动浏览器的JS代码取自此处

我们需要做的唯一事情就是在会话开始时将JS中的isMobile检查发送到R,并在应用程序的server部分中使用它:

library(shiny)
library(leaflet)

r_colors <- rgb(t(col2rgb(colors()) / 255))
names(r_colors) <- colors()

ui <- fluidPage(
  tags$script(HTML(
    "$(document).on('shiny:connected', function(event) {
        let check = false;
        (function(a){if(/(android|bb\\d+|meego).+mobile|avantgo|bada\\/|blackberry|blazer|compal|elaine|fennec|hiptop|iemobile|ip(hone|od)|iris|kindle|lge |maemo|midp|mmp|mobile.+firefox|netfront|opera m(ob|in)i|palm( os)?|phone|p(ixi|re)\\/|plucker|pocket|psp|series(4|6)0|symbian|treo|up\\.(browser|link)|vodafone|wap|windows ce|xda|xiino/i.test(a)||/1207|6310|6590|3gso|4thp|50[1-6]i|770s|802s|a wa|abac|ac(er|oo|s\\-)|ai(ko|rn)|al(av|ca|co)|amoi|an(ex|ny|yw)|aptu|ar(ch|go)|as(te|us)|attw|au(di|\\-m|r |s )|avan|be(ck|ll|nq)|bi(lb|rd)|bl(ac|az)|br(e|v)w|bumb|bw\\-(n|u)|c55\\/|capi|ccwa|cdm\\-|cell|chtm|cldc|cmd\\-|co(mp|nd)|craw|da(it|ll|ng)|dbte|dc\\-s|devi|dica|dmob|do(c|p)o|ds(12|\\-d)|el(49|ai)|em(l2|ul)|er(ic|k0)|esl8|ez([4-7]0|os|wa|ze)|fetc|fly(\\-|_)|g1 u|g560|gene|gf\\-5|g\\-mo|go(\\.w|od)|gr(ad|un)|haie|hcit|hd\\-(m|p|t)|hei\\-|hi(pt|ta)|hp( i|ip)|hs\\-c|ht(c(\\-| |_|a|g|p|s|t)|tp)|hu(aw|tc)|i\\-(20|go|ma)|i230|iac( |\\-|\\/)|ibro|idea|ig01|ikom|im1k|inno|ipaq|iris|ja(t|v)a|jbro|jemu|jigs|kddi|keji|kgt( |\\/)|klon|kpt |kwc\\-|kyo(c|k)|le(no|xi)|lg( g|\\/(k|l|u)|50|54|\\-[a-w])|libw|lynx|m1\\-w|m3ga|m50\\/|ma(te|ui|xo)|mc(01|21|ca)|m\\-cr|me(rc|ri)|mi(o8|oa|ts)|mmef|mo(01|02|bi|de|do|t(\\-| |o|v)|zz)|mt(50|p1|v )|mwbp|mywa|n10[0-2]|n20[2-3]|n30(0|2)|n50(0|2|5)|n7(0(0|1)|10)|ne((c|m)\\-|on|tf|wf|wg|wt)|nok(6|i)|nzph|o2im|op(ti|wv)|oran|owg1|p800|pan(a|d|t)|pdxg|pg(13|\\-([1-8]|c))|phil|pire|pl(ay|uc)|pn\\-2|po(ck|rt|se)|prox|psio|pt\\-g|qa\\-a|qc(07|12|21|32|60|\\-[2-7]|i\\-)|qtek|r380|r600|raks|rim9|ro(ve|zo)|s55\\/|sa(ge|ma|mm|ms|ny|va)|sc(01|h\\-|oo|p\\-)|sdk\\/|se(c(\\-|0|1)|47|mc|nd|ri)|sgh\\-|shar|sie(\\-|m)|sk\\-0|sl(45|id)|sm(al|ar|b3|it|t5)|so(ft|ny)|sp(01|h\\-|v\\-|v )|sy(01|mb)|t2(18|50)|t6(00|10|18)|ta(gt|lk)|tcl\\-|tdg\\-|tel(i|m)|tim\\-|t\\-mo|to(pl|sh)|ts(70|m\\-|m3|m5)|tx\\-9|up(\\.b|g1|si)|utst|v400|v750|veri|vi(rg|te)|vk(40|5[0-3]|\\-v)|vm40|voda|vulc|vx(52|53|60|61|70|80|81|83|85|98)|w3c(\\-| )|webc|whit|wi(g |nc|nw)|wmlb|wonu|x700|yas\\-|your|zeto|zte\\-/i.test(a.substr(0,4))) check = true;})(navigator.userAgent||navigator.vendor||window.opera);
        Shiny.setInputValue(id = 'isMobile', value = check);
      });"
  )),
  leafletOutput("mymap"),
  conditionalPanel("input.isMobile == true", strong("Sorry - No map on mobiles", style= "color: red;")),
  p(),
  actionButton("recalc", "New points")
)

server <- function(input, output, session) {
  points <- eventReactive(input$recalc, {
    cbind(rnorm(40) * 2 + 13, rnorm(40) + 48)
  }, ignoreNULL = FALSE)
  
  output$mymap <- renderLeaflet({
    req(!is.null(input$isMobile) && !input$isMobile, cancelOutput = TRUE)
    leaflet() %>%
      addProviderTiles(providers$Stamen.TonerLite,
                       options = providerTileOptions(noWrap = TRUE)
      ) %>%
      addMarkers(data = points())
  })
}

shinyApp(ui, server)

我一直在使用Chrome浏览器扩展程序Mobile simulator进行测试: result 其他有用的链接: https://shiny.rstudio.com/articles/packaging-javascript.html https://shiny.rstudio.com/articles/communicating-with-js.html PS:作为另一种基于条件的解决方案,我们可以使用另一个conditionalPanel
conditionalPanel("input.isMobile == false", leafletOutput("mymap")),

这个答案最初是在这里提供的。

该问题涉及到在移动设备上不加载RMD页面的某些元素。

网页内容由stack overflow 提供, 点击上面的
可以查看英文原文,
原文链接