I am trying to create scatter plot outputs in the shiny dashboard. I have similar datasets for several years, and I want to plot according to chosen variables and year. Datasets file name is Y96Total8.rda, Y97Total8.rda... Datasets name is Total (data.table).
Unfortunately, I can't load the dataset in a true way to plot the results, and I have the error "non-numeric argument to mathematical function" in plot tab.
If anyone has any suggestions on how to produce this plot using the shiny dashboard it would be much appreciated.
I have attached the code.
library(shiny)
library(shinydashboard)
library(data.table)
library(ggplot2)
library(plotly)
library(DT)
header <- dashboardPage(
skin = "green",
dashboardHeader(title = "TEST"),
dashboardSidebar(sidebarMenu(
dir = "ltr",
align = "right",
menuItem("Correlation", tabName = "Correlation", icon = icon("users"))
)),
dashboardBody(load(file = "data/Test.rda"),
dir = "ltr",
tabItems(
tabItem(tabName = "Correlation",
fluidRow(tabsetPanel(
tabPanel(
"Inputs",
box(
status = "danger",
solidHeader = TRUE,
width = 6,
title = "Food Expenditures Per",
sliderInput(
inputId = "Food_Expenditures_Per2",
label = "Food Expenditures",
min = 0,
max = 30000000,
value = c(1000000, 10000000)
)
),
box(
status = "danger",
solidHeader = TRUE,
title = "Total Expenditures Per",
width = 6,
sliderInput(
inputId = "Total_Exp_Month_Per2",
label = "Total Expenditures Per",
min = 0,
max = 100000000,
value = c(1000000, 30000000)
)
),
box(
status = "info",
solidHeader = TRUE,
title = "First Variable",
width = 6,
selectInput(
"Var1",
"First Variable",
list("FoodExpenditure_Per", "Total_Exp_Month_Per"),
selected =
"FoodExpenditure_Per"
)
),
box(
status = "info",
solidHeader = TRUE,
title = "Second Variable",
width = 6,
selectInput(
"Var2",
"Second Variable",
list("FoodExpenditure_Per", "Total_Exp_Month_Per"),
selected =
"Total_Exp_Month_Per"
)
),
box(
status = "info",
solidHeader = TRUE,
title = "Year",
width = 6,
selectInput(
inputId = "slcT2Year3",
label = "Year",
choices =
list(1390, 1391, 1392, 1393,
1394, 1395, 1396, 1397),
selected =
1396
)
),
box(
status = "info",
solidHeader = TRUE,
title = "Add line of best fit",
width = 6,
checkboxInput("fit", "Add line of best fit")
),
),
tabPanel(
"Plot"
,
box(
status = "info",
solidHeader = TRUE,
width = 700,
height = 450,
plotOutput("scatterplot", width =
600, height = 400)
,
downloadButton("downloadPlot3", "Download")
)
)
)))
))
)
app_server <- function(input, output, session) {
##################### Scatter Plot #########################
output$scatterplot <- renderPlot({
y <- input$slcT2Year3
fn3 <- paste0("data/Y", substr(y, 3, 4), "Total8.rda")
load(fn3)
Total <- subset(
Total,
FoodExpenditure_Per >= input$Food_Expenditures_Per2[1] &
FoodExpenditure_Per <= input$Food_Expenditures_Per2[2] &
Total_Exp_Month_Per >= input$Total_Exp_Month_Per2[1] &
Total_Exp_Month_Per <= input$Total_Exp_Month_Per2[2]
)
p <- ggplot(Total, aes(input$Var1, input$Var2)) +
geom_point() +
scale_x_log10()
if (input$fit == TRUE) {
p <- p + geom_smooth(method = "lm")
}
p
})
session$onSessionEnded(function() {
stopApp()
# q("no")
})
}
shinyApp(header, app_server)
Image of the error:
Your ggplot call should be changed to
p <- ggplot(Total, aes(Total[[input$Var1]], Total[[input$Var2]]))
Related
I created an application with the shinyMobile package and I would like to know if it is possible to make it available on the Play and Apple Store as a regular app.
My app:
library(shinyMobile)
if(interactive()){
library(shiny)
library(shinyMobile)
library(shinyWidgets)
shinyApp(
ui = f7Page(
title = "Tab layout",
f7TabLayout(
tags$head(
tags$script(
"$(function(){
$('#tapHold').on('taphold', function () {
app.dialog.alert('Tap hold fired!');
});
});
"
)
),
panels = tagList(
f7Panel(title = "Left Panel", side = "left", theme = "light", "Blabla", effect = "cover"),
f7Panel(title = "Right Panel", side = "right", theme = "dark", "Blabla", effect = "cover")
),
navbar = f7Navbar(
title = "Tabs",
hairline = FALSE,
shadow = TRUE,
leftPanel = TRUE,
rightPanel = TRUE
),
f7Tabs(
animated = FALSE,
swipeable = TRUE,
f7Tab(
tabName = "Tab1",
icon = f7Icon("envelope"),
active = TRUE,
f7Shadow(
intensity = 10,
hover = TRUE,
f7Card(
title = "Card header",
f7Stepper(
"obs1",
"Number of observations",
min = 0,
max = 1000,
value = 500,
step = 100
),
plotOutput("distPlot1"),
footer = tagList(
f7Button(inputId = "tapHold", label = "My button"),
f7Badge("Badge", color = "green")
)
)
)
),
f7Tab(
tabName = "Tab2",
icon = f7Icon("today"),
active = FALSE,
f7Shadow(
intensity = 10,
hover = TRUE,
f7Card(
title = "Card header",
f7Select(
inputId = "obs2",
label = "Distribution type:",
choices = c(
"Normal" = "norm",
"Uniform" = "unif",
"Log-normal" = "lnorm",
"Exponential" = "exp"
)
),
plotOutput("distPlot2"),
footer = tagList(
f7Button(label = "My button", href = "https://www.google.com"),
f7Badge("Badge", color = "orange")
)
)
)
),
f7Tab(
tabName = "Tab3",
icon = f7Icon("cloud_upload"),
active = FALSE,
f7Shadow(
intensity = 10,
hover = TRUE,
f7Card(
title = "Card header",
f7SmartSelect(
inputId = "variable",
label = "Variables to show:",
c("Cylinders" = "cyl",
"Transmission" = "am",
"Gears" = "gear"),
multiple = TRUE,
selected = "cyl"
),
tableOutput("data"),
footer = tagList(
f7Button(label = "My button", href = "https://www.google.com"),
f7Badge("Badge", color = "green")
)
)
)
)
)
)
),
server = function(input, output) {
output$distPlot1 <- renderPlot({
dist <- rnorm(input$obs1)
hist(dist)
})
output$distPlot2 <- renderPlot({
dist <- switch(
input$obs2,
norm = rnorm,
unif = runif,
lnorm = rlnorm,
exp = rexp,
rnorm
)
hist(dist(500))
})
output$data <- renderTable({
mtcars[, c("mpg", input$variable), drop = FALSE]
}, rownames = TRUE)
}
)
}
I produce conventional shinyapps, but I would like to know if there is a way to make a shinMobile available on mobile platforms.
I even tried to do something, but nothing that came close to a satisfactory solution.
I'm creating a table that has 88 columns, so naturally I'd require a scrollbar, I'd also like to highlight some column variables depending on their values, however my issue is that no horizontal scrollbar appears. This is the code:
library(DT)
library(shiny)
library(shinydashboard)
library(dashboardthemes)
library(shinyjs)
data <- read.csv("somedata.csv", check.names = FALSE)
options(DT.options = list(pageLength = 5), scrollX = TRUE)
ui <- dashboardPage(
dashboardHeader(title = "Table Summary"),
dashboardSidebar(collapsed = FALSE,
sidebarMenu(
id = "tabs",
menuItem(text = "Tab 1",
tabName = "t1",
icon = icon('trophy'),
selected = TRUE
)
)
),
dashboardBody(
shinyjs::useShinyjs(),
tabItems(
tabItem(
tabName = "t1",
#we wan to create 3 separate pages on this tab
tabsetPanel(
id = "t1Selected", #returns value of current page we're on,
type = "tabs",
tabPanel(
title = "totals",
id = "tab_totals",
fluidRow(
column(width = 6, align = "right", DT::dataTableOutput("table"))
#DT::dataTableOutput("table")
),
fluidRow(
column(
width = 3, align = "left", checkboxInput("bt1", "Test for this?", TRUE)
),
column(
width = 3, align = "left",numericInput("bt1C", "Choice", 0, min = -100, max = 100)
),
column(
width = 3, align = "left", checkboxInput("bt2", "Test for this?", TRUE)
),
column(
width = 3, align = "left",numericInput("bt2C", "Choice", 0, min = -100, max = 100)
),
)
)
)
)
)
)
)
server <- function(input, output, session) {
observe({
shinyjs::enable("bt1C")
if(input$bt1 == 0){
shinyjs::disable("bt1C")
}
})
output$table <- DT::renderDataTable({
datatable(data) %>% formatStyle('Message_ratio', backgroundColor = styleEqual(c(0, 9.57), c('gray', 'yellow')))
})
}
shinyApp(ui, server)
I have the global setting for DT.options saying that scrollX should be on, but no horizontal taskbar comes up....
If it matters, I'm using windows.
Any suggestions would be helpful.
Before anyone recommends this link: How to make the horizontal scrollbar visible in DT::datatable
I've already tried what theyre saying, did not seem to help.
Using mtcars as example this works for me to get a horizontal scroll bar.
library(DT)
library(shiny)
library(shinydashboard)
library(dashboardthemes)
library(shinyjs)
data <- mtcars
ui <- dashboardPage(
dashboardHeader(title = "Table Summary"),
dashboardSidebar(collapsed = FALSE,
sidebarMenu(
id = "tabs",
menuItem(text = "Tab 1",
tabName = "t1",
icon = icon('trophy'),
selected = TRUE
)
)
),
dashboardBody(
shinyjs::useShinyjs(),
tabItems(
tabItem(
tabName = "t1",
#we wan to create 3 separate pages on this tab
tabsetPanel(
id = "t1Selected", #returns value of current page we're on,
type = "tabs",
tabPanel(
title = "totals",
id = "tab_totals",
fluidRow(
column(width = 6, align = "right", DT::dataTableOutput("table"))
#DT::dataTableOutput("table")
),
fluidRow(
column(
width = 3, align = "left", checkboxInput("bt1", "Test for this?", TRUE)
),
column(
width = 3, align = "left",numericInput("bt1C", "Choice", 0, min = -100, max = 100)
),
column(
width = 3, align = "left", checkboxInput("bt2", "Test for this?", TRUE)
),
column(
width = 3, align = "left",numericInput("bt2C", "Choice", 0, min = -100, max = 100)
),
)
)
)
)
)
)
)
server <- function(input, output, session) {
observe({
shinyjs::enable("bt1C")
if(input$bt1 == 0){
shinyjs::disable("bt1C")
}
})
output$table <- DT::renderDataTable({
datatable(data, options = list(scrollX = TRUE)) %>%
formatStyle('mpg', backgroundColor = styleEqual(c(0, 9.57), c('gray', 'yellow')))
})
}
shinyApp(ui, server)
As the title says. I have entered the code exactly as it is the book, but I run into this error message: "Error in shiny::tabsetPanel(..., id=id, selected = selected) : argument is missing, with no default"
I have no idea what is missing.
Here is the code:
library(shinydashboard)
ui<- dashboardPage(
dashboardHeader(title= "Uniform Distribution"),
dashboardSidebar(),
dashboardBody(
fluidRow(
column(width =6,
box(title = "Select a Number",
solidHeader = TRUE,
background = "yellow",
status = "warning",
width = NULL,
height = 312,
sliderInput(inputId = "number",
label = "",
value = 500, min = 25, max = 1000)),
box(
background= "light-blue",
solidHeader = TRUE,
status ="primary",
title = "Histogram",
width = NULL,
plotOutput("hist", height = 250))),
column(width = 6,
tabBox(
title ="Central Tendency",
id ="tabs1", height = 120, width =NULL,
tabPanel("Mean", h2(textOutput("meantext")),width=NULL),
tabPanel("Median", h2(textOutput("mediantext")),width=NULL),
),
tabBox(
title ="Variability",
id ="tabs2", height = 120, width =NULL,
tabPanel("Variance", h2(textOutput("vartext")),width=NULL),
tabPanel("Standard Deviation", h2(textOutput("sdtext")),width=NULL))
)
)
))
server <- function(input,output){
histdata <- reactive({runif(input$number, min=0, max = 1)})
output$hist <- renderPlot({
hist(histdata(), xlab = "Value",
main= paste(input$number,"random values between 0 and 1"))
})
output$meantext <- renderText({
paste("Mean =", round(mean(histdata()),3))})
output$mediantext <- renderText({
paste("Median =", round(median(histdata()),3))})
output$vartext <- renderText({
paste("Variance =", round(var(histdata()),3))})
output$sdtext <- renderText({
paste("Standard Deviation =", round(sd(histdata()),3))})
}
shinyApp(ui, server)
You have tabPanels outside of tabsetPanels. Your tabPanels need to wrapped inside tabsetPanel() or navBarPage()
See below:
ui<- dashboardPage(
dashboardHeader(title= "Uniform Distribution"),
dashboardSidebar(),
dashboardBody(
fluidRow(
column(width =6,
box(title = "Select a Number",
solidHeader = TRUE,
background = "yellow",
status = "warning",
width = NULL,
height = 312,
sliderInput(inputId = "number",
label = "",
value = 500, min = 25, max = 1000)),
box(
background= "light-blue",
solidHeader = TRUE,
status ="primary",
title = "Histogram",
width = NULL,
plotOutput("hist", height = 250))),
column(width = 6,
tabBox(
title ="Central Tendency",
id ="tabs1", height = 120, width =NULL,
tabsetPanel(
tabPanel("Mean", h2(textOutput("meantext")),width=NULL),
tabPanel("Median", h2(textOutput("mediantext")),width=NULL)
)
),
tabBox(
title ="Variability",
id ="tabs2", height = 120, width =NULL,
tabsetPanel(
tabPanel("Variance", h2(textOutput("vartext")),width=NULL),
tabPanel("Standard Deviation", h2(textOutput("sdtext")),width=NULL)
)
)
)
)
))
I've been struggling to add a functional slider input to my ggplot line chart for "number of observations", but I keep getting errors .. The code below works but the plot does not change ( I tried lots of stuff like adding a reactive function or adding input$obs inside ggplot but it still didn't work) .. I really appreciate your help ! Thanks
library(shiny)
library(shinydashboard)
library(readxl)
library(ggplot2)
library(dashboardthemes)
library(shinyWidgets)
library(dplyr)
df=read_excel("MASI.xlsx")
# Define UI for application that draws a histogram
ui <- dashboardPage(
dashboardHeader(title = "Finance Dashboard"),
dashboardSidebar(),
dashboardBody(
# Boxes need to be put in a row (or column)
fluidRow(
box(
title = "Line chart", status = "primary", solidHeader = TRUE,
collapsible = TRUE,
plotOutput("plot1", height = 250)
),
box(
title = "MASI", status = "primary", solidHeader = TRUE,
"The MASI index (Moroccan All Shares Index) is a stock index that tracks the performance of all
companies listed in the Casablanca Stock Exchange located at Casablanca."
),
box(
title = "Inputs", status = "primary", solidHeader = TRUE, collapsible = TRUE,
sliderInput("obs",
"Number of observations:",
min = 1,
max = length(df$MASI),
value = 50)
),
),
),
setBackgroundColor(
color = "white",
gradient = c("linear", "radial"),
direction = c("bottom", "top", "right", "left"),
shinydashboard = TRUE
)
)
server <- function(input, output) {
output$plot1 <- renderPlot({
ggplot(df,aes(x=Session, y=MASI)) + geom_line( color="darkblue", size=0.7) + theme_bw()
}, bg="transparent")
}
shinyApp(ui, server)
EDIT
Thank you for the kind answer #chemdork123.
I want to add a Date range in addition to the sliderInput. Here's what I did:
library(shiny)
library(shinydashboard)
library(readxl)
library(ggplot2)
library(dashboardthemes)
library(shinyWidgets)
library(dplyr)
df=read_excel("MASI.xlsx")
# Define UI for application that draws a histogram
box_height = "20em"
plot_height = "16em"
ui <- dashboardPage(
dashboardHeader(title = "Finance Dashboard"),
dashboardSidebar(),
dashboardBody(
# Boxes need to be put in a row (or column)
fluidRow(
box(
title = "Line chart", status = "primary", solidHeader = TRUE,
collapsible = TRUE,
plotOutput("plot1", height = 250)
),
box(
title = "MASI", status = "primary", solidHeader = TRUE,
"The MASI index (Moroccan All Shares Index) is a stock index that tracks the performance of all
companies listed in the Casablanca Stock Exchange located at Casablanca."
),
box(
title = "Inputs", status = "primary", solidHeader = TRUE, collapsible = TRUE,
sliderInput("obs",
"Number of observations:",
min = 1,
max = length(df$MASI),
value = 50),
dateRangeInput("date", strong("Date range"),
start = "2015-01-02", end = "2020-07-17",
min = "2015-01-02", max = "2020-07-17")
),
box(
title = "Line chart", status = "success", solidHeader = TRUE,
collapsible = TRUE,
plotOutput("plot2", height = 250)
),
box(
title = "Return", status = "success", solidHeader = TRUE,
"The relative difference of the MASI index"
),
box(
title = "Inputs", status = "success", solidHeader = TRUE, collapsible = TRUE,
sliderInput("obs",
"Number of observations:",
min = 1,
max = length(df$MASI),
value = 50)
),
),
),
setBackgroundColor(
color = "white",
gradient = c("linear", "radial"),
direction = c("bottom", "top", "right", "left"),
shinydashboard = TRUE
)
)
server <- function(input, output) {
reactive_data <- reactive({
set.seed(8675309) # for some consistent sampling
df <- df[sample(x=1:nrow(df), size = input$obs),]
return(df)
req(input$date)
validate(need(!is.na(input$date[1]) & !is.na(input$date[2]), "Error: Please provide both a start and an end date."))
validate(need(input$date[1] < input$date[2], "Error: Start date should be earlier than end date."))
df %>%
filter(
date > as.POSIXct(input$date[1]) & date < as.POSIXct(input$date[2]
))
})
output$plot1 <- renderPlot({
ggplot(reactive_data(),aes(x=Session, y=MASI)) + geom_line(color="darkblue", size=0.7) + theme_bw()
}, bg="transparent")
output$plot2 <- renderPlot({
ggplot(df,aes(x=Session, y=Return)) + geom_line( color="darkblue", size=0.7) + theme_bw()
}, bg="transparent")
}
shinyApp(ui, server)
Here is a link for the Dataset
Capture
OP. Without your data, it's difficult to give you a clear answer to your particular question, but I can show you how the input$obs slider input control can be used (or any other one for that matter) to filter and provide data for your ggplot() function to display.
Here's a working app that gives you two controls to adjust what data is displayed from the mtcars built-in dataset. The sliderInput() control determines how many rows are sampled from the total mtcars dataset. The selectInput() control allows you to select one or all of the values for mtcars$carb to display in the chart based on the sampled dataset.
You will see the general approach on how to use both inputs reactively is to create a reactive function (called sample_cars()) that is called inside of the renderPlot() function. The reactive function sample_cars() returns a data frame that is used in the ggplot() call.
library(shiny)
library(shinydashboard)
library(ggplot2)
library(dplyr)
library(tidyr)
ui <- dashboardPage(
dashboardHeader(title = "Example App"),
dashboardSidebar(),
dashboardBody(
# Boxes need to be put in a row (or column)
fluidRow(
box(
title = "Line chart", status = "primary", solidHeader = TRUE,
collapsible = TRUE,
plotOutput("plot1", height = 250)),
box(
title = "Inputs", status = "primary", solidHeader = TRUE, collapsible = TRUE,
sliderInput("obs", "Number of observations:",
min = 1, step = 1, max = nrow(mtcars), value = nrow(mtcars)),
selectInput("carbs", "Select carb to show",
choices = c('All', unique(mtcars$carb))
)
),
)
)
)
server <- function(input, output) {
sample_cars <- reactive({
set.seed(8675309) # for some consistent sampling
df <- mtcars[sample(x=1:nrow(mtcars), size = input$obs),]
if(input$carbs != "All")
df <- df %>% dplyr::filter(carb == input$carbs)
return(df)
})
output$plot1 <- renderPlot({
ggplot(sample_cars(), aes(mpg, disp)) + geom_point() +
labs(title=paste('You selected',input$obs, 'cars\n and to show',input$carbs, 'values of carb!'))
}, bg="transparent")
}
shinyApp(ui, server)
I have an app with two Highcharts plot, when I start the app the width of the two plots are correct, but everytime I change the mean input, the width of the first plot is set to the width of the second, like this :
When I start the app :
When I change the input :
My code to produce the app :
library(rCharts)
library(shiny)
runApp(list(
ui = fluidPage(
title = "App title",
titlePanel(strong("App title", style="color: steelblue")),
sidebarLayout(
sidebarPanel(width = 2,
br()),
mainPanel(width = 10,
tabsetPanel(
tabPanel("Tab 1",
selectInput(inputId = "input_mean", label = "Mean : ", choices = c(20:30)),
fluidRow(
column(8,
showOutput(outputId = "chart1", lib = "highcharts")
, br(), br(), br(), br(), br(), br(), br(), br(), br(), br(), br()),
column(4,
showOutput(outputId = "chart2", lib = "highcharts"))
)
)
)
)
)
),
server = function(input, output) {
my_data <- reactive({
rnorm(n = 30, mean = as.numeric(input$input_mean))
})
output$chart1 <- renderChart2({
my_data = my_data()
h2 <- Highcharts$new()
h2$chart(type="line")
h2$series(data=my_data, name = "One", marker = list(symbol = 'circle'), color = "lightblue")
h2$set(width = 800, height = 400)
return(h2)
})
output$chart2 <- renderChart2({
my_data = my_data()
my_mean = as.numeric(input$input_mean)
part = data.frame(V1 = c("Sup", "Inf"), V2 = c(sum(my_data>my_mean), sum(my_data<my_mean)))
p = hPlot(x = "V1", y = "V2", data = part, type = "pie")
p$tooltip(pointFormat = "{series.name}: <b>{point.percentage:.1f}%</b>")
p$params$width <- 200
p$params$height <- 200
return(p)
})
}
))
I use rCharts_0.4.5 and shiny_0.9.1.
Thanks !
Replace these lines:
h2$chart(type="line")
h2$set(width = 800, height = 400)
as follows:
h2$chart(type="line", width = 800, height = 400)
This should help.