I am trying to create a shiny app to render the 3d point cloud, but I am not sure where to start. Can anyone please help with an example?
Tried the following code but it is giving me pop up
library(shiny)
library(lidR)
library(rlang)
library(rgl)
library(ggplot2)
library(rglwidget)
las<-readLAS("S://change_detction//Snow_on//points (6).las")
str(las)
# Define UI for application that draws a histogram
ui <- fluidPage(
# Application title
titlePanel("LiDAR Visualisation"),
# Sidebar with a slider input for number of bins
rglwidgetOutput("plot", width = 800, height = 600)
# Show a plot of the generated distribution
#mainPanel(
#rglwidgetOutput("distPlot",width = 300, height = 300)
)
# Define server logic required to draw a histogram
server <- function(input, output,session) {
output$plot<- renderRglwidget({
rgl.open()
# generate bins based on input$bins from ui.R
plot(las)
rglwidget()
})
}
# Run the application
shinyApp(ui = ui, server = server)
Related
I am building an shiny app, where users upload a bunch of data and than choose which should be computed. The computation itself is rather timeconsuming and should be stored in a list. To keep shiny responsive during the calculation (for the user and other users) I tried to utilize promises and future. The problem is that I am not able to get an input into future function. I always get Warning: Error in $: Can't access reactive value 'mem_pos' outside of reactive consumer. i Do you need to wrap inside reactive() or observe()? [No stack trace available]. I tried to read about reactive but I am simply stuck.
Here is a minimal example of the problem (to display it, the list has only one value each):
library(shiny)
library(promises)
library(future)
plan(multisession)
# example function
subfct = function(n) {
Sys.sleep(3)
return(n*2)
}
# shiny page
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
numericInput("mem_pos", min = 1, max = 30, value = 1, label="mem pos"),
actionButton("mem_button", label="set mem value")
),
mainPanel(
tableOutput("result")
)
)
)
server <- function(input, output) {
superval = reactiveValues(mem = rep(list(0), 10))
# set the future calculations
observeEvent(input$mem_button, {future({return(subfct( input$mem_pos ))}) %...>% {superval$mem[[input$mem_pos]] = .}}) # here lies the problem
# show result table
observe( {output$result = renderTable({unlist(superval$mem)})})
}
# Run the application
shinyApp(ui = ui, server = server)
If the problematic line is exchanged by observeEvent(input$mem_button, {future({return(subfct( 5 ))}) %...>% {superval$mem[[input$mem_pos]] = .}}) it basically works. But I am not able to get the user input into the function. I am grateful for a direct help or an explanation of reactive for my specific problem.
I solved it. Not enterily sure why, but isolate does the trick.
This code works for me:
library(shiny)
library(promises)
library(future)
plan(multisession)
# example function
subfct = function(n) {
Sys.sleep(3)
return(n*2)
}
# shiny page
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
numericInput("mem_pos", min = 1, max = 30, value = 1, label="mem pos"),
actionButton("mem_button", label="set mem value")
),
mainPanel(
tableOutput("result")
)
)
)
server <- function(input, output) {
superval = reactiveValues(mem = rep(list(0), 10))
# set the future calculations
observeEvent(input$mem_button, {future({return(subfct( isolate(input$mem_pos) ))}) %...>% {superval$mem[[input$mem_pos]] = .}}) # here lied the problem
# show result table
observe( {output$result = renderTable({unlist(superval$mem)})})
}
# Run the application
shinyApp(ui = ui, server = server)
You may try to use delay() function from shinyjs package. This enables the code to run only after the times set lapses. e.g.
library(shinyjs)
ui<-fluidPage(useShinyjs(),
...)
server<-function(input,output, session){
delay (ms=,
...)
}
shinyApp(ui,server)
I am building an app with RShiny that renders a pdf as a PNG image which is then shown via a call to imageOutput (If needed, the image can be rendered via a different output, such as plotOutput).
I would like the user to be able to mouse-over or hover over the image to show a larger, more zoomed in version or subset of that same image (Example below).
Is there a way to accomplish this in Shiny?
Thank you
Here is an attempt based on w3schools:
library(shiny)
ui <- fluidPage(
uiOutput('image'),
tags$style('div#image:hover {
transform: scale(1.5);
transform-origin: top left;
}')
)
server <- function(input, output, session) {
output$image <- renderUI({
tags$img(src = 'https://i.stack.imgur.com/dlaci.jpg', width = 400)
})
}
shinyApp(ui, server)
Please play around with transform and transform-origin to suit your needs.
I'm trying to create a shiny app and I can't seem to find the error in my code.
I keep getting this error here:
Error in match.arg(position) : 'arg' must be NULL or a character vector
I'm am also unsure as to what the inputs should be.
library(shiny)
# Define UI for application that draws a histogram
ui <- fluidPage(
titlePanel("Linear Regression Shiny App"),
sidebarLayout(
sidebarPanel(
h1("Linear Regression"),
p("Select inputs for the Response
Variable"),
selectInput("ResVar",
"Response Variables:",
c("","","")
),
p("Select inputs for the Predictor
Variable"),
selectInput("PreVar",
"Predictor Variables:",
c("","","")
),
actionButton("goButton","Go!"),
plotOutput("distPlot")),
mainPanel =
verbatimTextOutput("ResVarPrint"),
verbatimTextOutput("PreVarPrint")
))
# Define server logic required to draw a histogram
server <- function(ResVar,PreVar) {
lm1 <- reactive({reformulate((input$ResVar),(input$PreVar))})
output$ResPrint <- renderPrint({input$ResVar})
output$PrePrint <- renderPrint({input$PreVar})
output$RegSum <- renderPrint({summary(lm1())})
}
# Run the application
shinyApp(ui = ui, server = server)
You had misplaced some parenthesis near the end of you UI code, and tried to use mainPanel= instead of the proper mainPanel(. The UI code below addresses the error and gets your app to load.
ui <- fluidPage(
titlePanel("Linear Regression Shiny App"),
sidebarLayout(
sidebarPanel(
h1("Linear Regression"),
p("Select inputs for the Response
Variable"),
selectInput("ResVar",
"Response Variables:",
c("","","")
),
p("Select inputs for the Predictor
Variable"),
selectInput("PreVar",
"Predictor Variables:",
c("","","")
),
actionButton("goButton","Go!"),
plotOutput("distPlot")
),
mainPanel(
verbatimTextOutput("ResVarPrint"),
verbatimTextOutput("PreVarPrint")
)
)
)
However, you may want to consider whether you actually want your plotOutput in the sidebar or whether you want it in the main panel, in which case you'll need to move it down.
I am trying to make an app that allow user to input data and then let shiny server to calculate some results, for example, I could make shiny generate a plot or a data table.
However, due to the space of the UI, I kind of "run out of" space. The input box, and documentation of the app take a whole screen. And when the shiny generate the results it will show at the very bottom of the screen.
Is there a way that I can make shiny pop-up a message box to show the result?
My sudo-code would be:
ui <- fluidPage(
textInput("text", "Name"),
numericInput("age", "Age", 20),
actionButton("demo", "Fill in fields with demo"))
server <- function(input, output, session) {
observeEvent(input$demo, {
****************************
OpenNewPage/MoveScreenDown()
****************************
updateTextInput(session, "text", value = H)
updateNumericInput(session, "age", value = "30")
})}
When clicking the "demo", a message box popup or I can make the screen move to the result part and allow the text to be at the top of the screen.
There are options to show your results in a separated window. But maybe will be easier to have everything on the same window.
You can use the shinyBS library to create a modal window to show the plot. Another option is to use JavaScript to move the scroll to the bottom of the page. I put the two options in the following example, so you can see which one is better for you.
library(shiny)
library(shinyBS)
runApp(list(
ui = shinyUI(fluidPage(
textInput("text", "Name"),
numericInput("age", "Age", 20),
# option 1, using ShinyBS with a modal window
actionButton("demo", "Using a modal"),
# modal window to show the plot
bsModal("largeModalID","Results", "demo", size = "large", plotOutput('plot')),
# Option 2, action button with a JavaScript function to move the scroll to the bottom
# after drawing the plot.
actionButton("demoJS", "Using JS",
# there is a delay to allow the renderPlot to draw the plot and you should
# change it according to the processes performed
onclick = "setTimeout( function() {
$('html, body').scrollTop( $(document).height() );},
300)"),
# to plot the results after click on "Using JS"
uiOutput("plotUI")
)
),
server = shinyServer(function(input, output, session) {
output$plot <- renderPlot({
# simple plot to show
plot(sin, -pi, 2*pi)
})
output$plotUI <- renderUI({
# this UI will show a plot only if "Using JS" is clicked
if (input$demoJS > 0)
# the margin-top attribute is just to put the plot lower in the page
div(style = "margin-top:800px", plotOutput('plot2'))
})
output$plot2 <- renderPlot({
# another simple plot,
plot(sin, -pi, 2*pi)
})
})
))
If you think that the JavaScript option works better for you, you could consider start using the shinyjs library, it includes very useful functions and you can easily add your own JavaScript code to your Shiny Apps.
I have programmed a shiny app in RStudio using R version 3.2.4. The app can be found here: https://koenvandenberge.shinyapps.io/tempConditioning/
Note that there is quite a lot of data to be loaded so it takes a couple of seconds to load.
I have deployed it on my Macbook and it seems as if it only works on Safari and Chromium browsers. It does not seem to work on Chrome or Firefox browsers. With this I mean that the plots which should be generated are not. The drop-down menu is present as it should be, so the app does not crash, but the plots that should be generated by selecting something from the drop-down menu do not.
Is there any way to fix this? You can find the code of my app below:
library(shiny)
library(scales)
load("countMatrix.RData")
countMatrixAllSub = as.data.frame(countMatrix$counts[,-1]) ; rm(countMatrix)
sampleNames = unlist(lapply(strsplit(colnames(countMatrixAllSub),split=".",fixed=TRUE), function(x) x[4]))
sampleNames[28] <- "3c0a"
treat=substr(sampleNames,2,2)
time=substr(sampleNames,3,nchar(sampleNames)-1)
timeC=as.numeric(time)
timeC[timeC==15]=0.25
ui <- shinyUI(fluidPage(
# Application title
titlePanel("Gene expression: conditioning experiment Gust"),
# Sidebar with a
sidebarLayout(
sidebarPanel(
selectInput("gene",
"Pick a gene",
choices = rownames(countMatrixAllSub))
),
# Show a plot of the generated distribution
mainPanel(
plotOutput("genePlot")
)
)
))
# Define server logic required to draw an expression plot
server <- shinyServer(function(input, output) {
output$genePlot <- renderPlot({
par(mar = c(5.1, 4.1, 3, 1))
plot(y=countMatrixAllSub[input$gene,],x=timeC, col=c("black","red")[as.numeric(factor(treat))], pch=19,cex=.6,xaxt="n",xlab="Time", ylab="Expression")
lines(x=unique(timeC[!timeC==0]),y=colMeans(sapply(unique(timeC[!timeC==0]), function(t) as.matrix(countMatrixAllSub[input$gene,treat=="c" & timeC==t]))), col=1)
lines(x=unique(timeC[!timeC==0]),y=colMeans(sapply(unique(timeC[!timeC==0]), function(t) as.matrix(countMatrixAllSub[input$gene,treat=="t" & timeC==t]))), col=2)
axis(1,at=c(0,0.25,1,3,6,9),labels=c("","15m","1h","3h","6h","9h"))
abline(v=c(0,0.25,1,3,6,9),col=alpha("grey",.6))
mtext("Conditioned",side=3, adj=0,col="red")
mtext("Unconditioned",side=3, adj=0.2, col="black")
})
})
# Run the application
shinyApp(ui = ui, server = server)