displaying shiny-leaflet application on mobile

I have deployed a shiny application on a OVH server ( http://37.187.119.198:3838/Babi_pluie/ ). To give greater visibility to the application, I rented a domain name from Gandi ( www.babipluie.org ) that redirects to the IP address of the server.

There is a problem with mobile display management depending on how to connect to the app.

Directly with the IP number, it's good.

Through the website (www.babipluie.org), the application is adjusted to the width of the map and not the the size of the screen.


Has anyone encountered this problem and has a solution?
Here is the code:
library(shiny)
library(leaflet)

PAGE_TITLE <- "Babi Pluie"

ui <- fluidPage(

tags$head(
tags$meta(charset="UTF-8"),
tags$meta(name="viewport", content="width=device-width, initial-scale=1")),

tags$style(type="text/css",
"h1 {
text-align:center;
}",
"h3 {
# font-family: 'Passion One';
font-family: 'Arial black';
color: #3399CC ;
margin-top: 0.2em;
text-align:center;
}",
".box-body {height:80vh}"
),

titlePanel(windowTitle = PAGE_TITLE,
title=div(h1(img(src="5_logos_4.jpg", height = 60, width = 330, style = "margin:auto")),h3("Babi pluie"))),

selectInput("cumul", NULL,
c("Pluie tombée sur les dernières 30 minutes" = "P30min",
"Pluie tombée sur la dernière 1h" = "P1h",
"Pluie tombée sur les dernières 2h" = "P2h",
"Pluie tombée sur les dernières 4h" = "P4h",
"Pluie tombée sur les dernières 12h" = "P12h",
"Pluie tombée sur les dernières 24h" = "P24h"),
width = 350),

mainPanel(leafletOutput("mymap"),width=12)

)

server <- function(input,output) {

tout ce qui appelle autoinvalidate sera reactive toutes les minutes

autoInvalidate <- reactiveTimer(60000)

output$mymap <- renderLeaflet({
# reactualise toutes les minutes
autoInvalidate()
labattrib = paste("","", "Projet EVIdENCE","","")

DataP <<- read.csv("~/script R/Test_Pluvio/Pluvio_Abidjan.csv", sep=';', dec=".", header=TRUE)

data <- switch(input$cumul, 
               "P30min" = DataP$P30min,
               "P1h" = DataP$P1h,
               "P2h" = DataP$P2h,
               "P4h" = DataP$P4h,
               "P12h" = DataP$P12h,
               "P24h" = DataP$P24h)

calcul du nombre de pluviographes ayant recu de la pluie sur la periode

non_nul = sum(!is.na(data))
datana <- data[!is.na(data)] 

if (non_nul > 1)
  #  plusieurs pluviographes ont recu de la pluie
  #  on met une echelle de couleur en legende
{
  couleurs <- colorNumeric("Blues", range(data, na.rm = TRUE), reverse=FALSE)
  leaflet() %>%
  addProviderTiles("OpenStreetMap.DE",
                   options = providerTileOptions(noWrap = TRUE)) %>%
  setView(lng = -4.015, lat = 5.39, zoom = 11) %>%
  addTiles(attribution = lapply(labattrib, HTML)) %>%
  # addMarkers(DataP$lon, DataP$lat, popup = DataP$site, label = data) %>%
  addCircleMarkers(DataP$lon, DataP$lat, weight = 2,
                   radius = sqrt(data) * 4,
                   #radius = 10,
                   popup = paste(DataP$site, " : ", data, "mm"),
                   # label = as.character(data),
                   color="black", stroke=TRUE,
                   fillColor = couleurs(data),
                   fillOpacity = 0.7) %>%
  addLegend(pal = couleurs, values = datana, title = "Pluie mm", opacity = 0.9)
}

else
if (non_nul == 1)
# un seul pluviographe a recu de la pluie sur la periode
# on ne met pas de legende
{
leaflet() %>%
addProviderTiles("OpenStreetMap.DE",
options = providerTileOptions(noWrap = TRUE)) %>%
setView(lng = -4.015, lat = 5.39, zoom = 11)%>%
addTiles(attribution = lapply(labattrib, HTML)) %>%
addCircleMarkers(DataP$lon, DataP$lat, weight = 2,
radius = sqrt(data) * 4,
#radius = 10,
popup = paste(DataP$site, " : ", data, "mm"),
# label = as.character(data),
color="black", stroke=TRUE,
fillColor = "blue",
fillOpacity = 0.7)
}
else
# aucun pluviographe a recu de la pluie sur la periode
# on ne met pas de legende
# on met sur la carte un message
{
lab=paste("Pas de pluie au niveau des pluviographes ","

", "","sur la periode","")

leaflet() %>%
  addProviderTiles("OpenStreetMap.DE",
                   options = providerTileOptions(noWrap = TRUE)) %>%
  setView(lng = -4.015, lat = 5.39, zoom = 11) %>%
  addTiles(attribution = lapply(labattrib, HTML)) %>%
  addLabelOnlyMarkers(lng=-4.015, lat=5.39,
                      label = lapply(lab, HTML),
                      labelOptions = labelOptions(noHide = T, direction = "bottom",
                                                  style = list(
                                                    "color" = "red",
                                                    "font-family" = "serif",
                                                    "font-style" = "italic",
                                                    "box-shadow" = "5px 5px rgba(0,0,0,0.25)",
                                                    "font-size" = "14px",
                                                    "border-color" = "rgba(0,0,0,0.5)"
                                                  )))
}

# fin de renderleaflet
})

fin de server(input, output, session)

}

app <- shinyApp(ui, server)

This topic was automatically closed 54 days after the last reply. New replies are no longer allowed.