How does one dynamically aggregate a raster in Shiny?
i.e. using an example .flt file:
https://www.ngdc.noaa.gov/mgg/global/relief/ETOPO2/ETOPO2v2-2006/ETOPO2v2c/raw_binary/
library("dplyr")
library("ggplot2")
library("shiny")
library("raster")
ui <- fluidPage(
mainPanel(
plotOutput("canvasHere")
),
sliderInput("sliderRes", label = h5("Resolution reduction"),
min = 1, max = 100, value = 5)
) ## UI end
shinyServer <- function(input, output) {
BMgradient <- raster("/home/berg/Downloads/ETOPO2v2c_f4_LSB/ETOPO2v2c_f4_LSB.flt",crs=NA,template=NULL)
##resolutionFactor <- input$sliderRes
resolutionFactor <- 5
BMgradient <- aggregate(BMgradient, fact=resolutionFactor, fun=max)
p <- rasterToPoints(BMgradient)
bmdf <- data.frame(p)
colnames(bmdf) <- c("bbb", "ccc", "varFillBBB")
output$canvasHere <- renderPlot({
ggplot()+
geom_tile(data=bmdf,aes(bbb,ccc,fill=varFillBBB))
})
}
print("Processed code")
runApp(list(ui = ui, server = shinyServer))
Now, usually I'd just adjust a variable in the server by using:
resolutionFactor <- input$sliderRes
However, this doesn't seem to work for raster aggregation, and I just have to use a static resolution factor such as: resolutionFactor <- 5
How can I do this dynamically via a slider in the UI?
After a while, I managed to find the solution.
The raster aggregation itself needs to be placed in the reactive environment.
i.e.
output$yourOutput <- renderPlot({
BMgradient <- raster(...)
resolutionFactor <- input$sliderRes
## Rest of raster code
ggplot()+
geom_tile(data=bmdf,aes(bbb,ccc,fill=varFillBBB))
})
Then, you can manually adjust the slider and the raster will dynamically aggregate.
Related
I am plotting a matrix of DNA characters in shiny using the plot.matrix package which allows plotting of non-numeric matrix
I want to create the matrix plot in shiny and make it interactive, where when you hover over a sequence the name of the sequence appears.
e.g. in by below example the hover labels would be the row names R1, R2 etc,
Are there any good packages or ways to do this?
See below for an simplified example of my current code:
library(plot.matrix)
library(shiny)
matsample<- cbind(c("A","A","A","T"),c("A","A","A","T"),c("A","A","A","G"))
rownames(matsample) <- c("R1","R2","R3","R4")
ui <- plotOutput("matimage")
server <- function(input, output){
output$matimage <- renderPlot({
plot(matsample,col=rainbow(7),fmt.cell='%s',las=1, cex=0.5)},
width=200,
units='px')
}
shinyApp(ui = ui, server = server)
If using plotly would be an option, you could use heatmaply like this:
library(shiny)
library(plotly)
library(heatmaply)
alph <- c("A"=1, "C"=2, "G"=3, "T"=4, "I"=5, "U"=6, "N"=7)
seq <- factor(names(alph), unique(names(alph)))
# matsample <- cbind(c("A","A","A","T"),c("A","A","A","T"),c("A","A","A","G"))
matsample <- matrix(sample(names(alph), 4000, replace = TRUE), nrow=4)
ms <- matrix(alph[matsample], ncol = ncol(matsample), byrow=FALSE)
rownames(matsample) <- c("R1","R2","R3","R4")
rownames(ms) <- rownames(matsample)
mm <- data.frame(do.call(rbind, lapply(rownames(ms), rep, ncol(matsample))))
ui <- plotlyOutput("matimage", width = 160 + (ncol(matsample)*20))
server <- shinyServer(function(input, output, session) {
output$matimage <- renderPlotly({
heatmaply(ms, custom_hovertext = mm,
cellnote = matsample,
show_dendrogram = c(FALSE, FALSE),
Rowv=NULL, Colv=NULL, color=rainbow(7),
hide_colorbar=TRUE,
plot_method = "plotly")
})
})
shinyApp(ui = ui, server = server)
I want to show three different scatterplots with a next button. the task is to guess the strength of the correlation in each plot. the problem is that I can only see the same plot. I try to work with a next button to see the next plot.
library(shiny)
# 3 different dataframes/data for scatter plots
data1 <- data.frame(a <- c(20,30,35,45,50,60,80),
b <- c(60,70,72,77,82,88,90))
data2 <- data.frame(a <- c(20,30,35,45,50,60,80),
b <- c(60,70,68,77,82,88,70))
data3 <- data.frame(a <- c(35,40,38,50,52,51,30),
b <- c(60,70,72,64,82,88,90))
ui = fluidPage(
sidebarPanel(
sliderInput
(inputId = "fit", label = "estimated correlation",
min = 0, max = 1, value = 0),
actionButton("newplot", "next")),
mainPanel(plotOutput("plot")))
server = function(input, output) {
output$plot <- renderPlot({
input$newplot
plot(data1)
plot(data2)
plot(data3)
})
}
shinyApp(ui = ui, server = server)
I don't believe there is any built in way to do this, but you could easily keep a variable to track which plot you want to show and then use switch() to draw just that plot. For example
cycle <- function(x, max) {
if(x() < max) {
x(x() + 1)
} else {
x(1)
}
}
server <- function(input, output) {
index <- reactiveVal(1)
observeEvent(input$newplot, {
cycle(index, 3)
})
output$plot <- renderPlot({
switch(index(),
plot(data1),
plot(data2),
plot(data3)
)
})
}
Here I just wrote the cycle helper function to make it easier to loop back to 1 when increment the index. But basically it's just taking a value 1 to 3. Then in the renderPlot, it looks a the current index and only draws that plot.
I'm new to Shiny and coding. I found an example that uses a choropleth map (ichorophlet function) to show crime rates across years and US states. I'd like to replicate this map in Shiny using annual poverty rates in the US. My questions are: 1) How do get the map to load on Shiny? 2) How do I get the animation button to work? Below are the R codes I used. Any ideas how to fix this issue?
ui.R
shinyUI(fluidPage(
titlePanel("U.S. Poverty Rates"),
# Sidebar with slider that demonstrates various years
sidebarLayout(
sidebarPanel(
helpText("Create a poverty map."),
# Animation with custom interval (in ms) to control speed, plus looping
sliderInput("animation", "Press Play:", 1980, 2015, 1, step=1,
animate=animationOptions(interval=800, loop=TRUE))),
# Show map summarizing the values entered
mainPanel(
plotOutput("map")
)
)
))
server.R
# Load libraries
library(lattice)
library(plyr)
library(dplyr)
library(readxl)
library(RColorBrewer)
library(rMaps)
library(rjson)
library(rCharts)
library(shiny)
# Load data and helper files
data <- read_excel("data/hstpov21.xls", sheet = "Sheet1")
source("toJASON.R")
source("ichoropleth.R")
# Remove DC
datm <- subset(na.omit(data),
!(State %in% c("D.C.", "District of Columbia")))
# Discreticize poverty rates
datm2 <- transform(datm,
State = state.abb[match(as.character(State), state.name)],
fillKey = cut(Poverty,
quantile(Poverty, seq(0, 1, 1/5)),
labels = LETTERS[1:5]),
Year = as.numeric(substr(Year, 1, 4))
)
# Fill colors
fills = setNames(
c(RColorBrewer::brewer.pal(5, 'YlOrRd'), 'white'),
c(LETTERS[1:5], 'defaultFill')
)
# Create Payload for DataMaps
dat2 <- dlply(na.omit(datm2), "Year", function(x){
y = toJSONArray2(x, json = F)
names(y) = lapply(y, '[[', 'State')
return(y)
})
# Define server logic for slider
shinyServer(
function(input, output) {
# Reactive expression to compose a data frame containing all of the values
sliderValues <- reactive({
# Compose data frame
data.frame(
Name = c("Animation"),
Value = as.character(c(input$animation)),
stringsAsFactors=FALSE)
})
# Show the values using a chorophlet map
output$map <- renderPlot({
sliderValues()
ichoropleth(Poverty ~ State,
data = datm2[,1:3],
pal = 'PuRd',
ncuts = 5,
animate = 'Year',
play = TRUE)
})
})
I am trying to displaying different 3D plots in different tab panels, but I found that 3D plot only displayed in the first tab panel. According to this post, plotOutputs parameter outputId should be unique, and in my case IDs are unique over the entail shiny app. Some lines of my app are as follow:
ui.R
shinyUI(fluidPage(
mainPanel(
tabsetPanel(
tabPanel("VWC", webGLOutput("VWC3DPlot")),
tabPanel("TEMP", webGLOutput("TEMP3DPlot"))
)
)
))
server.R
shinyServer(function(input, output) {
# set dir；
dataDir <- "C:/Users/PH/Desktop/data/DATA/"
# store dataframe of attribute to list；
dfList <- readIntoDF(dataDir) # readIntoDF() is function that return a list
# extract dataframe from list
dfVWC <- dfList$VWC
dfTEMP <- dfList$TEMP
# processing of dataframes
dfVWC <- transformDF(dfVWC)
dfTEMP <- transformDF(dfTEMP)
# prepare grid for kriging；
grd <- expand.grid(x=seq(from=0, to=600, by=200),
y=seq(from=0, to=500, by=200))
# Kriging；
dfVWCkrige <- krigingFun(dfVWC, grd)
dfTEMPKrige <- krigingFun(dfTEMP, grd)
krigeList <- list("VWCKrige" = dfVWCkrige, "TEMPKrige" = dfTEMPKrige)
return(krigeList)
}) # end of dataInput
### create cubs；
output$VWC3DPlot <- renderWebGL({
createCubes(dataInput()$VWCKrige) # createCubes() is a function that use output of kriging and shinyrgl pkg to create cubes;
})
output$TEMP3DPlot <- renderWebGL({
createCubes(dataInput()$TEMPKrige)
})
})
Since there are hundreds of lines, I could not to post all of them.
According to this post, I updated the version of shiny, but had no effect on my case.
You appear to be using shinyRGL. Don't use it, rgl has what you need. Here's an example that works for me:
ui.R:
library(shiny)
shinyUI(fluidPage(
mainPanel(
tabsetPanel(
tabPanel("red",
rglwidgetOutput('thewidget1')),
tabPanel("green",
rglwidgetOutput('thewidget2'))
))
))
server.R:
library(shiny)
library(rgl)
options(rgl.useNULL = TRUE)
shinyServer(function(input, output, session) {
x <- rnorm(100)
y <- 2*rnorm(100)
z <- 10*rnorm(100)
open3d()
plot3d(x, y, z, col = "red")
scene1 <- scene3d()
plot3d(z, y, x, col = "green")
scene2 <- scene3d()
rgl.close()
save <- options(rgl.inShiny = TRUE)
on.exit(options(save))
output$thewidget1 <- renderRglwidget(
rglwidget(scene1)
)
output$thewidget2 <- renderRglwidget(
rglwidget(scene2)
)
})
By the way, we would have got here a lot sooner if you had posted a reproducible example as requested.
I am trying to create an app using Shiny, where I want the user to be able to select the color of each line in a plot. The general idea is to import the data in the app and then plot each variable in the data. I tried to use the colorpicker 'jscolorInput' from the shinysky package, which works fine when placed in the ui.r file, but since I want my app to be dynamic for each dataset uploaded, I need to put the colorpicker in the server.R, using a reactive function.
When placed in the server, the 'jscolorInput' does not work.
What I want to do is:
Reproduce the colorpicker as many times as the number of
variables in the data
Take the input from the color and pass it
as color argument in the plot
I am very new in both shiny development and stackoverflow, so please excuse my mistakes.
Here is a reproducible example that does not work.
require(shinysky)
require(shiny)
dat <- data.frame(matrix(rnorm(120, 2, 3), ncol=3))
runApp(list(
ui = bootstrapPage(
# The reactive colorpicker
uiOutput('myPanel'),
# The plot
plotOutput('plot')
),
server = function(input, output) {
# Print as many colorpickers as the columns in the dataset
cols <- reactive({
n <- ncol(dat)
for(i in 1:n){
print(jscolorInput(paste("col", i, sep="_")))
}
})
output$myPanel <- renderPrint({cols()})
# Put all the input in a vector
colors <- reactive({
n <- ncol(dat)
lapply(1:n, function(i) {
input[[paste("col", i, sep="_")]]
})
})
output$plot <- renderPlot({
cols <- ifelse(is.null(input$col_1), rep("000000 ", n), colors())
plot(dat[,1], col= paste0("#", cols[1], ""))
for(i in 2:ncol(dat))lines(dat[,i], col=cols[i])
})
}
))
Here is a working version of what you are trying to do. Look at the differences between our code, there were a few problems with your code. Also, note that I'm not using shinysky because it doesn't have the colourpicker anymore (it's moved to a different package that's inactive), so instead I'm using the inputColour from shinyjs.
library(shiny)
library(shinyjs)
dat <- data.frame(matrix(rnorm(120, 2, 3), ncol=3))
runApp(shinyApp(
ui = fluidPage(
uiOutput('myPanel'),
plotOutput("plot")
),
server = function(input, output, session) {
cols <- reactive({
lapply(seq_along(dat), function(i) {
colourInput(paste("col", i, sep="_"), "Choose colour:", "black")
})
})
output$myPanel <- renderUI({cols()})
# Put all the input in a vector
colors <- reactive({
lapply(seq_along(dat), function(i) {
input[[paste("col", i, sep="_")]]
})
})
output$plot <- renderPlot({
if (is.null(input$col_1)) {
cols <- rep("#000000", ncol(dat))
} else {
cols <- unlist(colors())
}
plot(dat[,1], col = cols[1])
for(i in 2:ncol(dat)) lines(dat[,i], col = cols[i])
})
}
))
Disclaimer: I'm the author of shinyjs