Custom HTTP Handler using Rook - html

I am building this app using the Rook package in R:
library(Rook)
s <- Rhttpd$new()
s$start(quiet=T)
PIC.DIR = paste(getwd(), 'pic', sep='/')
my.app <- function(env){
## Start with a predefined lognormal mean and median, and allow a user to input custom values
req <- Request$new(env)
res <- Response$new()
E <- 1.5
MED <- 1
xmax <- 5
breaks <- 500
## Allow user to input custom mean/median values
if (!is.null(req$POST())){
E <- as.numeric(req$POST()[["mean"]])
MED <- as.numeric(req$POST()[["median"]])
xmax <- as.numeric(req$POST()[["xmax"]])
breaks <- as.numeric(req$POST()[["breaks"]])
}
mu <- log(MED)
sd <- sqrt(2*log(E/MED))
MO <- exp(mu - sd^2)
rate <- rlnorm(1000000, mu, sd)
today <- Sys.Date()
dt <- format(today, format="%m/%d/%y")
sc <- paste("Source: My Source, accessed ", dt)
png(file=paste(PIC.DIR, "/mypic.png", sep=""), width=1024, height=612)
h1 <- hist(rate, freq=F, col="red", xlim=c(0,xmax), breaks=breaks, main="Rate",
xlab="Rate", ylab="# of Studies", sub=sc)
dev.off()
res$write('<head>
<title> Rate Curve </title>
</head>
<h1>Rate Distribution Analysis</h1>')
res$write(paste("<img src='", s$full_url("pic"), "/mypic.png'",
"width='1024 px' height='612 px' />", sep = ""))
res$write('<p>
Input Lognormal Parameters:<form method="POST"> </br>
mean: <input type="text" name="mean" value="1.5" /> </t>
median: <input type="text" name="median" value="1" /> </br>
</br>
Graphics parameters </br>
X-axis limit: <input type="text" name="xmax" value="5" /> </t>
Histogram breaks: <input type="text" name="breaks" value="500" /> </br>
<input type="submit" name="Go" />\n</form>
</p>')
res$finish()
}
s$add(app=my.app, name='lognorm')
s$add(app = File$new(PIC.DIR), name = "pic")
s$browse('lognorm')
The browser initially loads fine, but when I try to enter different values in the inputs, I get this error:
R Custom HTTP Handler Not Found
Unable to locate custom HTTP handler for /custom/lognorm_mode
Is the package which implements this HTTP handler loaded?
Any ideas on how to solve this?

Instead of the last part
s$add(app=my.app, name='lognorm')
s$add(app = File$new(PIC.DIR), name = "pic")
s$browse('lognorm')
Try
library(Rook)
myPort <- 23845
myInterface <- "127.0.0.1"
status <- -1
status <- .Internal(startHTTPD(myInterface, myPort))
if (status == 0) {
unlockBinding("httpdPort", environment(tools:::startDynamicHelp))
assign("httpdPort", myPort, environment(tools:::startDynamicHelp))
s <- Rhttpd$new()
s$listenAddr <- myInterface
s$listenPort <- myPort
s$launch(name = "lognorm", app = my.app)
}
This should keep the server alive even after the web page is launched.
(Source http://jeffreyhorner.tumblr.com/post/33814488298/deploy-rook-apps-part-ii)

Related

Unable to save reactive value from an html template for RShiny

I've been struggling with this, below is a much simplified version of my issue but here is the idea : I have a table with 4 text areas using an html template. When the user types into one of the 4 text areas (he can only input text in one), a score is assigned - cell 1 =1, cell 2 = 2 etc. Pulling the string content is not a problem but I can't seem to get the score assigned to save properly I'm not sure of what I am doing wrong.
library(shiny)
ui <- fluidPage(
column(
12,
actionButton("save_project", "save")),
column(
width = 12,
h4("Assessment #1"),
htmlTemplate(
filename = "market_table.html",
indicator = "market_creation_attr_1"
)
)
)
server <- function(input, output, session) {
market_ table_1_score <- reactiveVal(NULL)
observeEvent(c(input$market_creation_attr_1_market_rating_1,input$market_creation_attr_1_market_rating_2,input$market_creation_attr_1_market_rating_3,input$market_creation_attr_1_market_rating_4), {
if (!is.na(input$market_creation_attr_1_market_rating_1)||is.null(input$market_creation_attr_1_market_rating_1)){
market_table_1_score<-1
} else if (!is.na(input$market_creation_attr_1_market_rating_2)){
market_table_1_score<-2
}else if (!is.na(input$market_creation_attr_1_market_rating_3)){
market_table_1_score<-3
}else if(!is.na(input$market_creation_attr_1_market_rating_4)){
market_table_1_score<-4
}
market_table_1_score
})
observeEvent(input$save_project, {
inputs <- reactiveValuesToList(input)
filepath <- file.path("save", paste0("input-.rds"))
saveRDS(inputs, file = filepath)
all_values <- reactiveValuesToList(values)
filepath <- file.path("save", paste0("values--.rds"))
saveRDS(all_values, file = filepath)
})
}
shinyApp(ui=ui, server=server)
And this is the template of the html table (not sure that's relevant)
<div class="market-table">
<ul class="market-header">
<li style="border-right: 1px solid black"><div>Market Typology</div></li>
<li><div>Highly Developed</div></li>
<li><div>Moderately Developed</div></li>
<li><div>Under Developed</div></li>
<li><div>Highly Under Developed</div></li>
</ul>
<ul class="market-row">
<li>INDICAOTR</li>
<li>
<textarea id="{{ paste0(indicator, '_market_rating_1')}}" rows="5" maxlength="500"></textarea>
</li>
<li>
<textarea id="{{ paste0(indicator, '_market_rating_2')}}" rows="5" maxlength="500"></textarea>
</li>
<li>
<textarea id="{{ paste0(indicator, '_market_rating_3')}}" rows="5" maxlength="500"></textarea>
</li>
<li>
<textarea id="{{ paste0(indicator, '_market_rating_4')}}" rows="5" maxlength="500"></textarea>
</li>
</ul>
</div>
Any advice is greatly appreciated!
after spending several hours on the (I'm still a beginner), I found noticed 2 major errors : 1. in my condition, it shouldn't be !is.na, rather I should have used !='' 2. and this is pretty important, I didn't create an empty object to store the reactive values...oops.
Here is a working code (see template in my original question)
library(shiny)
ui <- fluidPage(
column(
12,
actionButton("save_project", "save")),
column(
width = 12,
h4("Assessment #1"),
htmlTemplate(
filename = "market_table.html",
indicator = "market_creation_attr_1"
)
)
)
server <- function(input, output, session) {
values <- reactiveValues()
market_typology_table_1_score <- reactiveVal(NULL)
observeEvent(c(input$market_creation_attr_1_market_rating_1,input$market_creation_attr_1_market_rating_2,input$market_creation_attr_1_market_rating_3,input$market_creation_attr_1_market_rating_4), {
if (input$market_creation_attr_1_market_rating_1!=''){
market_ table_1_score<-1
} else if (input$market_creation_attr_1_market_rating_2!=''){
market_ table_1_score<-2
}else if (input$market_creation_attr_1_market_rating_3!=''){
market_ table_1_score<-3
}else if(input$market_creation_attr_1_market_rating_4!=''){
market_table_1_score<-4
}
values$market_typology_table_1_score<-isolate(market_typology_table_1_score)
})
observeEvent(input$save_project, {
inputs <- reactiveValuesToList(input)
filepath <- file.path("save", paste0("input.rds"))
saveRDS(inputs, file = filepath)
all_values <- reactiveValuesToList(values)
filepath <- file.path("save", paste0("values.rds"))
saveRDS(all_values, file = filepath)
})
}
shinyApp(ui=ui, server=server)

How can I make a Shiny app W3C compliant?

I've written and optimized a Shiny app, and now I'm struggling with the IT section of the organization where I work to have it published on their servers.
Currently, they are claiming that the app is not W3C compliant, which is true, according to the W3C validator.
The errors I'm trying to solve, with no success, are:
<form class="well" role="complementary"> Bad value “complementary” for attribute “role” on element “form”.
<label class="control-label" id="foo-label" for="foo"> The value of the “for” attribute of the “label” element must be the ID of a non-hidden form control.
Such errors can be seen also in very minimal shiny apps, like:
# Reprex adapted from https://shiny.rstudio.com/gallery/tabsets.html
library(shiny)
# Define UI for random distribution app ----
ui <- fluidPage(
# App title ----
titlePanel("Tabsets"),
# Sidebar layout with input and output definitions ----
sidebarLayout(
# Sidebar panel for inputs ----
sidebarPanel(
# Input: Select the random distribution type ----
radioButtons("dist", "Distribution type:",
c("Normal" = "norm",
"Uniform" = "unif",
"Log-normal" = "lnorm",
"Exponential" = "exp")),
# br() element to introduce extra vertical spacing ----
br(),
# Input: Slider for the number of observations to generate ----
sliderInput("n",
"Number of observations:",
value = 500,
min = 1,
max = 1000)
),
# Main panel for displaying outputs ----
mainPanel(
# Output: Tabset w/ plot, summary, and table ----
tabsetPanel(type = "tabs",
tabPanel("Plot", plotOutput("plot")),
tabPanel("Summary", verbatimTextOutput("summary")),
tabPanel("Table", tableOutput("table"))
)
)
)
)
# Define server logic for random distribution app ----
server <- function(input, output) {
# Reactive expression to generate the requested distribution ----
d <- reactive({
dist <- switch(input$dist,
norm = rnorm,
unif = runif,
lnorm = rlnorm,
exp = rexp,
rnorm)
dist(input$n)
})
# Generate a plot of the data ----
output$plot <- renderPlot({
dist <- input$dist
n <- input$n
hist(d(),
main = paste("r", dist, "(", n, ")", sep = ""),
col = "#75AADB", border = "white")
})
}
# Create Shiny app ----
shinyApp(ui, server)
The second error seems to be related, somehow, to radiobuttons only, whereas the first one seems to afflict all the shiny apps I've found on the web and tested with the W3C validator so far.
For completeness, I report also the HTML code generated by the shiny app in the reprex:
<!DOCTYPE html>
<html>
<head>
<meta http-equiv="Content-Type" content="text/html; charset=utf-8"/>
<script type="application/shiny-singletons"></script>
<script type="application/html-dependencies">jquery[3.6.0];shiny-css[1.7.1];shiny-javascript[1.7.1];ionrangeslider-javascript[2.3.1];strftime[0.9.2];ionrangeslider-css[2.3.1];bootstrap[3.4.1]</script>
<script src="shared/jquery.min.js"></script>
<link href="shared/shiny.min.css" rel="stylesheet" />
<script src="shared/shiny.min.js"></script>
<script src="shared/ionrangeslider/js/ion.rangeSlider.min.js"></script>
<script src="shared/strftime/strftime-min.js"></script>
<link href="shared/ionrangeslider/css/ion.rangeSlider.css" rel="stylesheet" />
<meta name="viewport" content="width=device-width, initial-scale=1" />
<link href="shared/bootstrap/css/bootstrap.min.css" rel="stylesheet" />
<link href="shared/bootstrap/accessibility/css/bootstrap-accessibility.min.css" rel="stylesheet" />
<script src="shared/bootstrap/js/bootstrap.min.js"></script>
<script src="shared/bootstrap/accessibility/js/bootstrap-accessibility.min.js"></script> <title>Tabsets</title>
</head>
<body>
<div class="container-fluid">
<h2>Tabsets</h2>
<div class="row">
<div class="col-sm-4">
<form class="well" role="complementary">
<div id="dist" class="form-group shiny-input-radiogroup shiny-input-container" role="radiogroup" aria-labelledby="dist-label">
<label class="control-label" id="dist-label" for="dist">Distribution type:</label>
<div class="shiny-options-group">
<div class="radio">
<label>
<input type="radio" name="dist" value="norm" checked="checked"/>
<span>Normal</span>
</label>
</div>
<div class="radio">
<label>
<input type="radio" name="dist" value="unif"/>
<span>Uniform</span>
</label>
</div>
<div class="radio">
<label>
<input type="radio" name="dist" value="lnorm"/>
<span>Log-normal</span>
</label>
</div>
<div class="radio">
<label>
<input type="radio" name="dist" value="exp"/>
<span>Exponential</span>
</label>
</div>
</div>
</div>
<br/>
<div class="form-group shiny-input-container">
<label class="control-label" id="n-label" for="n">Number of observations:</label>
<input class="js-range-slider" id="n" data-skin="shiny" data-min="1" data-max="1000" data-from="500" data-step="1" data-grid="true" data-grid-num="9.99" data-grid-snap="false" data-prettify-separator="," data-prettify-enabled="true" data-keyboard="true" data-data-type="number"/>
</div>
</form>
</div>
<div class="col-sm-8" role="main">
<div class="tabbable">
<ul class="nav nav-tabs" data-tabsetid="9747">
<li class="active">
Plot
</li>
<li>
Summary
</li>
<li>
Table
</li>
</ul>
<div class="tab-content" data-tabsetid="9747">
<div class="tab-pane active" data-value="Plot" id="tab-9747-1">
<div id="plot" class="shiny-plot-output" style="width:100%;height:400px;"></div>
</div>
<div class="tab-pane" data-value="Summary" id="tab-9747-2">
<pre class="shiny-text-output noplaceholder" id="summary"></pre>
</div>
<div class="tab-pane" data-value="Table" id="tab-9747-3">
<div id="table" class="shiny-html-output"></div>
</div>
</div>
</div>
</div>
</div>
</div>
</body>
</html>
Do you have any suggestions?
Thanks!
This message was also posted on RStudio Community: sorry for cross-posting.
The following only deals with the first of the errors you mention (as this one is pretty clear thanks to #BenBolkers comment), but hopefully it points you to the right tools to use.
I'd use htmltools::tagQuery to make the needed modifications - please check the following:
# Reprex adapted from https://shiny.rstudio.com/gallery/tabsets.html
library(shiny)
library(htmltools)
# Define UI for random distribution app ----
ui <- fluidPage(
# App title ----
titlePanel("Tabsets"),
# Sidebar layout with input and output definitions ----
sidebarLayout(
# Sidebar panel for inputs ----
{querySidebarPanel <- tagQuery(sidebarPanel(
# Input: Select the random distribution type ----
radioButtons("dist", "Distribution type:",
c("Normal" = "norm",
"Uniform" = "unif",
"Log-normal" = "lnorm",
"Exponential" = "exp")),
# br() element to introduce extra vertical spacing ----
br(),
# Input: Slider for the number of observations to generate ----
sliderInput("n",
"Number of observations:",
value = 500,
min = 1,
max = 1000)
))
querySidebarPanel$find(".well")$removeAttrs("role")$addAttrs("role" = "none")$allTags()},
# Main panel for displaying outputs ----
mainPanel(
# Output: Tabset w/ plot, summary, and table ----
tabsetPanel(type = "tabs",
tabPanel("Plot", plotOutput("plot")),
tabPanel("Summary", verbatimTextOutput("summary")),
tabPanel("Table", tableOutput("table"))
)
)
)
)
# Define server logic for random distribution app ----
server <- function(input, output) {
# Reactive expression to generate the requested distribution ----
d <- reactive({
dist <- switch(input$dist,
norm = rnorm,
unif = runif,
lnorm = rlnorm,
exp = rexp,
rnorm)
dist(input$n)
})
# Generate a plot of the data ----
output$plot <- renderPlot({
dist <- input$dist
n <- input$n
hist(d(),
main = paste("r", dist, "(", n, ")", sep = ""),
col = "#75AADB", border = "white")
})
}
# Create Shiny app ----
shinyApp(ui, server)
Please also see this related chapter from "Outstanding User Interfaces with Shiny".

Scrape information from meta and button tags with rvest

I am trying to scrape the average user ratings (out of 5 stars) and number of ratings from a wine seller's page. The average stars our of 5 seems to be in a button tag while the number of rating is in a meta tag.
Here is the HTML:
<div class="bv_avgRating_component_container notranslate">
<button
type="button"
class="bv_avgRating"
aria-expanded="false"
aria-label="average rating value is 4.5 of 5."
id="avg-rating-button"
role="link"
itemprop="ratingValue"
>
4.5
</button>
</div>
<div class="bv_numReviews_component_container">
<meta itemprop="reviewCount" content="95" />
<button
type="button"
class="bv_numReviews_text"
aria-label="Read 95 Reviews"
aria-expanded="false"
id="num-reviews-button"
role="link"
>
(95)
</button>
</div>
What I've tried:
library(tidyverse)
library(rvest)
x <- "/wine/red-wine/cabernet-sauvignon/amici-cabernet-sauvignon-napa/p/20095750?s=918&igrules=true"
ratings <- read_html(paste0("https://www.totalwine.com", x)) %>%
html_nodes(xpath = '//meta[#itemprop="reviewCount"]') %>%
html_attr('content') #returns character(empty)
ratings <- read_html(paste0("https://www.totalwine.com", x)) %>%
html_nodes("meta") %>%
html_attr("content") #returns chr [1:33]
ratings <- read_html(paste0("https://www.totalwine.com", x)) %>%
html_nodes("div meta") %>%
html_attr("content") #returns chr [1:21]
ratings <- read_html(paste0("https://www.totalwine.com", x)) %>%
html_nodes("meta[itemprop=reviewCount]") %>%
html_attr("content") #returns character(empty)
At the end of the day, the two points I am trying to extract are 4.5 and content="95".
Open the Network tab of Dev Tool and reload the page, you'll see that this page loads data from https://www.totalwine.com/product/api/product/product-detail/v1/getProduct/20095750-1?shoppingMethod=INSTORE_PICKUP&state=US-CA&storeId=918 (which is a JSON file):
Get the rating and review count you want by this:
data <- jsonlite::fromJSON("https://www.totalwine.com/product/api/product/product-detail/v1/getProduct/20095750-1?shoppingMethod=INSTORE_PICKUP&state=US-CA&storeId=918")
rating <- data$customerAverageRating
reviews_count <- data$customerReviewsCount
Update: If you're new to the web-scraping field, you're probably wondering why I didn't use rvest at all. The thing is, this page uses JS to generate the content and rvest cannot handle JS, it only reads the HTML before JS loaded.

File is empty after saving flask uploads

I've been trying to upload a file using Flask and HTML forms. Now I can save an uploaded file but it shows up empty (0 bytes). After that I store the form entries in a database.
So im stuck at saving the file.
This is the python code
#app.route('/handle_data', methods=['POST'])
def handle_data():
naam = request.form['naam']
leeftijd = request.form['leeftijd']
gewicht = request.form['gewicht']
geslacht = request.form['geslacht']
filename = "x"
if request.method == 'POST' and 'photo' in request.files:
filename = photos.save(request.files['photo'])
photos.save(request.files['photo'], opslag)
cur = mysql.connect()
cursor = cur.cursor()
cursor.execute("INSERT INTO gekko (naam, leeftijd, gewicht, geslacht, foto) VALUES (%s, %s, %s, %s, %s)", (naam, leeftijd, gewicht, geslacht, filename))
# cursor.execute("INSERT INTO gekko (naam, leeftijd, gewicht) VALUES (" + str(naam) + "," + leeftijd + "," + gewicht + ")")
cur.commit()
cursor.close()
cur.close()
return "added"
HTML form:
{% extends "base.html" %}
{% block body %}
<form action="{{ url_for('handle_data') }}" enctype=multipart/form-data
method="POST">
Naam van de gekko:<br>
<input type="text" name="naam">
<br>
Leeftijd van de gekko:<br>
<input type="text" name="leeftijd">
<br>
Gewicht van de gekko:<br>
<input type="text" name="gewicht">
<br>
Geslacht van de gekko:<br>
<input type="radio" name="geslacht" value="man"> Man
<input type="radio" name="geslacht" value="vrouw"> Vrouw<br>
<br>
<input type="file" id="photo" name="photo">
<br>
<input type="submit" value="Submit">
</form>
{% endblock %}
We don't really know what the class photos is, nor what it's method save does, but that's where the error is probably occurring.
Try this instead:
request.files['photo'].save('test.jpg')
I realized that flask has a habit of including one empty file upload with the exact same name and details as one of the file attachments(usually the first attachment) WHEN you use the 'multiple' attribute in your form.
My workaround was to
create a temporary random filename and save the file upload
use os.stat(temp_filename).st_size to check if the file is empty
if the file is empty, delete it with os.remove, otherwise, rename the file to your preferred [secure] filename
an example...
# ...
def upload_file(req):
if req.method != 'POST': return
# file with 'multiple' attribute is 'uploads'
files = req.files.getlist("uploads")
# get other single file attachments
if req.files:
for f in req.files: files.append(req.files[f])
for f in files:
if not f.filename: continue
tmp_fname = YOUR_TEMPORARY_FILENAME
while os.path.isfile(tmp_fname):
# you can never rule out the possibility of similar random
# names
tmp_fname = NEW_TEMPORARY_FILENAME
# TEMP_FPATH is he root temporary directory
f.save(os.path.join(TEMP_FPATH, tmp_fname))
# and here comes the trick
if os.stat(os.path.join(TEMP_FPATH, tmp_fname)).st_size:
os.system("mv \"{}\" \"{}\" > /dev/null 2> /dev/null".format(
os.path.join(TEMP_FPATH, tmp_fname),
os.path.join(ACTUAL_FILEPATH, f.filename))
))
else:
# cleanup
os.remove(os.path.join(TEMP_FPATH, tmp_fname))
pass
#app.route("/upload", methods=["POST"])
def upload():
upload_files(request)
return "files are uploaded!"
# ...

R Shiny: Translate into HTML UI uiOutput, htmlOutput and File Upload

I have a Shiny App which I want to implement in a existing website, therefore I need to translate the ui.R into a HTML UI.I got most of the things from ui.R work in HTML UI, but I have questions concerning uiOutput, html Output and the File Upload.
Q1:How do implement an dynamic Slider, that I have created with renderUI({})? The dynamic selection I have created with renderUI({}) works fine, but with the slider I get the following error:min, max, amd value must all be numeric values It seems that no numeric values can be send to server.R from the HMTL UI.
Q2:: How would a working HMTL File Upload would look like? Mine seems to upload files, but I cannot pass it to server.R.
Here is an example:
server.R:
library(shiny)
#sample data
years<-c(1990,1995,2000,2005,2010)
oryear<-years[3]
shinyServer(function(input, output, session) {
#Input uploaded file
inFile<-input$ascii_layer
#make dynamic selection
output$selectUI <- renderUI({
selectInput("test_select", "Test selection", years, selected=oryear)
})
#make dynamic slider
output$slider <- renderUI({
sliderInput("inSlider", "Slider", min=input$min_val, max=input$max_val, value=2000)
})
})
ui.R:
library(shiny)
shinyUI(pageWithSidebar(
headerPanel("Test Shiny App"),
sidebarPanel(
#File Upload
fileInput('ascii_layer', 'Choose ASCII Layer', multiple=FALSE, accept='asc'),
#HTML Selection Output from server.R
htmlOutput("selectUI"),
#Numeric Inputs
numericInput("min_val", "Enter Minimum Value", 1993),
numericInput("max_val", "Enter Maximum Value", 2013)
#display dynamic UI
uiOutput("slider")
),
mainPanel()
))
HMTL UI:
<html>
<head>
<script src="shared/jquery.js" type="text/javascript"></script>
<script src="shared/shiny.js" type="text/javascript"></script>
<link rel="stylesheet" type="text/css" href="shared/shiny.css"/>
</head>
<body>
<h1>HTML UI</h1>
<!—- File Upload—->
<p>
<form action="input_file.htm" method="post" enctype="multipart/form-data">
<p>Choose Distance to Road Layer:<br>
<input name="ascii_layer" type="file" size="50" maxlength="100000" accept="*.asc">
</p>
</form>
</p>
<!—-Numeric Inputs—->
<p>
<label>Enter Minimum Value:</label><br />
<input type="number" name="min_val" value="1993" />
</p>
<p>
<label>Enter Maximum Value:</label><br />
<input type="number" name="max_val" value="1993" />
</p>
<!—-Dynamic Selection—->
<div id="selectUI" class="shiny-html-output"></div>
<!—-Dynamic Slider—->
<div id="slider" class="shiny-html-output"></div>
</body>
</html>
There were several errors in your Shiny code. A fixed version is given below. Run this by copy-and-pasting into the R terminal and view the source code from your browser to get your html-ui. I suggest you take a look at the Shiny tutorials online (e.g. http://rstudio.github.io/shiny/tutorial) for further detail on file upload etc.
library(shiny)
#sample data
years <- c(1990,1995,2000,2005,2010)
oryear <- years[3]
server <- function(input, output, session) {
#Input uploaded file
# inFile<-input$ascii_layer
output$contents <- renderTable({
inFile <- input$ascii_layer
if (is.null(inFile))
return(NULL)
read.csv(inFile$datapath)
})
#make dynamic selection
output$selectUI <- renderUI({
selectInput("test_select", "Test selection", years, selected=oryear)
})
#make dynamic slider
output$slider <- renderUI({
sliderInput("inSlider", "Slider", min=input$min_val, max=input$max_val, value=2000)
})
}
ui <- pageWithSidebar(
headerPanel("Test Shiny App"),
sidebarPanel(
#File Upload
fileInput('ascii_layer', 'Choose ASCII Layer', multiple=FALSE, accept='asc'),
#HTML Selection Output from server.R
uiOutput("selectUI"),
#Numeric Inputs
numericInput("min_val", "Enter Minimum Value", 1993),
numericInput("max_val", "Enter Maximum Value", 2013),
#display dynamic UI
uiOutput("slider")
),
mainPanel(
tableOutput('contents')
)
)
runApp(list(ui = ui, server = server))