problems with using plotly in a shiny project - r

I am trying to start using plotly with shiny, but unfortunately it doesn't work with my code. As an example I wrote this (sorry that descriptions in UI part are in russian):
UI:
library(shiny)
library(ggplot2)
library(plotly)
library(mvtnorm)
shinyUI(fluidPage(
titlePanel("Грачев Влад инкорпорейшн"),
sidebarLayout(
sidebarPanel(
sliderInput('n_obs', 'Количество испытаний', min = 0, max = 1000, value = 500, animate = TRUE),
sliderInput('prc', 'Средний рост детей', min = 170, max = 180, value = 175, step = 0.5, animate = TRUE),
sliderInput('prp', 'Средний рост родителей', min = 170, max = 180, value = 175, step = 0.5, animate = TRUE),
sliderInput('corr', 'Корреляция между ростом ребенка и ростом родителей', min = -1, max = 1, value = 0.5, step = 0.1, animate = TRUE),
sliderInput('stdc', 'Стандартное отклонение роста детей', min = 0, max = 1, value = 0.5, animate = TRUE),
sliderInput('stdp', 'Стандартное отклонение роста родителей', min = 0, max = 1, value = 0.5, animate = TRUE)
),
mainPanel(
plotOutput('dotplot'),
plotOutput('plotl')
)
)
))
Server:
shinyServer(function(input, output){
update_x <- reactive({
mu <- c(input$prc,input$prp)
A <-matrix(
c(input$stdc, input$corr*sqrt(input$stdc*input$stdp), input$corr*sqrt(input$stdc*input$stdp), input$stdp),
nrow = 2
)
X <- rmvnorm(input$n_obs, mean = mu, sigma = A)
X
})
output$dotplot <- renderPlot({
X <- data.frame(update_x())
g <- ggplot(X, aes(x=X[,1], y = X[,2])) + geom_jitter() + stat_smooth()
gg <- ggplotly(g)
gg
})
output$plotl <- renderPlotly({
X <- data.frame(update_x())
g <-ggplot(X, aes(X[,2])) + geom_histogram(binwidth = 0.2)
gg <- ggplotly(g)
gg
})
})
It works without plotly (just ordinary renderPlot and ggplot graph):
enter image description here
But when i am starting the code above it doesn't show any graphs or warnings (only empty space) and there are 2 warnings in the console: Using size for a discrete variable is not advised.
Thanks in advance
Vlad

Related

Calculate distance between 2 points in shiny

I want to calculate the distance of the segment between 2 clicked points, i already have a function with that launches a shiny dashboard that allows you to save the clicks and draw a line between the pairs. It is printing the dimension of the image in pixels. Any image can be used changing the image_path.
I want to know if there is a way to select the segments of each pair and calculate the distance between them in pixels and later convert it to cm.
library(shiny)
library(shinydashboard)
library(dplyr)
library(imager)
library(reactable)
click_length <- function(image_path = system.file("example_images", package = "ClickMetrics")){
app <- shinyApp(
ui <- dashboardPage(
skin = 'purple',
dashboardHeader(title = "ClickMetrics"),
dashboardSidebar(disable = TRUE),
dashboardBody(
fluidRow(
box(plotOutput("IMG",
height = 400,
click = "click_plot")),
box(
(selectInput("IMAGE",
"Images:",
list.files(path = image_path,
pattern = ".jpg",
full.names = TRUE,
include.dirs = FALSE)))
),
actionButton("clear","Clear Points"),
reactableOutput("INFO")
)
)
),
server <- function(input, output, session){
# Creating a reactive value that receives image input
img <- reactive({
f <- input$IMAGE
imager::load.image(f)
})
# Store reactive values for coordinates
CLICKS <- reactiveValues(
x = NULL,
y = NULL,
n = NULL,
pair = NULL
)
ns <- session$ns
observeEvent(eventExpr = input$click_plot$x, handlerExpr = { ## Adds the info about clicks
CLICKS$x <- append(CLICKS$x, input$click_plot$x)
CLICKS$y <- append(CLICKS$y, input$click_plot$y)
CLICKS$n <- append(CLICKS$n, length(CLICKS$x))
CLICKS$pair <-
append(CLICKS$pair,
as.integer(ceiling(length(CLICKS$x)/2)))
df <- data.frame(CLICKS$x, CLICKS$y, CLICKS$pair)
df <- split(df, CLICKS$pair)
print(dim(img())) # prints dimensions of the image
})
output$IMG <- renderPlot({
expr = {
img <- img()
par(mar = c(0.5, 0.5, 1.75, 0.5))
plot(img, axes = FALSE)
box(col = 'gray')
mtext(text = input$IMAGE,
side = 3,
line = 0.5,
adj = 0.5,
cex = 1.23)
if (!is.null(CLICKS$x) && length(CLICKS$x) > 0) {
points(x = CLICKS$x,
y = CLICKS$y,
pch = 19,
cex = 0.75,
col = "red")
text(x = CLICKS$x,
y = CLICKS$y,
label = CLICKS$n,
pos = 3)
n_par <- 2 * floor(length(CLICKS$x)/2)
tb_pairs <- cbind(
matrix(CLICKS$x[1:n_par], ncol = 2, byrow = TRUE),
matrix(CLICKS$y[1:n_par], ncol = 2, byrow = TRUE))
segments(x0 = tb_pairs[, 1],
x1 = tb_pairs[, 2],
y0 = tb_pairs[, 3],
y1 = tb_pairs[, 4],
col = "black")
}
}
})
output$INFO <- renderReactable({
df1 <- data.frame(round(CLICKS$x,2), round(CLICKS$y,2), CLICKS$pair)
reactable(df1)
})
observe({ # clear clicked points
if(input$clear>0){
session$reload()
}
})
})
runApp(app)
}
click_length()
I tried some examples using locator, but it does not work inside a shiny dashboard, which i need.

Calling reactive objects into render output functions

I am trying to create a dashboard in Shiny. I am taking inputs(data frame - df1) from a user and do some prediction and display the results of the prediction as well as a plot of air quality parameters.
Below is the ui code chunk -
########## User interface ############
ui <- dashboardPage(
dashboardHeader(title = "Air Quality Index"),
dashboardSidebar(
selectizeInput(
"City", "Select the City:",
choices = list("Mumbai", "Delhi", "Bengaluru")
),
numericInput("PM2.5", "PM2.5 Levels:", min = 0, max = 1000, value = 50),
numericInput("PM10", "PM10 Levels:", min = 0, max = 1000, value = 50),
numericInput("NO", "NO Levels:", min = 0, max = 1000, value = 50),
numericInput("CO", "CO Levels:", min = 0, max = 1000, value = 50),
numericInput("NO2", "NO2 Levels:", min = 0, max = 1000, value = 50),
numericInput("O3", "O3 Levels:", min = 0, max = 1000, value = 50),
actionButton("submitbutton", "Calculate AQI", class = "btn btn-primary")
),
dashboardBody(
fluidRow(
valueBoxOutput("AQI"),
valueBoxOutput("high_risk_params")
),
fluidRow(
box(title = "Polluting Contents in Air:", solidHeader = TRUE,
width = 12, collapsible = TRUE,
plotlyOutput("param_plot"))
)
))
And the code for server is -
########### Server logic ############
server <- function(input, output, session) {
# Input Data
datasetInput <- reactive({
df1 <- data.frame(
Names= c("City"= input$City,
"PM2.5"= input$PM2.5,
"PM10"= input$PM10,
"NO"= input$NO,
"NO2"= input$NO2,
"CO"= input$CO,
"O3"= input$O3
),
stringsAsFactors = FALSE)
n <- rownames(df1)
input <- data.table::transpose(df1)
colnames(input) <- n
input[,2:7] <- as.numeric(input[,2:7])
predicted <- data.frame(Predicted.AQI=predict(rf_model_new,input))
print(predicted)
})
output$param_plot <- renderPlotly({
df1 <- data.table::transpose(df1, keep.names = "rn")
df1 <- df1[-1,]
print(df1)
plot <- ggplot(df1) +
geom_col(aes(x = rn, y = as.numeric(V1), fill = as.numeric(V1))) +
labs(x = "Air Paramteres", y = "Value") +
theme_gray() +
ylim(0, NA) +
geom_hline(yintercept = 50) +
scale_fill_gradient(low = "green",
high = "red",
limits = c(0, 300),
na.value = "darkred",
name = "Value") +
theme(panel.background = element_rect(fill = "mintcream"),
legend.position = "none")
plot <- ggplotly(plot)
plot
})
output$AQI <- renderValueBox({
valueBox(paste0( "AQI: ",round(predicted,0)),
" ", icon = icon("cloudscale"), color = "blue", width = 10)
})
output$high_risk_params <- renderValueBox({
risk_df <- df1 %>%
filter(df1[,2:7]> 100)
if(nrow(risk_df)>0){
valueBox("Over Safe Limits", HTML(paste0(risk_df$rn, sep= "<br>")),
icon = icon("exclamation-triangle"), color = "red")
}
else{
valueBox("No Hazard", icon = icon("exclamation-triangle"), color = "green")
}
})
}
Now the error showing is -
Warning: Error in data.table::transpose: object 'df1' not found &
Warning: Error in paste0: object 'predicted' not found &
Warning: Error in filter: object 'df1' not found
Attaching screenshot of the errors.
Any help is much appreciated. Thanks!
https://i.stack.imgur.com/4ncQq.png
try to declare df1 var outside the reactive({}) function and make it global across the whole server and then use it below inside the renderPlotly({}) function

Error in RShiny UI.r: argument "variable" is missing, with no default

Trying to create a ui.r file for showing a Pert Distribution
I got the following error: Error in ui.r: argument "variable" is missing, with no default
The common fix for this that I have seen is to remove unnecessary commas and I believe I have done this.
server <- function(input, output){
BS = function(n, births, cat2, statusmin, statusmode, statusmax, impactmin, impactmode, impactmax){
d1 = births*cat2*rpart(n,statusmin,statusmode,statusmax)*rpart(n,impactmin,impactmode,impactmax)
return(d1)
}
output$plotCall <- renderPlot({
n = input$n
births = input$births
cat2 = input$cat2
statusmin = input$statusmin
statusmode = input$statusmode
statusmax = input$statusmax
impactmin = input$impactmin
impactmode = input$impactmode
impactmax = input$impactmax
gg <- ggplot(data.frame(BS()), aes(x = BS))
gg <- gg + geom_histogram(aes(y = ..density..),color = "black", fill = "white",
binwidth = 2 * IQR(BS) / length(BS)^(1/3))
gg <- gg + geom_density(fill = "steelblue", alpha = 1/3)
gg <- gg + scale_x_continuous(labels = comma)
gg <- gg + theme_bw()
plot(gg, labels = TRUE, conf.level = .8)
}
)
}
ui <- shinyUI(fluidPage(
titlePanel("ROI"),
sidebarLayout(
sidebarPanel(
numericInput('n', 'Number of Simulations', 1000, min = 1, max = 1000, step = 1),
numericInput('birth', 'Number of Births', 6811, min = 1, max = 10000, step = 1),
numericInput('cat2', 'Percentage of Category II Strips', 0.84, min = 0.01, max = 1, step = 0.01),
numericInput('statusmin', '% Status Min', 0.1, min = 0.01, max = 1, step = 0.01),
numericInput('statusmode', '% Status Most Likely', 0.3, min = 0.01, max = 1, step = 0.01),
numericInput('statusmax', '% Status Max', 0.4, min = 0.01, max = 1, step = 0.01),
numericInput('impactmin', '% Impact Min', 0.2, min = 0.01, max = 1, step = 0.01),
numericInput('impactmode', '% Impact Most Likely', 0.4, min = 0.01, max = 1, step = 0.01),
numericInput('impactmax', '% Impact Max', 0.64, min = 0.01, max = 1, step = 0.01)
),
mainPanel(
textOutput("BScall"),
hr(),
tabsetPanel(
tabPanel("Calls", plotOutput("plotCall",width="100%"))
)
)
)
))
shinyApp(ui = ui, server = server)
I am trying to get a histogram of the results of d1.
I've found a couple of issues in this code. As Wil pointed out in the comments, you define BS as a function with several arguments, but when you call BS() you're not assigning any arguments to it.
So, the first change I made was to define a variable called result_d1 that receives the output from BS(n, births, cat2, statusmin, statusmode, statusmax, impactmin, impactmode, impactmax). Then I passed this variable to ggplot:
here: gg <- ggplot(data.frame(result_d1), aes(x=result_d1));
and here:
gg + geom_histogram(aes(y = ..density..),color = "black", fill = "white",
binwidth = 2 * IQR(result_d1) / length(result_d1)^(1/3))
Another issue is that you call input$births but the ID for your numericInput is "birth". I changed this to "births".
Even after these fixes, we have issues with the function rpart, as Wil pointed out as well. I'm not familiar with this function nor its package, but since you said that you want to plot a Pert Distribution I'll use the function dpert from the mc2d package to get the values for the histogram. I don't know if this is exactly what you want, but with a working code that uses this dpert you can make the necessary changes to use the rpart function.
One last thing, I changed scale_x_continuous(labels = comma) to scale_x_continuous(labels = scales::comma).
Here's the full code:
server <- function(input, output){
BS = function(n, births, cat2, statusmin, statusmode, statusmax, impactmin, impactmode, impactmax){
x.status <- seq(statusmin, statusmax, length.out= n)
x.impact <- seq(impactmin, impactmax, length.out= n)
d1 = births*cat2*
dpert(x.status, min=statusmin, mode=statusmode, max=statusmax)*
dpert(x.impact, min=impactmin, mode=impactmode, max=impactmax)
return(d1)
}
output$plotCall <- renderPlot({
n = input$n
births = input$births
cat2 = input$cat2
statusmin = input$statusmin
statusmode = input$statusmode
statusmax = input$statusmax
impactmin = input$impactmin
impactmode = input$impactmode
impactmax = input$impactmax
result_d1 <- BS(n, births, cat2, statusmin, statusmode, statusmax, impactmin, impactmode, impactmax)
gg <- ggplot(data.frame(result_d1), aes(x=result_d1))
gg <- gg + geom_histogram(aes(y = ..density..),color = "black", fill = "white",
binwidth = 2 * IQR(result_d1) / length(result_d1)^(1/3))
gg <- gg + geom_density(fill = "steelblue", alpha = 1/3)
gg <- gg + scale_x_continuous(labels = scales::comma)
gg <- gg + theme_bw()
plot(gg, labels = TRUE, conf.level = .8)
}
)
}
ui <- shinyUI(fluidPage(
titlePanel("ROI"),
sidebarLayout(
sidebarPanel(
numericInput('n', 'Number of Simulations', 1000, min = 1, max = 1000, step = 1),
numericInput('births', 'Number of Births', 6811, min = 1, max = 10000, step = 1),
numericInput('cat2', 'Percentage of Category II Strips', 0.84, min = 0.01, max = 1, step = 0.01),
numericInput('statusmin', '% Status Min', 0.1, min = 0.01, max = 1, step = 0.01),
numericInput('statusmode', '% Status Most Likely', 0.3, min = 0.01, max = 1, step = 0.01),
numericInput('statusmax', '% Status Max', 0.4, min = 0.01, max = 1, step = 0.01),
numericInput('impactmin', '% Impact Min', 0.2, min = 0.01, max = 1, step = 0.01),
numericInput('impactmode', '% Impact Most Likely', 0.4, min = 0.01, max = 1, step = 0.01),
numericInput('impactmax', '% Impact Max', 0.64, min = 0.01, max = 1, step = 0.01)
),
mainPanel(
textOutput("BScall"),
hr(),
tabsetPanel(
tabPanel("Calls", plotOutput("plotCall",width="100%"))
)
)
)
))
shinyApp(ui = ui, server = server)
And the output:

Implementing ggvis with shiny and circlize

I'm trying to understand how ggvis works in the context of shiny and it's been a real headache. At this point I'm just trying to make something, anything interactive. Ideally I would like to be able to filter data points with sliders and be able to click on sectors and links to zoom and highlight respectively.
Ignoring the entire right bar, how would I be able to implement ggvis?
server.r
options(shiny.maxRequestSize=60*1024^2)
# Option to use scientific notation
options(scipen=999)
library(ggplot2)
library(ggvis)
shinyServer(function(input, output) {
inputData <- try(reactive({
inFile <- input$file1
if(is.null(inFile$datapath)){
return(iris)
}
newData <- read.csv(inFile$datapath, fill=TRUE)
newData
}))
output$choose_histVar <- renderUI({
newData <- inputData()
nameDataNew1<-c("ALL" ,"Earmarks", "Free-Cash")
if(class(nameDataNew1)!="try-error"){
selectInput("histVar", "1. Select Funding", as.list(nameDataNew1),
multiple = FALSE)
}
else{
selectInput("histVar", "1.Select Funding", NULL, multiple = FALSE)
}
})
# Use renderTable() function to render a table
output$summaryTable <- renderTable({ summary( try(inputData()) ) })
output$plot.hist <- renderPlot({
plotHistograms(data=try(inputData()), getCol=input$histVar,
getBin=input$bins)
})
output$plot.bar <- renderPlot({ plotcir(data)})
})
plotcir <- function(data) {
set.seed(999)
n = 1000
df = data.frame(factors = sample(letters[1:8], n, replace = TRUE),
x = rnorm(n), y = runif(n))
data.temp <- as.data.frame(df)
circos.par("track.height" = 0.1)
circos.initialize(factors = df$factors, x = df$x)
circos.track(factors = df$factors, y = df$y,
panel.fun = function(x, y) {
circos.text(CELL_META$xcenter, CELL_META$cell.ylim[2] + uy(5,
"mm"),
CELL_META$sector.index)
circos.axis(labels.cex = 0.6)
})
col = rep(c("#FF0000", "#00FF00"), 4)
circos.trackPoints(df$factors, df$x, df$y, col = col, pch = 16, cex = 0.5)
circos.text(-1, 0.5, "text", sector.index = "a", track.index = 1)
bgcol = rep(c("#EFEFEF", "#CCCCCC"), 4)
circos.trackHist(df$factors, df$x, bin.size = 0.2, bg.col = bgcol, col = NA)
circos.track(factors = df$factors, x = df$x, y = df$y,
panel.fun = function(x, y) {
ind = sample(length(x), 10)
x2 = x[ind]
y2 = y[ind]
od = order(x2)
circos.lines(x2[od], y2[od])
})
##vis <- reactive({})
circos.link("a", 0, "b", 0, h = 0.4)
circos.link("c", c(-0.5, 0.5), "d", c(-0.5,0.5), col = "red",
border = "blue", h = 0.2)
circos.link("e", 0, "g", c(-1,1), col = "green", border = "black", lwd = 2,
lty = 2)
}
ui.r
# Load libraries used in this Shiny App
library(shiny)
library(ggplot2)
library(circlize)
library(ggvis)
library(shinythemes)
shinyUI(fluidPage(
titlePanel(title = h2("The Wall", align="center")),
theme = shinytheme("cyborg"),
sidebarPanel(
fileInput('file1', 'The default dataset is df data. You may choose your own
CSV file'),
sliderInput('file1', 'Mission 1', value = 10, min = 0, max = 100, step = 1,
post = "%"),
sliderInput('file1', 'Mission 2', value = 0, min = 0, max = 100, step = 1,
post = "%"),
sliderInput('file1', 'Mission 3', value = 0, min = 0, max = 100, step = 1,
post = "%"),
sliderInput('file1', 'Mission 4', value = 0, min = 0, max = 100, step = 1,
post = "%"),
sliderInput('file1', 'Mission 5', value = 0, min = 0, max = 100, step = 1,
post = "%"),
uiOutput("choose_histVar"),
uiOutput("choose_xVar"),
uiOutput("choose_yVar"),
uiOutput("choose_cateVar"),
uiOutput("choose_barVar"),
p()
),
mainPanel(
h3('DOS - Augmented decisions'),
tabsetPanel(type="tab",
tabPanel( "Optimal",
plotOutput('plot.bar')
),
tabPanel("Histogram",
h4(checkboxInput("showHideHistograms", "Show/hide histograms",
value=FALSE)),
# Add a conditional panel to plot the histogram only when "Show
histogram" is checked
conditionalPanel(
condition = "input.showHideHistograms",
# Use plotOutput function to plot the output visualization
plotOutput('plot.hist')
)
)
),
p('')
)
))

How can I apply Holt's Winter forecasting method in r shiny?

I would like to adjust Holt Winter's method as a forecasting method via shiny. However I could not manage to plot real and forecasted data. However I get an error which indicates time series has no or less than 2 periods.
Here is the code:
ui.R
require(shiny)
require(ggplot2)
require(forecast)
require(TTR)
shinyUI(pageWithSidebar(
headerPanel("Forecasting Methods"),
sidebarPanel(
h3(strong("Holt's Winter",style = "color:black")),
br(),
sliderInput("h","Number of periods for forecasting:",
min = 1, max = 20, step= 1, value = 4),
sliderInput("alpha","Alpha (Smoothing Parameter):",
min = 0.05, max = 1, step= 0.05, value = 0.01),
sliderInput("beta","Beta (Smoothing Parameter):",
min = 0.05, max = 1, step= 0.05, value = 0.01),
sliderInput("gamma","Gamma (Smoothing Parameter):",
min = 0.05, max = 1, step= 0.05, value = 0.01)),
mainPanel(
tabsetPanel( id="tabs",
tabPanel("Holt's Winter",
value="panel",
plotOutput(outputId = "hw",
width = "900px",height = "400px"),
dataTableOutput(outputId="infoes"))
))))
server.R
require(shiny)
require(ggplot2)
require(forecast)
require(TTR)
shinyServer(function(input, output, session){
set.seed(123)
predset <- reactive({
tmp <- data.frame(time = 1:100, sales = round(runif(100, 150, 879)) )
tmp.mean <- HoltWinters(x=tmp$sales, alpha = , beta = input$beta,gamma=input$gamma)
tmp.pred <- data.frame(predict(tmp.mean,n.ahead = input$h, prediction.interval = TRUE), time = tmp[nrow(tmp), "time"] + 1:input$h)
list(tmp = tmp, tmp.pred = tmp.pred)
})
output$hw <- renderPlot({
tmp <- predset()$tmp
tmp.pred <- predset()$tmp.pred
y <- ggplot(tmp, aes(time, sales)) +
geom_line() +
geom_line(data=tmp.pred, aes(y=upr),color="red") +
geom_line(data=tmp.pred, aes(y=fit),color="blue") +
geom_line(data=tmp.pred, aes(y=lwr),color="red") +
xlab("Days") +
ylab("Sales Quantity")+
ggtitle("title")
y })

Resources