http://gallery.htmlwidgets.org/
shinyServer(function(input, output, session){
# Get Lengths from user input
a <- eventReactive(input$do, {
subset(dd, Wafer %in% input$wafer, select = Length)
})
#Observe and update first set of radiobuttons based on a(). Does render
observe({
z <- a()
updateRadioButtons(session, "length", choices = unique(z$Length), inline=TRUE)
})
output$l <- renderDataTable({ a() })
})
shinyUI(fluidPage(
actionButton("do", "Search wafer"),
radioButtons("length", label="Length", choices=""),
dataTableOutput(outputId="l")
)
)library(shiny)
library(magrittr)
ui <- shinyServer(fluidPage(
plotOutput("my_plot")
))
server <- shinyServer(function(input, output, session){
# Function to get new observations
get_new_data <- function(){
data <- rnorm(5) %>% rbind %>% data.frame
return(data)
}
# Initialize my_data
my_data <<- get_new_data()
# Function to update my_data
update_data <- function(){
my_data <<- rbind(get_new_data(), my_data)
}
# Plot the 30 most recent values
output$my_plot <- renderPlot({
print("Render")
invalidateLater(2000, session) # update once 2 seconds
# invalidation will not be tied to any session, and so it will still occur
# invalidateLater(60000,NULL)
update_data()
print(my_data)
par(mfrow = c(2,2))
plot(X1 ~ 1, data=my_data[1:30,], ylim=c(-3, 3), las=1, type="l")
plot(X1 ~ 1, data=my_data[1:30,], ylim=c(-3, 3), las=1, type="p")
plot(X1 ~ 1, data=my_data[1:30,], ylim=c(-3, 3), las=1, type="b")
plot(X1 ~ 1, data=my_data[1:30,], ylim=c(-3, 3), las=1, type="l")
}
, height = 800, width = 1000 )
})
shinyApp(ui,server)max_plots <- 5
server <- shinyServer(function(input, output) {
# Insert the right number of plot output objects into the web page
output$plots <- renderUI({
plot_output_list <- lapply(1:input$n, function(i) {
plotname <- paste0("plot", i)
dygraphOutput(plotname, width = "100%", height = "300px")
})
# Convert the list to a tagList - this is necessary for the list of items
# to display properly.
do.call(tagList, plot_output_list)
})
# Call renderPlot for each one. Plots are only actually generated when they
# are visible on the web page.
for (i in 1:max_plots) {
# Need local so that each item gets its own number. Without it, the value
# of i in the renderPlot() will be the same across all instances, because
# of when the expression is evaluated.
local({
plotname <- paste0("plot", i)
output[[plotname]] <- renderDygraph({
dygraph(mdeaths, group = "all-one")
})
})
}
})
ui <- shinyUI(
wellPanel(
sliderInput("n", "Number of plots", value=1, min=1, max=5),
# This is the dynamic UI for the plots
uiOutput("plots")
)
)
shinyApp(ui,server)library(shiny)
ui <- shinyUI(pageWithSidebar(
headerPanel("Example"),
sidebarPanel(),
mainPanel(
tabsetPanel(
tabPanel("Main", plotOutput("temp", height=1000, width=1000))
) #tabsetPanel
) #mainPane;
))
server <- shinyServer(function(input, output) {
output$temp <-renderPlot({
par(mfrow=c(2,2))
plot(1:10)
plot(rnorm(10))
plot(rnorm(10))
plot(rnorm(10))
})
})
shinyApp(ui, server)library(shiny)
createLink <- function(val) {
sprintf('<a href="https://www.google.com/#q=%s" target="_blank" class="btn btn-primary">Info</a>',val)
}
ui <- fluidPage(
p("Click the link in the table to seea google search for the car."),
dataTableOutput('table1')
)
server <- function(input, output) {
output$table1 <- renderDataTable({
my_table <- cbind(rownames(mtcars), mtcars)
colnames(my_table)[1] <- 'car'
my_table$link <- createLink(my_table$car)
return(my_table)
}, escape = FALSE)
}
shinyApp(ui, server)library(shiny)
library(rhandsontable)
ui=fluidPage(
rHandsontableOutput('table'),
verbatimTextOutput('selected')
)
server=function(input,output,session)({
df=data.frame(N=c(1:10),L=LETTERS[1:10],M=LETTERS[11:20])
df$chart = c(sapply(1:5, function(x) jsonlite::toJSON(list(values=rnorm(5)
, options = list(type = "bar")))))
output$table=renderRHandsontable(
rhandsontable(df,selectCallback = TRUE, readOnly = T)
%>% hot_table(highlightCol = F, highlightRow = TRUE)
%>% hot_col("M",readOnly = F )
%>% hot_col("chart", renderer = htmlwidgets::JS("renderSparkline"))
)
output$selected=renderPrint({
cat('Selected Row:',input$table_select$select$r)
cat('\nSelected Column:',input$table_select$select$c)
cat('\nSelected Cell Value:',input$table_select$data[[input$table_select$select$r]][[input$table_select$select$c]])
cat('\nSelected Range: R', input$table_select$select$r,'C',input$table_select$select$c,
':R',input$table_select$select$r2, 'C',input$table_select$select$c2, sep="")
cat('\nChanged Cell Row Column:',input$table$changes$changes[[1]][[1]],
input$table$changes$changes[[1]][[2]])
cat('\nChanged Cell Old Value:',input$table$changes$changes[[1]][[3]])
cat('\nChanged Cell New Value:',input$table$changes$changes[[1]][[4]])
})
})
shinyApp(ui, server)library("dygraphs")
hw <- HoltWinters(ldeaths)
predicted <- predict(hw, n.ahead = 72, prediction.interval = TRUE)
library("xts") # for index() function## Loading required package: zoo##
## Attaching package: 'zoo'## The following objects are masked from 'package:base':
##
## as.Date, as.Date.numericindex <- index(predicted)
predicted <- as.data.frame(predicted)
predicted$index <- index
# dygraph will use first column as x axis
predicted <- predicted[, c("index", "lwr", "fit", "upr")]
predicted[1:3,]## index lwr fit upr
## 1 1980.000 2147.208 2645.163 3143.119
## 2 1980.083 2110.181 2608.152 3106.124
## 3 1980.167 2045.144 2543.142 3041.141dygraph(predicted, main = "Predicted Lung Deaths (UK)") %>%
dyAxis("x", drawGrid = FALSE) %>%
dySeries(c("lwr", "fit", "upr"), label = "Deaths") %>%
dyOptions(colors = RColorBrewer::brewer.pal(3, "Set1"))