I am having trouble setting the title of the axis using ggvis reactive, xVar()/yVar() as I change the variable I am looking at using renderUI, so the title of both x and y in my ggvis plots is updated. My code works as I change the variable x or y, but a couple of seconds after changing the variable, it automatically resents to the original starting value. This is the full server.R
Help please!
output$map <- renderLeaflet({
print('render map')
leaflet(FULL) %>%
addSearchOSM(options = searchOSMOptions(position = 'topleft', zoom = 5)) %>%
addProviderTiles("OpenStreetMap.Mapnik", group = "OpenStreetmap") %>%
addProviderTiles("Esri.WorldImagery", group = "Esri.WorldImagery") %>%
setView(lng = 0, lat = 50, zoom = 2) %>%
addLayersControl(baseGroups = c('Esri.WorldImagery',"OpenStreetmap", ),
options = layersControlOptions(collapsed = TRUE, autoZIndex = F, position = 'bottomleft' ))
})
df <- datasets[['FULL']]
makeReactiveBinding('df')
observeEvent(input$dataset,{
print('dataset')
leafletProxy('map')%>%clearShapes()
df <<- datasets[[input$dataset]]
i.active <<- NULL
})
coords <- reactive({
print('coords')
crds <- data.frame(coordinates(df))
leafletProxy('map')%>%fitBounds(lng1=min(crds[,1]),lng2=max(crds[,1]),
lat1=min(crds[,2]),lat2=max(crds[,2]))
crds
})
output$yvar <- renderUI(selectInput('yvar',label='variable B',choices = names(df),selected = names(df)[2]))
output$xvar <- renderUI(selectInput('color',label='variable A (mapped)',choices = names(df),selected = names(df)[1]))
xVar <- reactive({
print('xVar')
if(is.null(input$xvar)) return(names(df)[1])
xvar_ <<- input$xvar
input$xvar})
yVar <- reactive({
if(is.null(input$yvar)) return(names(df)[2])
input$yvar})
xVar <- reactive({
print('colVar')
if(is.null(input$color)) return(names(df)[1])
input$color})
ggvisdf <- reactive({
print('ggvesdf1')
df1 <- isolate(df@data)
gdf <- df1[, c(xVar(), yVar())]
names(gdf) <- c("x", "y")
gdf
})
colorData <- reactive({
print(names(input))
print('colData')
df1 <- isolate(df@data)
df1[,xVar()]})
colorpal <- reactive(colorNumeric(input$pal, colorData()))
pal <- reactive({colorpal()(colorData())})
observe({
print('update map size/opa/color')
x <- coords()[,1]
y <- coords()[,2]
leafletProxy('map')%>%
clearShapes() %>%
addCircleMarkers(lng=x,fillColor = pal(),
lat=y,
stroke = F,
layerId = as.character(1:length(x)),
radius = input$size/10,
color = 'blue',
fillOpacity = 1,
popup = paste("ID:", FULL$id, "<br>",
"Name: ", FULL$name, "<br>",
"Country: ", FULL$country, "<br>") )
})
observe({
print('legend')
leafletProxy("map")%>%
clearControls() %>%
addLegend(opacity = 1,position = "bottomright",title = xVar(),
pal = colorpal(), values = rev(colorData()))
})
mapData <- reactive({
print('mapdata')
mb <- input$map_bounds
if(is.null(mb))
return(1)#as.vector(rep(1,nrow(coords()))))
if(nrow(coords())!=nrow((ggvisdf())))
return(1)
as.numeric(coords()[,1]>mb$west&coords()[,1]<mb$east&
coords()[,2]>mb$south&coords()[,2]<mb$north)+0.1
})
tooltip <- function(x) {
ggvisHover <<- x
if(is.null(x)) return(NULL)
tt<<-paste0(c(xVar(),yVar()), ": ", format(x[1:2]), collapse = "<br/>")
leafletProxy('map') %>%addControl(tt,layerId = 'tt',position = 'topright')
tt
}
#########
ggvisHover <- NULL
makeReactiveBinding('ggvisHover')
i.active <- NULL
makeReactiveBinding('i.active')
observeEvent(ggvisHover,{
h <- ggvisHover[1:2]
i.active <<- ggvisdf()[,'x']==h[[1]]&ggvisdf()[,'y']==h[[2]]
})
observeEvent(input$map_marker_mouseover,{
id <- as.numeric(input$map_marker_mouseover$id)
if(!is.na(id)){
i.active <<- id
}
})
mouseOver <- reactive({
p <- ggvisdf()[i.active,c('x','y')]
if(class(i.active)=='numeric'){tooltip(p)}
p
})
####
#######Table
output$a <- DT::renderDataTable(descriptiondataset, filter = 'top', options = list(
pageLength = 5, autoWidth = TRUE))
output$FULL <- DT::renderDataTable(FULL.val, filter = 'top', options = list(
pageLength = 5, autoWidth = TRUE))
######Big plot X vs y
ggvisdf %>%
ggvis(~y,~x) %>%
set_options(width = "auto", height = "auto", resizable=TRUE) %>%
# add_axis("x", title = xVar()) %>%
add_axis("x", title = xVar(), grid = TRUE, title_offset = 40, properties = axis_props(
axis = list(stroke = "red"),title = list(fontSize = 20),
labels = list(fontSize = 16))) %>%
add_axis("y", title = yVar(), grid = TRUE, title_offset = 60, properties = axis_props(
axis = list(stroke = "blue"),title = list(fontSize = 20),
labels = list(fontSize = 16))) %>%
layer_points(size := input_slider(1, 100, value = 50,id='size',label = 'Size'),
opacity := 1,
fill := pal) %>%
add_tooltip(tooltip, "hover") %>%
layer_points(data =mouseOver,stroke:='blue',size := 150,fillOpacity=0,strokeWidth:=5) %>%
layer_model_predictions(model = "lm", se = TRUE) %>%
layer_model_predictions(model = "MASS::rlm", stroke := "red") %>%
bind_shiny("p",'ui')
#####density plot X
ggvisdf %>%
ggvis(~x) %>%
set_options(width = "auto", height = "auto", resizable=TRUE) %>%
add_axis("x", title = yVar,properties = axis_props(
axis = list(stroke = "red"),
title = list(fontSize = 20),
labels = list(fontSize = 10))) %>%
add_axis("y", title = 'count', properties = axis_props(
axis = list(stroke = "red"),
title = list(fontSize = 20),
labels = list(fontSize = 10))) %>%
layer_histograms(width = 0.5, center = 20, fill := "red") %>%
layer_points(data =mouseOver,stroke:='black',shape := "triangle-down", size := 50) %>%
bind_shiny("p2")
#####density plot y
ggvisdf %>%
ggvis(~y) %>%
set_options(width = "auto", height = "auto", resizable=TRUE) %>%
add_axis("x", title = xVar(), properties = axis_props(
axis = list(stroke = "blue"),
title = list(fontSize = 20),
labels = list(fontSize = 10))) %>%
add_axis("y", title = 'count', properties = axis_props(
axis = list(stroke = "blue"),
title = list(fontSize = 20),
labels = list(fontSize = 10))) %>%
layer_histograms(width = 0.5, center = 20, fill := "blue") %>%
layer_points(data =mouseOver,stroke:='black',shape := "triangle-down", size := 50) %>%
bind_shiny("p3")
})
})