I have an reactive ggvis scatterplot (layer_points) in shiny.
Now i want to add an horizontal line and vertical line in the plot to resemble the median of the x/y axis.
i know how to calculate it, but not how to display it in same plot.
my code so far:
vis <- reactive({
# Lables for axes
xvar_name <- names(axis_vars)[axis_vars == input$xvar]
yvar_name <- names(axis_vars)[axis_vars == input$yvar]
xvar <- prop("x", as.symbol(input$xvar))
yvar <- prop("y", as.symbol(input$yvar))
gegevens %>%
ggvis(x = xvar, y = yvar) %>%
layer_points(size := 50, size.hover := 200,
fillOpacity := 0.2, fillOpacity.hover := 0.5,
stroke = ~bron, key := ~Project.ID) %>%
add_tooltip(gegevens_tooltip, "hover") %>%
add_axis("x", title = xvar_name, format='d', grid = FALSE) %>%
add_axis("y", title = yvar_name, format='d', grid = FALSE) %>%
add_legend("stroke", title = "Gegevens van:", values = c("A", "B")) %>%
scale_numeric("x", trans = "log", expand=0) %>%
scale_numeric("y", trans = "log", expand=0) %>%
scale_nominal("stroke", domain = c("A", "B"),
range = c("blue", "#aaa")) %>%
set_options(width = 600, height = 600)
})
vis %>% bind_shiny("plot1")
to calculate the median i use:
output$defects <- renderText ({
d <- median(gegevens()$Total.Defects.Delivered)
paste("de mediaan voor totaal aantal Defects is:", d)
})
Lots of thanks for helping.
Seems i misunderstood your example, but i got it working, just after i posted i couldn't. Well here is the solution:
vis <- reactive({
# Lables for axes
xvar_name <- names(axis_vars)[axis_vars == input$xvar]
yvar_name <- names(axis_vars)[axis_vars == input$yvar]
xvar <- prop("x", as.symbol(input$xvar))
yvar <- prop("y", as.symbol(input$yvar))
gegevens %>%
ggvis(x = xvar, y = yvar) %>%
layer_points(size := 50, size.hover := 200,
fillOpacity := 0.2, fillOpacity.hover := 0.5,
stroke = ~bron, key := ~Project.ID) %>%
add_tooltip(gegevens_tooltip, "hover") %>%
add_axis("x", title = xvar_name, format='d', grid = FALSE, properties = axis_props(labels = list(angle = 90, align = "left"))) %>%
add_axis("y", title = yvar_name, format='d', grid = FALSE) %>%
add_legend("stroke", title = "Gegevens van:", values = c("A", "B")) %>%
scale_numeric("x", trans = "log", expand=0) %>%
scale_numeric("y", trans = "log", expand=0) %>%
scale_nominal("stroke", domain = c("A", "B"),
range = c("blue", "#aaa")) %>%
set_options(width = 600, height = 600) %>%
layer_paths(data = gegevens, x = median(gegevens()$kolomname.i.want.the.median.from)), y = yvar ) %>%
layer_paths(data = gegevens, x = xvar, y = median(gegevens()$kolomname.i.want.the.median.from))
})
this gives me an cross in my plot by calculating the median of x and y, even if the user changes the original input. of course i need to find out how to get "kolomname.i.want.the.median.from" to be the x-/ or y-value.
but i now know how to get the lines in, and that was the question.
So thank you aosmith for the right direction.
Related
I must design a graph that accumulates variables as they are added in Shiny R using plotly.
For example, if I graph the variable x with respect to the date t with a select input, I add the variable and it is located on the right side of the variable x, indicating with a separator that it is the variable y and so with as many variables are selected.
This is my code:
library(shiny)
library(plotly)
library(dplyr)
set.seed(123)
df <- data.frame(x = seq.Date(as.Date("2000/1/1"), by = "month", length.out = 100),
cat = sample(c("m1","m2","m3"),100, replace = TRUE),
a = cumsum(rnorm(100)),
b = rnorm(100),
c = rnorm(100),
d = rnorm(100))
ui <- fluidPage(
selectInput("x","Variable",names(df)[-1],NULL,TRUE),
selectInput("y", "category", unique(df$cat), NULL, TRUE),
numericInput("ls","limite superior",NULL,-100,100),
numericInput("li","limite superior",NULL,-100,100),
plotlyOutput("plot1")
)
server <- function(input, output, session) {
output$plot1 <- renderPlotly({
req(input$y, input$x)
df <- df%>%
filter(cat %in% input$y)%>%
select(one_of("x",input$x))
estado <- ifelse(df[[2]]>input$ls,"red",
ifelse(df[[2]]<input$ls & df[[2]]>input$li,
"orange","green"))
df$estado <- estado
p <- plot_ly(df,
x = ~x,
y = ~df[[2]],
type = "scatter",
mode = "lines")
## Makers
p <- p %>%
add_trace(x = ~x,
y= df[[2]],
marker = list(color = ~estado, size = 20, symbol = "square"),
showlegend = FALSE)
## Lengends and labels
p <- p %>%
layout(legend = list(orientation = 'h'))%>%
layout(title = paste('Comportamiento de calidad de agua residual', input$estacion, sep=' '),
plot_bgcolor = "#e5ecf6",
xaxis = list(title = 'Fecha'),
yaxis = list(title = paste(input$x,"mg/l", sep=" ")))
print(p)
})
}
shinyApp(ui, server)
I need that when adding the variables a, b, c, d, the graph will be made just after the variable that was already there so that it looks something like this:
Use subplot and do function.
df %>%
group_by(category) %>%
do(p = plot_ly(...) %>% (plot_features...)) %>%
subplot(sharex= FALSE,sharey=TRUE, nrow=1, margin = 0.0001)
With plot feautures i mean all the deatils of the plot (markers, lines, colors, etc)
How can I create a grouped bar chart in plotly that has a dropdown (or something else), so a viewer can select the grouping variable?
Working example:
library(dplyr)
library(plotly)
library(reshape2)
iris$Sepal.L <- iris$Sepal.Length %>%
cut(breaks = c(4,5,7,8),
labels = c("Length.a","Length.b","Length.c"))
iris$Sepal.W <- iris$Sepal.Width %>%
cut(breaks = c(1,3,5),
labels = c("Width.a","Width.b"))
# Get percentages
data1 <- table(iris$Species, iris$Sepal.L) %>%
prop.table(margin = 1)
data2 <- table(iris$Species, iris$Sepal.W) %>%
prop.table(margin = 1)
# Convert to df
data1 <- data.frame(Var1=row.names(data1), cbind(data1))
row.names(data1) <- NULL
data2 <- data.frame(Var1=row.names(data2), cbind(data2))
row.names(data2) <- NULL
plot_ly(
data = data1,
name = "Length.a",
x = ~Var1, y = ~Length.a,
type = "bar") %>%
add_trace(y=~Length.b, name = "Length.b") %>%
add_trace(y=~Length.c, name = "Length.c")
plot_ly(
data = data2,
name = "Width.a",
x = ~Var1, y = ~Width.a,
type = "bar") %>%
add_trace(y=~Width.b, name = "Width.b")
For example if I would like to select between viewing a plot with table(iris$Species, iris$Sepal.Length) and a plot with table(iris$Species, iris$Sepal.Width)
Bonus:
If it's easy; being able to interactively select the x variable as well would be cool, but not necessary.
You can find a solution here.
The idea is to plot your bar charts (with data1 and data2) all together and to make visible only one at a time.
items <- list(
list(label="Var1",
args=list(list(visible=c(T,T,T,F,F)))),
list(label="Var2",
args=list(list(visible=c(F,F,F,T,T))))
)
plot_ly(data=data1) %>%
add_bars(name = "Length.a",
x = ~Var1, y = ~Length.a, visible=T) %>%
add_bars(name = "Length.b",
x = ~Var1, y = ~Length.b, visible=T) %>%
add_bars(name = "Length.c",
x = ~Var1, y = ~Length.c, visible=T) %>%
add_bars(name = "Width.a",
x = ~Var1, y = ~Width.a, visible=F, data=data2, marker=list(color="#377EB8")) %>%
add_bars(name = "Width.b",
x = ~Var1, y = ~Width.b, visible=F, data=data2, marker=list(color="#FF7F00")) %>%
layout(
title = "Bar chart with drop down menu",
xaxis = list(title="x"),
yaxis = list(title = "y"),
showlegend = T,
updatemenus = list(
list(y = 0.9,
buttons = items)
))
This is a simple example of my data:
df1 <- structure(
list(
X = c(1250, 2500, 3750, 5000, 6250, 7500, 8750,
10000), Y = c(
0.112151039933887, 0.0792717402389768, 0.064716676038453,
0.0560426379617912, 0.0501241024200681, 0.0457556453076907, 0.0423607088430516,
0.0396242625334144
)
), .Names = c("X", "Y"), row.names = c(NA,-8L), class = "data.frame"
)
I want to create a smooth line with a tooltip that shows the values X and Y. This is what I'm doing right now
library(ggvis)
library(dplyr)
all_values <- function(x)
{
if(is.null(x)) return(NULL)
row <- smoothed[smoothed$id == x$id, ]
paste0(names(row), ": ", format(row), collapse = "<br />")
}
smoothed <- df1 %>% compute_smooth(Y ~ X) %>% rename(X=pred_ , Y=resp_)
smoothed$id <- 1:nrow(smoothed)
smoothed %>% ggvis(~X, ~Y, key:= ~id, stroke := "red", strokeWidth := 5) %>% layer_paths() %>%
add_tooltip(all_values, "hover")
The tooltip is always showing the same values.
I'm generating a graph with ggvis and the legends are in top of each-other.
library(ggvis)
df1 <- data.frame(x=c(0.6,1,1.4), y=c(-2, -.8, -0.2), number=c(10,8,6),
type=c('A', 'A', 'B'))
df1 %>% ggvis(x = ~x, y = ~y) %>%
layer_points(shape=~type, fill=~number)
How can I fix this?
Thanks!
Steven's solution works for the simple example but It does not work when you add a tooltip:
library(ggvis)
df1 <- data.frame(x=c(0.6,1,1.4), y=c(-2, -.8, -0.2), number=c(10,8,6),
type=c('A', 'A', 'B'), id=c(1:3))
tooltip <- function(x) {
if(is.null(x)) return(NULL)
row <- df1[df1$id == x$id, ]
paste0(names(row), ": ", format(row), collapse = "<br />")
}
df1 %>% ggvis(x = ~x, y = ~y) %>%
layer_points(shape=~type, fill=~number, key := ~id) %>%
add_tooltip(tooltip, "hover") %>%
add_legend("shape", properties = legend_props(legend = list(y = 50)))
Try:
df1 %>% ggvis(x = ~x, y = ~y) %>%
layer_points(shape=~type, fill=~number) %>%
add_legend("shape", properties = legend_props(legend = list(y = 50)))
Edit:
As mentionned by #aosmith, you could use the set_options() workaround:
df1 %>% ggvis(x = ~x, y = ~y) %>%
layer_points(shape=~type, fill=~number, key := ~id) %>%
add_tooltip(tooltip, "hover") %>%
add_legend("shape", properties = legend_props(legend = list(y = 50))) %>%
set_options(duration = 0)
I am having problem with the following example ggvis code which is meant to make a plot that highlights an entire group of points when you hover over any member of that group. I would then like the highlighting to vanish as soon as you hover off. What is happening is that the highlighting initially works but then when you hover off, the highlighting stays, and only vanishes when you hover over another set of points and then hover off them again.
library(magrittr)
library(dplyr)
library(ggvis)
library(shiny)
dat <- iris %>% select(-Species) %>% dist %>% cmdscale %>% data.frame %>% tbl_df %>% mutate(Species = iris$Species) %>%
data.frame
Props <- reactiveValues(Size = rep(50, length.out = nrow(dat)), Stroke = rep("white", length.out = nrow(dat)))
hoveron <- function(data, ...) {
Props$Size[dat$Species == data$Species] <- 150
print("hoveron!")
Props$Stroke[dat$Species == data$Species] <- "black"
}
hoveroff <- function(...) {
Props$Size <- rep(50, length.out = nrow(dat))
print("hoveroff!")
Props$Stroke <- rep("white", length.out = nrow(dat))
}
dat %>%
ggvis(~X1, ~X2, fill = ~Species) %>% layer_points(size = reactive(Props$Size), stroke = reactive(Props$Stroke)) %>%
scale_numeric("size", range = c(80, 180)) %>% scale_numeric("x", label = "MDS Axis 1") %>%
scale_numeric("y", label = "MDS Axis 2") %>% scale_ordinal("stroke", sort = TRUE, domain = c("black", "white"), range = c("black", "white")) %>%
add_legend(scales = "size", properties = legend_props(title = list(fontSize = 0), labels = list(fontSize = 0), symbols = list(size = 0))) %>%
add_legend(scales = "stroke", properties = legend_props(title = list(fontSize = 0), labels = list(fontSize = 0), symbols = list(size = 0))) %>%
set_options(duration = 0) %>% handle_hover(hoveron, hoveroff)
You can view the results as a shinyapp here: https://ecologician.shinyapps.io/ggvis_grouping_wrong/. Note: The print statements are for debugging. hoveroff seems to fire when you mover off the first set of points but then hoveron fires immediately afterwards, with data$Species equal to what was just hovered off. I can't quite explain why. I am hoping it is just a simple mistake which I just can't see at the moment. Can anyone here see what is wrong?
More Details:
The above code was an attempt to make a less verbose / simpler version of the code below, which does work as I expect it to:
library(magrittr)
library(dplyr)
library(ggvis)
library(shiny)
hoverset <- reactiveValues(setosa = 0, versicolor = 0, virginica = 0)
hoveron <- function(data, ...) {
hoverset[[data$Species]] <- 1
}
hoveroff <- function(data, ...) {
hoverset$setosa <- 0
hoverset$versicolor <- 0
hoverset$virginica <- 0
}
dat <- iris %>% select(-Species) %>% dist %>% cmdscale %>% data.frame %>% tbl_df %>% mutate(Species = iris$Species) %>%
mutate(Size = 50, Stroke = "white") %>% data.frame
dat2 <- reactive({
if (hoverset$setosa == 1){
dat[dat[,"Species"] == "setosa","Size"] <<- 150
dat[dat[,"Species"] == "setosa","Stroke"] <<- "black"
} else {
dat[dat[,"Species"] == "setosa","Size"] <<- 50
dat[dat[,"Species"] == "setosa","Stroke"] <<- "white"
}
if (hoverset$versicolor == 1){
dat[dat[,"Species"] == "versicolor","Size"] <<- 150
dat[dat[,"Species"] == "versicolor","Stroke"] <<- "black"
} else {
dat[dat[,"Species"] == "versicolor","Size"] <<- 50
dat[dat[,"Species"] == "versicolor","Stroke"] <<- "white"
}
if (hoverset$virginica == 1){
dat[dat[,"Species"] == "virginica","Size"] <<- 150
dat[dat[,"Species"] == "virginica","Stroke"] <<- "black"
} else {
dat[dat[,"Species"] == "virginica","Size"] <<- 50
dat[dat[,"Species"] == "virginica","Stroke"] <<- "white"
}
dat
})
dat2 %>%
ggvis(~X1, ~X2, fill = ~Species) %>% layer_points(size = ~Size, stroke = ~Stroke) %>%
scale_numeric("size", range = c(80, 180)) %>% scale_numeric("x", label = "MDS Axis 1") %>%
scale_numeric("y", label = "MDS Axis 2") %>% scale_ordinal("stroke", sort = TRUE, domain = c("black", "white"), range = c("black", "white")) %>%
add_legend(scales = "size", properties = legend_props(title = list(fontSize = 0), labels = list(fontSize = 0), symbols = list(size = 0))) %>%
add_legend(scales = "stroke", properties = legend_props(title = list(fontSize = 0), labels = list(fontSize = 0), symbols = list(size = 0))) %>%
set_options(duration = 0) %>% handle_hover(hoveron, hoveroff)
See this app here: https://ecologician.shinyapps.io/ggvis_grouping/
Thanks!