2016-04-27 11 views
1

高度なポップアップ

itemcat country item Price date_today lat lng 
Clothes Bangkok Shoes $5 2016-04-27 13.75 100.51 
Clothes Bangkok Tshirt $5 2016-04-27 13.75 100.51 
Clothes Bangkok Skirt $5 2016-04-27 13.75 100.51 
Clothes Bangkok Pants $5 2016-04-27 13.75 100.51 
Food Bangkok Chicken $2 2016-04-27 13.75 100.51 
Food Bangkok Milk $2 2016-04-27 13.75 100.51 
Clothes New York Shoes $5 2016-04-27 40.74 -73.98 
Clothes New York Tshirt $5 2016-04-27 40.74 -73.98 
Clothes New York Skirt $5 2016-04-27 40.74 -73.98 
Clothes New York Pants $5 2016-04-27 40.74 -73.98 

私は日付を選択、ユーザーがitemcatを選択することができます光沢のあるアプリを持っている、とリーフレットは、価格情報を持つ国が利用できる示されますが、次のように私は、データセットを持っています世界地図上に私はポップ・アップがクリックしたときなど、都市とすべての項目とその価格を表示することが可能であるようにポップアップを作成したい

市:バンコク、シューズ:$ 5、Tシャツ:スカート $ 5、:$ 5、パンツの:$

しかし、今、私は私のコードでこれらのポップアップを表示するトラブルを抱えています。特に、ITEMSの複数の可変列をポップアップに表示する方法はわかりません。 "city:"という単語がポップアップしますが、それだけです。

####USER INTERFACE#### 
ui <- shinyUI(fluidPage(
tabsetPanel(
tabPanel("World Cost of Living", 
sidebarLayout(position="right", 
sidebarPanel(
selectInput("witem", "Select item of comparison", choices = c("Clothes", "Communication", "Income", "Outside Food", "Prepared Food", "Property Price", "Recreation", "Rent", "Transport", "Utilities")), 
dateRangeInput("wdaterange", "Select Date Range", start = min(col$date_today), end = max(col$date_today), format = "yyyy-mm-dd", startview = "month", weekstart = 0, language = "en", separator = " to "), 
dateInput("wdate", "Select Date", min = min(col$date_today), format = "yyyy-mm-dd", startview = "month", weekstart = 0, language = "en")), 

mainPanel(leafletOutput('map')) 
)) 
) 
) 
) 



####SERVER#### 

server <- function(input, output, session){ 

    pal <- colorQuantile("Blues", NULL, n = 5) 
    output$map <- renderLeaflet({ 
    prices<-col[col$itemcat==input$witem & col$date_today==input$wdate[1],] 

    leaflet(prices) %>% addTiles() %>% addCircles(lng = ~lng, lat=~lat, stroke=TRUE, color = "black", weight=1, opacity = 0.2, fill = TRUE, fillColor = ~pal(infl), fillOpacity = 0.2 , radius = ~infl*30) 
    }) 

    #~htmlEscape(country[lng==lng & lat==lat]) 

    # Show a popup at the given location 
    showPopup <- function(itemcat, lat, lng, date) { 
    selectedItem <- col[col$itemcat == itemcat & col$lat==lat & col$lng==lng & col$date_today==date,] 
    content <- as.character(tagList(
     tags$strong("City:", selectedItem$country), 
     tags$strong(HTML(sprintf("%s, %s", 
           selectedItem$item, selectedItem$spore 
    ))) 
    )) 
    leafletProxy("map") %>% addPopups(lng, lat, content, layerId = itemcat) 
    } 

    observe({ 
    leafletProxy("map") %>% clearPopups() 
    event <- input$map_shape_click 
    if (is.null(event)) 
     return() 

    isolate({ 
     showPopup(event$id, event$lat, event$lng, event$date) 
    }) 
    }) 

} 

答えて

0

私はこの質問があなたのために外の日付であると思いますが、私は同じ問題とfouns無回答がなかったので、誰もが将来同じ問題に遭遇した場合、彼はここで答えを見つけるかもしれません。

マーカーをクリックしたときにポップアップを表示する最も簡単な方法は、マーカーを定義するときにpopupオプションを渡すことです。例:(server.R)

server <- function(input, output, session){ 
    pal <- colorQuantile("Blues", NULL, n = 5) 

    output$map <- renderLeaflet({ 
    prices<-col[col$itemcat==input$witem & col$date_today==input$wdate[1],] 
    leaflet(prices) %>% 
    addTiles() %>% 
    addCircles(lng = ~lng, lat=~lat, fillColor = ~pal(infl), 
      popup = "Hello world!") 
    }) 
} 

私は意図的に読みやすくするためにaddCirclesに多くのオプションを削除しました。このコードは、マーカーをクリックすると、Hello world!というテキストのポップアップを表示します。最初のステップが完了しました。次に、データを表示してみましょう:

server <- function(input, output, session){ 
    pal <- colorQuantile("Blues", NULL, n = 5) 

    output$map <- renderLeaflet({ 
    prices<-col[col$itemcat==input$witem & col$date_today==input$wdate[1],] 
    leaflet(prices) %>% 
    addTiles() %>% 
    addCircles(lng = ~lng, lat=~lat, fillColor = ~pal(infl), 
      popup = as.character(tagList(
       sprintf("Itemcat: %s", prices$itemcat), tags$br(), 
       sprintf("Date: %s", prices$date_today) 
))) 
    }) 
} 

ここで、ポップアップで項目カテゴリと日付が表示されます。 このコードでは、フライ・マインド(異なるデータセット全体に適合し、addCirclesの代わりにaddCircleMarkersを使用しています)を編集する必要があることに注意してください。あなたが使用することもできているようです

PS:

popup = paste("Itemcat: ", prices$itemcat, "<br>", 
       "Date: ", prices$date_today,"<br>")