I am building a Shiny app with a Leaflet map based on a PostgreSQL spatialdatabase.
I succeeded to import spatial data into SpatialPolygonDataFrame and to display it on Leaflet widget.
I am trying to display the data from the SpatialDataFrame with a RenderTable output, but its not working, even by converting it with as.data.frame(spatialdataframe).
Therefore this conversion is enough to dispay the table with view(), kable() or other display functions, but not in Shiny.
Should I make another conversion? Anyone got an idea?
ui <- fluidPage(
titlePanel("AgriPAG"),
sidebarLayout(
mainPanel(
tabsetPanel(
tabPanel(leafletOutput("m",width = "100%", height = 1000)),
tabPanel(tableOutput(as.data.frame(sample_test1)))
)
),
sidebarPanel("curseur")
)
)
server <- function(input,output, session){
data <- reactive({
x <- test1
})
output$mymap <- renderLeaflet({
test1 <- data()
m <- leaflet(data = sample_test1) %>%
addTiles() %>%
setView(lng=-52.3333300, lat=4.9333300 , zoom=10) %>%
addPolygons(data=sample_test1, weight=2, col="black", opacity=0.5)
m
})
output$table <- renderDataTable(as.data.frame(sample_test1))
}
shinyApp(ui = ui, server = server)
renderDataTable does not work with tableOutput. You have to use dataTableOutput instead. In addition, you should add the correct inputId for dataTableOutput.
To get everything to work change: tableOutput(as.data.frame(sample_test1)) in your ui to dataTableOutput('table')
Related
I am building a shiny application which contains a leaflet map with markers on it, and a table with information about each marker next to it. As I zoom in the leaflet map, how would I update the table to only show markers still visible on the leaflet map?
# Minimum Viable Example
library(shiny)
library(leaflet)
library(DT)
data(quakes)
# Define UI
ui <- fluidPage(
# leaflet box
column(
leafletOutput("mymap"),
width = 8
),
#data table box
column(
DT::dataTableOutput("table"),
width = 4
)
)
# Define server logic
server <- function(input, output) {
# leaflet map
output$mymap <- renderLeaflet({
# Show first 20 rows from the `quakes` dataset
leaflet(data = quakes[1:20,]) %>% addTiles() %>%
addMarkers(~long, ~lat, popup = ~as.character(mag), label = ~as.character(mag))
})
# data table
output$table = DT::renderDataTable({
quakes
})
}
# Run the application
shinyApp(ui = ui, server = server)
Use the input$mymap_bounds event to filter the data. In your example, add library(dplyr) and change output$table to
output$table = DT::renderDataTable({
if (isTruthy(input$mymap_bounds)) {
bounds = input$mymap_bounds
quakes %>% filter(
between(long, bounds$west, bounds$east),
between(lat, bounds$south, bounds$north)
)
} else
quakes
})
Note that this filters the entire quakes table, not the 20 items you show. Modify to suit. See the Events section of this page for details:
https://rstudio.github.io/leaflet/shiny.html
This is my first Shiny app, and I just got the basics working to where it allows the user to select from a dropdown menu of clients, then a dropdown menu of test codes to receive a plot of the results for the selected test.
I'd like the second dropdown menu to be updated with the available test codes for that client (all are not present for each client). Also, I would like to be able to hover over the point in the plot and receive more information from the row in the original dataframe.
I've looked into tooltips and the nearPoints() function, but I'm not sure if these can be used on this data since it is manipulated. I'm not sure if at this point it would be easier to import the data in a different way (it will ultimately need to accept either excel files or .csv). Thanks for any help that you would be able to provide, please let me know if there is any other supporting info I can give.
Here is my code:
library(shiny)
library(scales)
library(ggplot2)
labData <-
read.table("MockNLData.csv",
header=TRUE, sep=",")
#convert '<10' and '<20' results
labData$ModResult <- labData$Result
levels(labData$ModResult)[levels(labData$ModResult)=="<10"]
<- "0"
levels(labData$ModResult)[levels(labData$ModResult)=="<20"]
<- "0"
#convert results to scientific notation
SciNotResult <-
formatC(as.numeric(as.character(labData$ModResult)),
format="e", digits=2)
ui <- fluidPage(
headerPanel("Dilution History"),
sidebarLayout(
sidebarPanel(
selectInput(inputId="client", label="Select Client
Name", choices=levels(labData$Client.Name)
),
selectInput(inputId="test", label="Select Test Code",
choices=levels(labData$Analysis))
),
mainPanel(
plotOutput("line", hover="plot_hov"),
verbatimTextOutput("info"))
)
)
server <- function(input, output) {
#selected client into data frame
selDF <- reactive({labData[labData[,1]==input$client,]
})
#selected test code into data frame
subsetDF <- reactive({selDF()[selDF()[,5]==input$test,]
})
#points to be plotted
points <-
reactive({as.numeric(levels(subsetDF()$ModResult))
[subsetDF()$ModResult]
})
#plot
output$line <- renderPlot({
qplot(seq_along(points()), points(), xlab ="Index",
ylab ="Result")
})
#hover information
output$info <- renderText({
paste0("x=", input$plot_hov$x, "\ny=",
input$plot_hov$y)
})
}
shinyApp(ui = ui, server = server)
Here is what the data looks like:
MockNLData.csv
EDIT: I figured out updating the menu with updateSelectInput()
In the future, make sure you share a reproducible example :)
Since your code is not reproducible please find below something you can understand and adapt to your case.
On your first question, if I understand correctly, you want to programatically generate a dropdown (selectInput) which is perfectly do-able. *Inputs are, in essence, just HTML content which you can dynamically generate, just like your plots. You do so with uiOutput (in your ui) and renderUI in your server.
library(shiny)
ui <- fluidPage(
selectInput("dataset", "Select a dataset", choices = c("cars", "mtcars")),
uiOutput("column"), # dynamic column selector
verbatimTextOutput("selected_column")
)
server <- function(input, output, session){
data <- reactive({
if(input$dataset == "cars")
return(cars)
else
return(mtcars)
})
output$column <- renderUI({
# build your selectInput as you normally would
selectInput("column_selector", "Select a column", choices = colnames(data()))
})
output$selected_column <- renderPrint({
# use input$column_selector!
print(input$column_selector)
})
}
shinyApp(ui, server)
On your second question, what you want is an interactive plot. There are numerous packages that will let you do that in R and Shiny. Below are some examples, by no means a comprehensive list:
plotly which will also let you make your ggplot2 charts interactive
highcharter another great, well tested library
echarts4r ECharts for R.
billboarder billboard.js for R and Shiny
Below is an example using highcharter. They all follow the same principle within Shiny, an *Output function coupled with a render* function.
library(shiny)
library(highcharter)
ui <- fluidPage(
highchartOutput("chart")
)
server <- function(input, output, session){
output$chart <- renderHighchart({
hchart(mpg, "scatter", hcaes(x = displ, y = hwy, group = class))
})
}
shinyApp(ui, server)
EDIT
Following your question on the flashing error. You need to require (req) the required input. When launching the app below the error will flash, uncomment the req(input$y) line and it'll go away.
library(shiny)
ui <- fluidPage(
uiOutput("sel"),
plotOutput("plot")
)
server <- function(input, output){
output$sel <- renderUI({
numericInput("y", "N:", value = 200, min = 5, max = 1000, step = 100)
})
output$plot <- renderPlot({
# req(input$y)
hist(runif(input$y, 1, 10))
})
}
shinyApp(ui, server)
In essence, since your plot relies on a dynamically generating input for a fraction of second that input is not available as it is being rendered, using req prevents that.
What I understand from your problem above are:
You want to make next dropdown menu based on what the user have chosen from previous dropdown menu.
When the mouse over the point on the plot, it will show row value.
So, here i will give you reproducible example and i hope it is useful for you.
In this example I use Rabbit dataset from library MASS.
To filter data for next dropdown menu, I use filter from library
dplyr (See line 30).
I use reactive expression to manage next dropdown menu (See line
29).
I use nearPoints() to manage hover point (See line 55).
library(shiny)
library(MASS)
library(dplyr)
library(ggplot2)
ui <- fluidPage(
titlePanel("Rabbit dataset from MASS library"),
fluidRow(
column(4, selectInput("var",
"Animal:",
unique(sort(Rabbit$Animal)))),
column(4, uiOutput("selected_var")),
column(4, uiOutput("selected_var1")),
column(12, plotOutput("selected_var2", hover = "plot_hover")),
column(12, verbatimTextOutput("info"))
)
)
server <- function(input, output) {
###FILTER NEXT DROPDOWN MENU BASED ON PREVIOUS SELECTED BY USER
dataset3 <- reactive({
unique(Rabbit %>% filter(Animal == input$var) %>% select(Treatment))
})
output$selected_var <- renderUI({
selectInput("var1", "Treatment:", c(dataset3()))
})
dataset4 <- reactive({
Rabbit %>% filter(Animal == input$var) %>% filter(Treatment == input$var1) %>% select(Run)
})
output$selected_var1 <- renderUI({
selectInput("var2", "Run:", c(dataset4()))
})
####
output$selected_var2 <- renderPlot({
ggplot(Rabbit %>% filter(Animal == input$var) %>% filter(Treatment == input$var1) %>% filter(Run == input$var2), aes(x = BPchange, y = Dose)) + geom_point()
})
###HOVER POINT USING nearPoints()
output$info <- renderPrint({
nearPoints(Rabbit %>% filter(Animal == input$var) %>% filter(Treatment == input$var1) %>% filter(Run == input$var2), input$plot_hover)
})
}
shinyApp(ui = ui, server = server)
I am able to use the data.tree package to produce a plot. Here is an example of a plot:
library(data.tree)
org <- Node$new("Parent")
org$AddChild("Child_1")
org$AddChild("Child_2")
plot(org)
However, I am not able to render this plot in R-Shiny. I have been able to render most other plots in Shiny. What can I do to render this plot, and why is it not showing up? Here is my Shiny code:
library(shiny); library(data.tree)
ui <- fluidPage(
mainPanel(plotOutput("orgplot") )
)
server <- function(input, output){
rv <- reactiveValues()
org <- Node$new("Parent")
org$AddChild("Child_1")
org$AddChild("Child_2")
output$orgplot <- renderPlot({ plot(org)})
}
shinyApp(ui = ui, server = server)
plot(org) generate widget of class grViz So you can use renderGrViz to show plot in shiny.
Like ( textInput used for example of change name of "parent")
library(shiny);
library(data.tree)
library(DiagrammeR)
ui <- fluidPage(
mainPanel(grVizOutput("xx") ),
textInput("parent","parent","parent")
)
server <- function(input, output){
output$xx=renderGrViz({
org <- Node$new(input$parent)
org$AddChild("Child_1")
org$AddChild("Child_2")
grViz(ToGraphViz(org),engine = "dot")
})
}
shinyApp(ui = ui, server = server)
Update add node dynamically
If You want to add nodes dynamically you can try to add child to node by name( you need some checks to avoid names duplicate)
New functions to draw chart get from #rpm answer
ui <- fluidPage(
mainPanel(uiOutput("add_child_ui"),
grVizOutput("xx") )
)
server <- function(input, output){
#Create reative value to app
vv=reactiveValues(org=NULL,names=NULL)
#create main tree
observe({
vv$org <- Node$new("Parent1")
vv$org$AddChildNode(child = Node$new("1"))
vv$names=vv$org$Get('name') # get names of main tree
})
output$add_child_ui=renderUI({
list(
wellPanel(
selectInput("Name_to_change","Name_to_change",vv$names),
textInput("new_name","new_name",""),
actionButton("Change_name","Change_name")
),
wellPanel(
selectInput("Parent_name","Parent_name",vv$names),
textInput("new_node_name","new_node_name",""),
actionButton("add_child","add_child")
))
})
observeEvent(input$Change_name,{
aa=FindNode(node=vv$org,name = input$Name_to_change)
aa$name=input$new_name # Change name
vv$names=vv$org$Get('name')# get names of new tree
#re-generate chart
output$xx=renderGrViz({
grViz(DiagrammeR::generate_dot(ToDiagrammeRGraph(vv$org)),engine = "dot")
})
})
observeEvent(input$add_child,{
FindNode(node=vv$org,name = input$Parent_name)$AddChildNode(Node$new(input$new_node_name)) # add child
vv$names=vv$org$Get('name')# get names of new tree
#re-generate chart
output$xx=renderGrViz({
grViz(DiagrammeR::generate_dot(ToDiagrammeRGraph(vv$org)),engine = "dot")
})
})
output$xx=renderGrViz({
grViz(DiagrammeR::generate_dot(ToDiagrammeRGraph(vv$org)),engine = "dot")
})
}
shinyApp(ui = ui, server = server)
This code does not work as the ToGraphViz function has been retired from DiagrammeR and replaced with ToDiagrammerGraph. The following change works.
# grViz(ToGraphViz(org),engine = "dot")
grViz(DiagrammeR::generate_dot(ToDiagrammeRGraph(org)))
Also, "parent" is a reserved word so I replaced it "parent2".
I have a problem with my code. Every time I click a button my plot (built with ggvis) is showing up but vanishes immediately. Since my code is very long, the following code reproduces my problem. I want to reuse the reactive data frame test0 in my render function and I guess this is exactly what causes my problem. But this is essential to me. The three steps (reactive, observe, render) are the same than in my code. I would very much appreciate your help!
server.R
library(shiny)
library(ggvis)
library(dplyr)
data(mtcars)
shinyServer(function(input, output) {
test0 <- reactive({
df <- mtcars %>% select(mpg, wt)
(input$NextCounter + 1)*df
})
observe({
df <- test0()
if (!is.null(df)) {
ggvis(df, x = ~wt, y = ~mpg) %>% bind_shiny("plotggvis")
}
})
output$test1 <- renderUI({
df <- test0()
ggvisOutput("plotggvis")
})
})
ui.R
library(shiny)
shinyUI(fluidPage(
sidebarLayout(
sidebarPanel(
actionButton("NextCounter", "Next")
),
mainPanel(
uiOutput("test1")
)
)
))
this one working for me
library(shiny)
library(ggvis)
library(dplyr)
ui <- shinyUI(fluidPage(
sidebarLayout(
sidebarPanel(
actionButton("NextCounter", "Next")
),
mainPanel(
ggvisOutput("plotggvis")
)
)
))
server <- shinyServer(function(input, output) {
data(mtcars)
test0 <- reactive({
df <- mtcars %>% select(mpg, wt)
(input$NextCounter + 1)*df
})
my_graph <- reactive({
df <- test0()
ggvis(df, x = ~wt, y = ~mpg)
})
my_graph %>% bind_shiny("plotggvis")
})
})
shinyApp(ui = ui, server = server)
You don't need to have a ggvisOutput in the UI to solve your problem. Actually the problem in your code is having the bind_shiny function inside an observer that will be executed again every time your test0 data changes. It is expected to bind your ggvis only once, otherwise it will have that behavior of showing up and vanishes immediately. Also, one great feature of ggvis is having a nice transitions when data is changing, so you don't need to create a ggvis object every time your data changes, just make sure that you only bind that ggvis object once in your UI.
Below is a modified version of your code to solve your problem and show the animated transition of data.
library(shiny)
library(ggvis)
library(dplyr)
data(mtcars)
ui <- fluidPage(fluidPage(
sidebarLayout(
sidebarPanel(
actionButton("NextCounter", "Next")
),
mainPanel(
uiOutput("test1")
)
)
))
server <- function(input, output) {
test0 <- reactive({
input$NextCounter
df <- mtcars %>% select(mpg, wt)
df[sample(nrow(df),nrow(df)/2), ]
})
output$test1 <- renderUI({
# bind the ggvis only once
test0 %>% ggvis(x = ~wt, y = ~mpg) %>% bind_shiny("plotggvis")
ggvisOutput("plotggvis")
})
}
shinyApp(ui, server)
You can also modify some ggvis parameters using input widgets by putting the ggvis inside of a reactive expression.
I am trying to create an interactive webmap in R to display locations using Shiny and Leaflet
The idea is that the user selects one input and the markers corresponding to that input(lat/long which are to be fetched from data set of the corresponding input) are displayed in a Leaflet map (with zoom in/out function).
Any help/advice would be greatly appreciated!
(sample data file uploaded here):
enter code here
Server.R
library(shiny)
library(rpart.plot)
library(leaflet)
shinyServer(
function(input, output) {
output$dtmplot <- renderPlot({
dtmplot <- rpart.plot(dtm, type=4, extra=101)
})
observe({
output$map <- renderLeaflet( {
for(j in 1:nrow(df))
{
if(df[j, "col1"]==input$input1) {
map <- leaflet() %>%
addTiles() %>%
addMarkers(lng=df[j,"Longitude"], lat=df[j,"Latitude)
}
}
})
})
}
)
enter code here
UI.R
library(shiny)
library(leaflet)
shinyUI(
pageWithSidebar(
headerPanel("Sample project"),
sidebarPanel(
plotOutput("dtmplot"),
selectInput("input1",
label = "label1:",
choices = c(“choice1”,”choice2”),
selected = " choice1"),
sliderInput("slider","Please select slider input", min=1,max=100,value=20,step=10)
),
mainPanel(
leafletOutput("map")
)
))
The basic code to handle custom points in a leaflet map is available below. The code utilises the official example available on the leaflet GitHub and provided end-user with the functionality to display custom location on the map.
app.R
library(shiny)
library(leaflet)
r_colors <- rgb(t(col2rgb(colors()) / 255))
names(r_colors) <- colors()
ui <- fluidPage(
leafletOutput("mymap"),
p(),
h1("Added example to add more points here:"),
p(),
numericInput("long", label = h3("Longitude:"), value = 11.242828),
numericInput("lat", label = h3("Latitude:"), value = 30.51470),
actionButton("recalc", "Show point")
)
server <- function(input, output, session) {
points <- eventReactive(input$recalc, {
cbind(input$long, input$lat)
}, ignoreNULL = FALSE)
output$mymap <- renderLeaflet({
leaflet() %>%
setView(lat = 30, lng = 11, zoom = 4) %>%
addProviderTiles("Stamen.TonerLite",
options = providerTileOptions(noWrap = TRUE)
) %>%
addMarkers(data = points())
})
}
shinyApp(ui, server)
Results
The obtained map looks like that:
Explanation
The mechanics is fairly simple and can be summarised in the following steps:
You need to pas lat and lon to your map to addMarkers. In my example this is done via primitive input files but it can be done in a number of ways.
You have to decide on the logic of dynamically adding markers to your map; in the presented case this is done with use of an actionButton.
Side notes
As at the time of drafting this answer there was no clarity with respect to the actual data that should be represented on the map, I found it more informative to generate the desired functionality following the official example instead of trying to modify the provided code.
The thing worth noting is that the lat/lon values have to be of correct format to appear on the map.
The map setView to make the example more presentable but in an actual solution, default lat/lon values should be generated dynamically.