Given the following ui.R and server.R and circuit.csv; I can produce a simple plot which reacts to the user input (power in this case).
However, not all values for power are returned. For example, .5 produces a plot whereas .6 does not, so on and so forth at random occurrence throughout the power range.
If i plot as a table instead, to check my work, same thing, certain power inputs work as expected and others produce no table, and also no plot when asking to plot.
ui.R
library(shiny)
library(ggplot2)
shinyUI(fluidPage(
hr(),
sidebarLayout(
sidebarPanel(
sliderInput("power",label = "Power",
min = 0, max = 5, value = .5, step = .1)
),
mainPanel(
p("Lum vs Distance by Power"),
plotOutput('plot1')
)
)
))
server.R
library(shiny)
library(ggplot2)
df <- read.table(file = "circuit.csv", sep=",", header = TRUE)
shinyServer(function(input, output) {
output$plot1 <- renderPlot({
df2 <- subset(df,df$pow==input$power)
p <- ggplot(df2)+
geom_point(aes(x=dist, y=lum))
print(p)
})
})
Link to github (for csv data)
I would post images but am not allowed to do so at this time.
Related
I am currently working on a Shiny dashboard that has a slider that outputs the optimal portfolio weights of stocks, gold and silver for a given volatility value using the slider input. I have been able to output the values with a dynamic text output given the slider input, but I cannot figure out how to turn these values into a graph as the text output in Shiny seems to require a function. How can I add a pie chart to this code using the values I get from slidervalues()? It outputs a list of 5 numerical values, now I want to chart the first 3 of them in a pie chart:
library(shiny)
shinyUI(fluidPage(
headerPanel(title = "Volatility Slider"),
sidebarLayout(
sidebarPanel(
sliderInput("Risk","Volatility", 0, 0.24, 0.12)
),
mainPanel(
textOutput("Output")
)
)
))
server <- function(input, output) {
sliderValues <- reactive({
#This part finds the optimal portfolio using CAPM(which is found in a different script).
custom <- three_assets %>%
filter(sd_p > input$Risk,
sd_p < input$Risk+0.0001)
max_er_custom <- custom[custom$er_p == max(custom$er_p)]
toString(max_er_custom)
})
output$Output <- renderText({
sliderValues()
})
}
Here is a screenshot of the dashboard. The first three values are the weights of the three assets, the forth value is the expected return of that portfolio and the last value is the volatility of that portfolio all using historical data.
Not sure how to replicate your logic without your files, but here's an example where the input slider determines the values in the sliderValues data frame, which are in turn used to create a bar chart.
library(shiny); library(ggplot2)
ui <- fluidPage(
headerPanel(title = "Volatility Slider"),
sidebarLayout(
sidebarPanel(
sliderInput("Risk","Volatility", 0, 0.24, 0.12)
),
mainPanel(
plotOutput("Output")
)
)
)
server <- function(input, output) {
sliderValues <- reactive({
data.frame(values = c(input$Risk, 0.7 * (1 - input$Risk), 0.3 * (1-input$Risk)),
categories = c("A", "B", "C"))
})
output$Output <- renderPlot(
ggplot(sliderValues(), aes(1, values, fill = categories)) +
geom_col() +
coord_polar(theta = "y")
)}
shinyApp(ui = ui, server = server)
I am building an RShiny-app where I am creating a plot based on a data table which I can edit and another data table which I cannot. I eventually want to save all data points on the plot in a data table which I can display and export.
I have seen many ways to do this using ggplot (ie layer_data, ggplot_build), but no efficient ways when just using plot and lines. My plots will be getting quite complicated so it would be really helpful to find an easy way to do this rather than hardcoding everything in.
A very simple example of my code is below (Note: plots will be getting much more complicated than this. They will be line graphs, but I will just need the y values at each x value marked with a number on the x axis):
x <- data.frame('col_1' = c(1,2,3,4,5), 'col_2' = c(4,5,6,7,8))
y <- data.frame('col_1' = c(5,4,3,6,7), 'col_2' = c(1,2,3,4,5))
#import necessary libraries
library(shiny)
library(DT)
library(shinythemes)
library(rhandsontable)
#ui
ui <- fluidPage(theme = shinytheme("flatly"),
titlePanel("Test"),
sidebarLayout(
sidebarPanel(
#display data
rHandsontableOutput('contents'),
#update plot button
actionButton("go", "Plot Update"),
width=4
),
mainPanel(
tabsetPanel(
#plot
tabPanel("Plot", plotOutput("plot_1")) )
))
)
#server
server <- function(input, output, session) {
#data table
output$table_b <- renderTable(x)
indat <- reactiveValues(data=y)
observe({
if(!is.null(input$contents))
indat$data <- hot_to_r(input$contents)
})
output$contents <- renderRHandsontable({
rhandsontable(indat$data)
})
#save updated data
test <- eventReactive(input$go, {
live_data = hot_to_r(input$contents)
return(live_data)
})
#plot
output$plot_1 <- renderPlot({
plot(x[,1],x[,2],col='red',type = 'l')
lines(test()[,1],x[,2], col='black', type='l')
# need a way to grab data from plot a create a table
})
}
shinyApp(ui, server)
I have an r script includes a Identify_IP() that returns a list of dataframe and a ggplot. I want to call the script and render both the dataframe and the plot.
This is Identify_IP() function. I took off unrelative code and kept only the plot, lines and ggplot code to give a clear example of my type of ggplot.
library(ggplot2)
library(matrixStats)
library(fda.usc)
#df <- read.table("name.XLS", header = FALSE)
Identify_IP = function(df1){
mlearn <- df1[,'V7']
formul <- plot(blue_curve$x, blue_curve$y * 30, type = 'l', col = 'blue')
formula_deriv <- lines(blue_curve$x, red_curve$y1 * 30, col = 'red')
p <- ggplot(df1, aes(blue_curve$x)) +
geom_line(aes(y = blue_curve$y, colour = "0 Deriv")) +
geom_line(aes(y = red_curve$y1, colour = "1st Deriv")) +
geom_vline(xintercept = x_loc) + geom_hline(yintercept = 0)
return(list(df1,p))
}
Now, this is a modified Shiny code based on amrr and micstr suggestion.
source('InflectionP2.R', local = TRUE)
library(ggplot2)
library(shiny)
runApp(
list(
ui = fluidPage(
titlePanel("Upload your file"),
sidebarLayout(
sidebarPanel(
fileInput('file1', 'Choose xls file',
accept = c(".XLS")),
actionButton("btn", "Update Table"),
actionButton("btn1", "Display Plot")
),
mainPanel(
tableOutput('what'),
plotOutput('pl'))
)
)
,
server = function(input, output, session){
dataOP <- reactive({
inFile <- input$file1
if (is.null(input$file1))
return(NULL)
dfs <- Identify_IP(read.table(inFile$datapath))
return(dfs)
})
observeEvent(input$btn, output$what <- renderTable({
dataOP()[[1]]
}))
observeEvent(input$btn1, output$pl <- renderPlot({
pp <- dataOP()
pp[[2]]
}))
}))
This was really helpful in teaching me how to call r script in reactive(). And it makes sense to me. Yet, it render the table but the Display Plot button is not rendering the plot. Does my ggplot in Identify_IP function has anything to do with not being able to display the plot? I also tried print(ggplot(pp[[2]])) and still the same.
I managed to get this working.
Note I used the internal data set iris and made a toy Identify_IP function as I do not have your code.
Note you still need to choose a file to trigger the events but it will ignore that file and use iris data.
Workaround I used [[1]] to get the table not dataOP()$tble
CODE
library(shiny)
library(ggplot2)
# source('InflectionP2.R', local = TRUE)
# MAKE TEST FUNCTION
Identify_IP <- function(mydata) {
#shrink data
tble <- head(mydata)
plt <- ggplot(data = head(mydata),
mapping = aes(y = Sepal.Length,
x = Petal.Length)) + geom_point()
return(list(tble, plt))
}
runApp(
list(
ui = fluidPage(
titlePanel("Upload your file"),
sidebarLayout(
sidebarPanel(
fileInput('file1', 'Choose xls file',
accept = c(".XLS")),
actionButton("btn", "Update Table"),
actionButton("btn1", "Display Plot")
),
mainPanel(
tableOutput('what'),
plotOutput('pl'))
)
)
,
server = function(input, output, session){
dataOP <- reactive({
inFile <- input$file1
if (is.null(input$file1))
return(NULL)
# ORIGINAL dfs <- Identify_IP(read.table(inFile$datapath))
# using internal dataset for example
dfs <- Identify_IP(iris)
# ORIGINAL list(tble = dfs, plt = dfs)
# lets just return your dfs, its already a list in code above
return(dfs)
})
observeEvent(input$btn, output$what <- renderTable({
#print(dataOP()) # debug line that led to [[1]] idea
# ORIGINAL dataOP()$tble
# just say first in list
dataOP()[[1]]
}))
observeEvent(input$btn1, output$pl <- renderPlot({
#ggplot(dataOP()$plt)
# since already a plot just need to index it
# I found [[2]] worked better than explicit dataOP()$plt
pp <- dataOP()
pp[[2]]
}))
}))
RESULT
Voila!
1) Try print (ggplot(dataOP()$plt))
Take a look at this answer I wrote.
2) Sorry its hard to interpret without your ggplot code bit and data. Given #amrrs questions can you try debug in your Shiny code with print() and str() temporary lines to see what your data is returning. i.e.
print(dataOP()$plt)
str(dataOP())
Worse case, try split your code in two. So Identify_IP code to do the data leg and then make a Print_IP with the ggplot code that just returns the plot. It might rule out your chart is not the problem.
3) Take a look at reactiveValues()
https://shiny.rstudio.com/reference/shiny/0.11/reactiveValues.html
It "bakes" a result that was reactive. The type coming out of your chart may be a reactive type not a chart type. Perhaps share any error messages you are getting.
This is causing me a lot of pain.
I would like to simlpy have a sliderInput that takes a Date (preferably stepping by month) and changes a simple ggplot_bar as a result. Although I can show everything there seems to be no response to the changing of the slider:
Here is my code:
ui.r
library(shiny)
# Define UI for application that draws a histogram
shinyUI(fluidPage(
# Application title
titlePanel("St Thomas' Physiology Data Console"),
# Sidebar with a slider input for the number of bins
sidebarLayout(
sidebarPanel(
sliderInput("DatesMerge",
"Dates:",
min = as.Date("2006-01-01","%Y-%m-%d"),
max = as.Date("2016-12-01","%Y-%m-%d"),
value=as.Date("2016-12-01"),timeFormat="%Y-%m-%d")
),
# Show a plot of the generated distribution
mainPanel(
tabsetPanel(
tabPanel("Breath Tests",plotOutput("distPlotLactul")),
)
)
))
server.r
library(shiny)
source("S:\\Usage.R")
# Define server logic required to draw a histogram
shinyServer(function(input, output) {
output$distPlotLactul <- renderPlot({
#Create the data
DatesMerge<-input$DatesMerge
# draw the histogram with the specified number of bins
ggplot(TotsLactul)+
geom_bar(aes(DatesMerge,fill=year))+
labs(title=paste("Num")) +
xlab("Time") +
ylab("NumP") +
theme(axis.text.x=element_text(angle=-90)) +
theme(legend.position="top")+
theme(axis.text=element_text(size=6))
})
})
I wasn't totally sure of your ggplot code, so I had to rejig into something I understood.
I also created my own data to make it reproducible.
Here is the data I made
# Generate random variates
TotsLactul <- rep(ymd("2016-01-01"),10000)
randomMonths <- round(runif(n = 10000,min = 0,max = 11),0)
randomDays <- round(runif(n = 10000,min = 0,max = 28),0)
# Increments days
month(TotsLactul) <- month(TotsLactul) + randomMonths
day(TotsLactul) <- day(TotsLactul) + randomDays
# Make it a DT
TotsLactul <- data.table(x=TotsLactul)
This is just random dates throughout the year.
UI
ui <- shinyUI(fluidPage(
# Application title
titlePanel("St Thomas' Physiology Data Console"),
# Sidebar with a slider input for the number of bins
sidebarLayout(
sidebarPanel(
sliderInput("DatesMerge",
"Dates:",
min = as.Date("2016-01-01","%Y-%m-%d"),
max = as.Date("2016-12-01","%Y-%m-%d"),
value=as.Date("2016-12-01"),
timeFormat="%Y-%m-%d")
),
mainPanel(
plotOutput("distPlotLactul"))
)
))
I amended the slider to only take 2016 values, to match my generated data
Server
server <- shinyServer(function(input, output) {
output$distPlotLactul <- renderPlot({
#Create the data
DatesMerge<-input$DatesMerge
# draw the histogram with the specified number of bins
ggplot(TotsLactul[month(x) == month(DatesMerge)],mapping=aes(x=x))+
geom_histogram(bins=100)+
labs(title=paste("Num")) +
xlab("Time") +
ylab("NumP") +
theme(axis.text.x=element_text(angle=-90)) +
theme(legend.position="top")+
theme(axis.text=element_text(size=6))
})
})
I'll be honest, I have never used ggplot like you have (just dropped in a table in a geom etc.), so I can't comment on if any of it was right / wrong. Hopefully you can follow my changes.
Changed geom_bar to geom_hist (to match my data)
The filtering happens in the data included in the plot, not within the geom.
This seems to work fine, let me know how you get on.
I have the following code that I am unsuccessfully trying to run. I just want to be able to filter a graph output based on an input range. In this example, if the range input is set to 1-5, I would like to see 5 points on the graph, likewise range input of 2-5 shows 4 points.
##UI
require(shiny)
shinyUI(fluidPage(
titlePanel(title=h4("Races", align="center")
),
sidebarPanel(
sliderInput("num", "Number:",
min = 0, max = 5,step=1,value=c(0,2)),
mainPanel(
plotOutput("plot2")))))
##server
library(dplyr)
library(ggplot2)
shinyServer(function(input,output){
num<-c(1,2,3,4,5)
let<-c("A","B","C","D","E")
date<-c("2015-5-1","2015-6-1","2015-7-1","2015-8-1","2015-9-1")
df<-data.frame(num,let,date)
dat<-reactive({
df %>% filter(num==input$num)})
output$plot2<-renderPlot({
ggplot(dat(),aes(x=date,y=num))+geom_point(colour='red')},height = 400,
width = 600)})
I would like to show the range of values on the graph based on the input range but only 1 value is showing, not the range of values with corresponding dates.
Thanks in advance.
Is this what you want? Edit: Now you would be able to see all the points you have specified
#rm(list = ls())
library(shiny)
library(ggplot2)
num<-c(1,2,3,4,5)
let<-c("A","B","C","D","E")
date<-c("2015-5-1","2015-6-1","2015-7-1","2015-8-1","2015-9-1")
df <- data.frame(num,let,date)
ui <- fluidPage(
titlePanel(title=h4("Races", align="center")),
sidebarPanel(
sliderInput("num", "Number:",min = 0, max = 5,step=1,value=c(1,2))),
mainPanel(plotOutput("plot2")))
server <- function(input,output){
dat <- reactive({
test <- df[df$num %in% seq(from=min(input$num),to=max(input$num),by=1),]
print(test)
test
})
output$plot2<-renderPlot({
ggplot(dat(),aes(x=date,y=num))+geom_point(colour='red')},height = 400,width = 600)}
shinyApp(ui, server)