rPlot won't show in Shiny app - r

I have a app, where I want to use rCharts and polycharts, to create a plot with a tooltip. But the plot doesn't show up, when I load the shiny app, and I can't figure out why.
Here is my ui.R:
library(shiny)
require(rCharts)
shinyUI(fluidPage(
titlePanel("Please work..."),
sidebarLayout(
sidebarPanel( "Test:",
uiOutput("TestSelection")),
mainPanel("Plots (show me the money, please!):",
showOutput("tempplot","polycharts")
)
)
))
And here's my server.R:
library(shiny)
require(rCharts)
#Test of rcharts and shiny.
df1 <- read.csv("//KED-FILE/ASIC-Shared/users/jhertel/Work/R_workspace/oban_test_data.csv",quote="")
shinyServer(function(input, output, session){
output$TestSelection <- renderUI({
df <- df1
selectInput("TestSel", "Test Variable", ls(df, pattern = ".*?_meas|.*?_calc"))
})
output$tempplot <- renderChart2({
dataPlot <- df1[,c("DUT", input$TestSel, "Temperature")]
r1 <- rPlot(input$TestSel ~ Temperature,
data = dataPlot,
type = "point",
tooltip = "#!function(item){return item.DUT}!#",
sample = FALSE)
r1$guides(
x = list(
min = pretty( dataPlot$Temperature ) [1],
max = tail( pretty( dataPlot$Temperature ), 1 ),
numticks = length( pretty( dataPlot$Temperature ) ),
labels = pretty( dataPlot$Temperature )
),
y = list(
min = pretty( dataPlot[, input$TestSel] ) [1],
max = tail( pretty( dataPlot[, input$TestSel] ), 1 )
)
)
return(r1)
})
})
I've tried different things, such as options(RCHART_LIB = 'polycharts'), using as.formula around input$TestSel ~ Temperature, adding a reactive element on the TestSelection-ui, I've tried changing browser, from internal, to Firefox, to Chrome.
I am suspecting the input$TestSel ~ Temperature to be the reason, as when I inspect the javascript with Chrome, it doesn't look like input$TestSel has been interpreted to the desired value. But I am a total noob to javascript, so I wouldn't know. EDIT: I am fairly certain that my error occurs here, as setting the changing input$TestSel to a desired value results in the desired plot... Still don't know how to solve it, though.
When just using R the plot shows up as desired in the viewer.

Related

Update plotly data (chloropleth) in R shiny without re-rendering entire map

I am trying to use shiny controls to modify the data underlying a plotly chloropleth map.
Whenever I change the data the entire plot re-renders, which is quite slow. I'm guessing the bottleneck is redrawing the geojson polygons. Because the geojson never changes, I'm wondering if there is a way to keep the rendered widget intact but modify the z values only.
It looks like using plotlyProxy and plotlyProxyInvoke might be the right direction, but I can only see examples of an entire trace (which includes the geojson data) being replaced.
Sorry if I'm missing something or have been unclear - I have not used plotly very much, and even less so the js side of things.
See below for example code:
library(shiny)
library(dplyr)
library(plotly)
library(readr)
library(rjson)
zip_geojson <- fromJSON(file="https://raw.githubusercontent.com/hms1/testData/main/zip3_2.json")
plot_data <- read_csv(file="https://raw.githubusercontent.com/hms1/testData/main/plot_data.csv")
mapboxToken <- "pk.eyJ1IjoiaG1vcmdhbnN0ZXdhcnQiLCJhIjoiY2tmaTg5NDljMDBwbDMwcDd2OHV6cnd5dCJ9.8eLR4FtlO079Gq0NeSNoeg" #burner token
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
sliderInput("multip",
"n:",
min = 1,
max = 10,
value = 1)
),
mainPanel(
plotlyOutput("cPlot")
)
)
)
server <- function(input, output) {
output$cPlot <- renderPlotly({
plot_data_i <- plot_data%>%
mutate(log_count = case_when(log_count <= input$multip ~ log_count * input$multip,
TRUE ~ log_count))
plot_ly() %>%
add_trace(
type = "choroplethmapbox",
geojson = zip_geojson,
locations = plot_data_i$zip,
z = plot_data_i$log_count
) %>%
layout(
mapbox = list(
style = "light",
zoom = 3,
center = list(lon = -95.7129, lat = 37.0902)
)
) %>%
config(mapboxAccessToken = mapboxToken)
})
}
shinyApp(ui = ui, server = server)
For anyone else who comes across this post later, I found a solution.
It turns out that you can change data using the restyle method in plotlyProxyInvoke, as shown below.
library(shiny)
library(dplyr)
library(plotly)
library(readr)
library(rjson)
zip_geojson <- fromJSON(file="https://raw.githubusercontent.com/hms1/testData/main/zip3_2.json")
plot_data <- read_csv(file="https://raw.githubusercontent.com/hms1/testData/main/plot_data.csv")
mapboxToken <- "pk.eyJ1IjoiaG1vcmdhbnN0ZXdhcnQiLCJhIjoiY2tmaTg5NDljMDBwbDMwcDd2OHV6cnd5dCJ9.8eLR4FtlO079Gq0NeSNoeg"
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
sliderInput("multip",
"n:",
min = 1,
max = 10,
value = 1),
actionButton("Remove", "Remove Trace")
),
mainPanel(
plotlyOutput("cPlot")
)
)
)
server <- function(input, output, session) {
output$cPlot <- renderPlotly({
plot_ly(type = "choroplethmapbox", geojson = zip_geojson) %>%
layout(
mapbox = list(
style = "light",
zoom = 3,
center = list(lon = -95.7129, lat = 37.0902)
)
) %>%
config(mapboxAccessToken = mapboxToken)
})
plotproxy <- plotlyProxy("cPlot", session, deferUntilFlush = FALSE)
observeEvent(input$multip, {
plot_data_i <- plot_data %>%
mutate(log_count = case_when(log_count <= input$multip ~ log_count * input$multip,
TRUE ~ log_count))
plotproxy %>%
plotlyProxyInvoke("restyle", list(z = list(plot_data_i$log_count),
locations = list(plot_data_i$zip)))
})
}
shinyApp(ui = ui, server = server)

How do I animate my R Shiny plot's output based on the increments of slider input value?

I've looked through R Shiny tutorials and stackoverflow for answers related to my query. I usually wait for 3-4 days to solve a coding problem before I attempt to post.
I have an animated slider in my UI that loops through time interval in a column (column a) . I'm trying to produce an animated line plot that plots y values of another column (column b), corresponding to the nrow() of that time interval. The slider works perfectly, but I haven't been able to plot the output.
I mightve missed some concepts related to reactivity in Shiny app. Appreciate any guidance I can get related to my query. I'll be happy to post more info if needed.
a <- c(0,1,2,3,4,5,6)
b <- c(50,100,40,30,20,80)
mydata <- cbind(a,b)
mydata <- as.data.frame(mydata())
ui <- fluidPage (
headerPanel("basic app"),
sidebarPanel(
sliderInput("slider",
label = "Time elapsed",
min = 0,
max = nrow(mydata()),
value = 1, step = 1,
animate =
animationOptions(interval = 200, loop = TRUE))
),
mainPanel(
plotlyOutput("plot")
)
)
server <- function(input, output) {
sliderValues <- reactive({
data.frame(
Name = "slider",
Value = input$slider)
})
output$plot <- renderPlot({
x<- as.numeric(input$slider)
y <- as.numeric(b[x])
ggplot(mydata,aes_string(x,y))+ geom_line()
})
}
Just as a demo, I wanted the animated plot to come out like this, but in correspondance to UI slider values :
library(gganimate)
library(ggplot2)
fake <- c(1,10)
goods <- c(11,20)
fakegoods <- cbind(fake,goods)
fakegoods <- data.frame(fakegoods)
ggplot(fakegoods, aes(fake, goods)) + geom_line() + transition_reveal(1, fake)
Does this accomplish what you are looking for? Note that I removed the first element, 0, from vector a as your original example had more elements in a than b, and in order for them to be cbind together they must be the same length.
library(ggplot2)
library(shiny)
a <- c(1,2,3,4,5,6)
b <- c(50,100,40,30,20,80)
mydata <- cbind(a,b)
mydata <- as.data.frame(mydata)
ui <- fluidPage (
headerPanel("basic app"),
sidebarPanel(
sliderInput("slider",
label = "Time elapsed",
min = min(mydata$a),
max = max(mydata$a),
value = min(mydata$a), step = 1,
animate =
animationOptions(interval = 200, loop = TRUE))
),
mainPanel(
plotOutput("plot")
)
)
server <- function(input, output) {
output$plot <- renderPlot({
plotdata <- mydata[1:which(input$slider==mydata$a),]
p <- ggplot(plotdata,aes(x = a,y = b))
if(nrow(plotdata)==1) {
p + geom_point()
} else {
p + geom_line()
}
})
}

Chart not generated in R shiny when run locally using googleVis

These are the codes for my UI and server. The issue that I am facing is that when the app is run locally the charts are not being generated.
ui.R
library(googleVis)
library(shiny)
shinyUI(fluidPage(
titlePanel(" Tool"),
sidebarLayout(
sidebarPanel(
radioButtons(inputId="choice", label="What would you like to see?",
choices=c("Overall ","Individual"))
),
mainPanel(
htmlOutput("View")
)
)
))
server.R
library(googleVis)
require(googleVis)
shinyServer(function(input, output) {
n = 100
dates = seq(Sys.Date(), by = 'day', length = n)
x = 10 * rnorm(n)
y = 3 * x + 1 + rnorm(n)
label = rep(LETTERS[1:4], each=25)
label[1] = "D"
my.data = data.frame(Date = dates, x, y, label)
output$view <- renderGvis({
gvisMotionChart(my.data, idvar ='label', xvar = 'x', yvar = 'y', timevar= 'Date')
})
}
)
Looks like you have a couple things going wrong here. First, you should have a library open to shiny in both server.R and ui.R; it looks like you reproduced googleVis twice in server.R. In addition I found you capitalized the 'v' in htmlOutput('view'), but this should match the output$view path in server.R which is not capitalized.
On top of this the radio buttons seem superfluous or I do not understand the intent. Typically radio buttons are used so that their input can be fed to a reactive environment in server.R to change a dataset or some other parameter (see shiny tutorial or this example: https://github.com/rstudio/shiny-examples/blob/master/006-tabsets/server.R).
Code below will produce the plot and I have left the radio buttons even though they serve no purpose.
ui.R
library(googleVis)
library(shiny)
shinyUI(fluidPage(
titlePanel(" Tool"),
sidebarLayout(
sidebarPanel(
radioButtons(inputId="choice", label="What would you like to see?",
choices= c("Overall ","Individual"))
),
mainPanel(
htmlOutput("view")
)
)
))
server.R
library(googleVis)
library(shiny)
shinyServer(function(input, output) {
n = 100
dates = seq(Sys.Date(), by = 'day', length = n)
x = 10 * rnorm(n)
y = 3 * x + 1 + rnorm(n)
label = rep(LETTERS[1:4], each=25)
label[1] = "D"
my.data = data.frame(Date = dates, x, y, label)
output$view <- renderGvis({
gvisMotionChart(my.data,
idvar ='label',
xvar = 'x',
yvar = 'y',
timevar= 'Date')
})
})
Be sure to also open it to a browser after the app is launched. Hope that helps.

Rcharts nPlot() Percentages with discrete/multiBarChart

I want to use the nPlot() function in RCharts to plot percentages of people falling into discrete groups, rather than frequencies.
For example: Using the HairEyeColor data/code below I am able to consider the percentage of people with different hair colors (my grouping variable), as a function of their eye color.
## server.r
library(rCharts)
library(shiny)
library(reshape)
HairEyeColor1 <- melt(round(prop.table(HairEyeColor[,,1],2)*100,2))
names(HairEyeColor1) <- c("Hair", "Eye", "Percent")
shinyServer(function(input, output) {
output$myChart <- renderChart({
p1 <- nPlot(Percent ~ Eye, group = "Hair", data = HairEyeColor1, type = multiBarChart")
p1$addParams(dom = 'myChart')
return(p1)
})
})
## ui.R
library(rCharts)
library(shiny)
shinyUI(pageWithSidebar(
headerPanel("rCharts: Interactive Charts from R using NVD3.js"),
sidebarPanel(
wellPanel(
helpText( "Look at the pretty graph"
)
),
wellPanel(
helpText( "Look at the pretty graph"
)
),
wellPanel(
helpText( "Look at the pretty graph"
)
)
),
mainPanel(
div(class='wrapper',
tags$style(".Nvd3{ height: 400px;}"),
showOutput("myChart","Nvd3")
)
)
))
Say I just wanted to look at a single factor, like Hair. Is there a way to plot their percentages using nPlot()?
prop.table(rowSums(HairEyeColor[,,1]))
Black Brown Red Blond
0.2007168 0.5125448 0.1218638 0.1648746
With type=multiBarChart I have tried:
p1 <- nPlot(Percent ~ , group = "Hair", data = HairEyeColor1, type = multiBarChart")
This fails entirely. I have also tried:
p1 <- nPlot(Percent ~ 1, group = "Hair", data = HairEyeColor1, type = multiBarChart")
This at least passes some graph to Shiny UI. But this looks hideous and functionality (appearance of X/Y-axis, clicking on graph) is all lost.
I thought this would be appropriate for nPlot(type=discreteBarChart) but the data layout for this seems to want a dataframe with a single factor variable. So I can't quite see how to trick nPlot(type=discreteBarChart) into taking a vector of proportions/percentages.
Any suggestions appreciated.
Here is how to do it with nPlot. You can see the resulting plot here. If you want to stack the bars by default, add the line n1$chart(stacked = TRUE) before you print the chart.
# prepare data
require(plyr)
dat = as.data.frame(HairEyeColor)
dat = ddply(dat, .(Hair), summarize, Freq = sum(Freq), Group = "A")
# draw chart
require(rCharts)
n1 <- nPlot(Freq ~ Group, data = dat, group = 'Hair', type = 'multiBarChart')
n1

RCharts lineChart Features

I am trying to embed an RChart into a shiny app. Specifically, working with the function nPlot and the type=lineChart NVD3 feature. I am trying to plot 3 density curves for simulated Normal data. I am trying to achieve some of the functionality described in the example below:
http://nvd3.org/ghpages/line.html
My issues:
How to have different colours for different density curves?
How to have the feature to click on group variable (1), (2), (3) to effectively remove the selected density. Similar to clicking on "Sine Wave" (top right) in the example to remove the orange sine curve?
How to add x-axis and y-axis labels? My $params$xAxis= call does not work.
Below are my server.R and ui.R files:
## server.r
library(rCharts)
library(shiny)
x <-rnorm(1000,0,1)
y <-rnorm(1000,1,1)
z <-rnorm(1000,2,1)
out <- c(x,y,z)
grp <- c(rep(0,1000),rep(1,1000),rep(2,1000))
data <- as.data.frame(cbind(out,grp))
dens <- by(data$out, data$grp, density)
d <- unlist(c(dens[[1]][1][1], dens[[2]][1][1], dens[[3]][1][1]))
support <- unlist(c(dens[[1]][2][1], dens[[2]][2][1], dens[[3]][2][1]))
grpvar <- c(rep(0,length(unlist(dens[[1]][1][1]))), rep(1,length(unlist(dens[[2]][1][1]))), rep(2,length(unlist(dens[[3]][1][1]))))
dat <- as.data.frame(cbind(d,support,grpvar))
shinyServer(function(input, output) {
output$myChart <- renderChart({
p1 <- nPlot(support~d, group=grpvar, data = dat, type = "lineChart")
p1$addParams(dom = 'myChart')
p1$params$width = 600
p1$params$height = 400
p1$params$xAxis = "Support"
p1$params$yAxis = "Density"
p1$chart(tooltipContent = "#! function(key, x, y, e){
return '<b>Group</b>: ' + e.point.grpvar
} !#")
return(p1)
})
})
## ui.R
library(rCharts)
library(shiny)
shinyUI(pageWithSidebar(
headerPanel("rCharts: Interactive Charts from R using NVD3.js"),
sidebarPanel(
wellPanel(
helpText( "Look at the pretty graph"
)
),
wellPanel(
helpText( "Look at the pretty graph"
)
),
wellPanel(
helpText( "Look at the pretty graph"
)
)
),
mainPanel(
div(class='wrapper',
tags$style(".Nvd3{ height: 600px;}"),
showOutput("myChart","Nvd3")
)
)
))
Thanks in advance for any help/advice you can provide.
You will just need to add quotes around grpvar, so
p1 <- nPlot(support~d, group="grpvar", data = dat, type = "lineChart")

Resources