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.
Related
I have several series which I would like to animate with plotly R. After following the example here (https://plot.ly/r/cumulative-animations/), I have the animation working. I figured out how to change the colors for the groups, however, I need specific colors for the groups (RGB custom colors).
I have two questions:
How do I assign RGB colors to groups in R Plotly...what am I missing here?
Is there an easier way to do this? I have several more "cities" than just two, and want to be able to dynamically assign the specific color. I was able to pull the colors in as a column in the data frame, and would like to be able to assign them that way...got it working for the regular colors, but need to get it for the RGB...
library(plotly)
# Helper function to create frames
accumulate_by <- function(dat, var) {
var <- lazyeval::f_eval(var, dat)
lvls <- plotly:::getLevels(var)
dats <- lapply(seq_along(lvls), function(x) {
cbind(dat[var %in% lvls[seq(1, x)], ], frame = lvls[[x]])
})
dplyr::bind_rows(dats)
}
# Pull in data and also create color columns
d <-
txhousing %>%
filter(year > 2005, city %in% c("Abilene", "Bay Area")) %>%
accumulate_by(~date) %>%
mutate(regular_color = if_else(city == "Abilene", 'red', 'black'),
RGB_color = if_else(city == "Abilene", 'rgb(229,18,18)', 'rgb(13,9,9)'))
# color vectors
reg_color_vector <-
d %>%
arrange(city) %>%
select(regular_color) %>%
distinct() %>%
pull()
RGB_color_vector <-
d %>%
arrange(city) %>%
select(RGB_color) %>%
distinct() %>%
pull()
p <- d %>%
plot_ly(
x = ~date,
y = ~median,
split = ~city,
frame = ~frame,
type = 'scatter',
mode = 'lines',
line = list(simplyfy = F),
color = ~city,
# colors = c('red', 'black')
colors = c('rgb(229, 18, 18)', 'rgb(13, 9, 9)')
# colors = reg_color_vector
# colors = RGB_color_vector
) %>%
layout(
xaxis = list(
title = "Date",
zeroline = F
),
yaxis = list(
title = "Median",
zeroline = F
)
) %>%
animation_opts(
frame = 100,
transition = 0,
redraw = FALSE
) %>%
animation_slider(
hide = T
) %>%
animation_button(
x = 1, xanchor = "right", y = 0, yanchor = "bottom"
)
p
rgb() is a function which outputs a hexadecimal value of the color you want. That is what you need to store. Remove the ' and it should be fine. And you need to add maxColorValue = 255 to the rgb() function.
d <-
txhousing %>%
filter(year > 2005, city %in% c("Abilene", "Bay Area")) %>%
accumulate_by(~date) %>%
mutate(regular_color = if_else(city == "Abilene", 'red', 'black'),
RGB_color = if_else(city == "Abilene",
rgb(229, 18, 18, maxColorValue = 255),
rgb(13, 9, 9, maxColorValue = 255)))
You can use in plot_ly than the RGB_color_vector to define the colors.
plot_ly(
x = ~date,
y = ~median,
split = ~city,
frame = ~frame,
type = 'scatter',
mode = 'lines',
line = list(simplyfy = F),
color = ~city,
colors = RGB_color_vector
)
I am trying to animate this test data.frame but the plotly plot doesn't even show up! The same code works for original plotly data though. I have doublechecked column's class and they are the same as plotly example. I am now puzzled why this fails.
This also works in marker mode but not in lines mode as you see.
total <- data.frame(replicate(4,sample(0:1, 100, rep=TRUE)))
names(total) <- c("date", "frame", "P1.10", "year")
total$date <- as.numeric(as.character(t(rbind(runif(100, min=2000, max=2010)))))
f.rank <- order(total$date)
total$frame[f.rank] <- 1:nrow(total)
total$P1.10 <- as.numeric(as.character(t(rbind(runif(100, min=1, max=10)))))
total$year <- 2000
p <- total %>%
plot_ly(
x = ~date,
y = ~P1.10,
frame = ~frame,
type = 'scatter',
mode = 'lines',
line = list(simplyfy = F)
) %>%
layout(
xaxis = list(
title = "Date",
zeroline = F
),
yaxis = list(
title = "P1.10",
zeroline = F
)
) %>%
animation_opts(
frame = 100,
transition = 0,
redraw = FALSE
) %>%
animation_slider(
hide = T
) %>%
animation_button(
x = 1, xanchor = "right", y = 0, yanchor = "bottom"
)
You have ignored accumulate_by in the example. You also need an ID field. This is the same but using ggplot in combination.
set.seed(123)
library(plotly)
total <- data.frame(replicate(4,sample(0:1, 100, rep=TRUE)))
names(total) <- c("date", "frame", "P1.10", "year")
total$date <- as.numeric(as.character(t(rbind(runif(100, min=2000, max=2010)))))
f.rank <- order(total$date)
total$frame[f.rank] <- 1:nrow(total)
total$ID[f.rank] <- 1:nrow(total)
total$P1.10 <- as.numeric(as.character(t(rbind(runif(100, min=1, max=10)))))
total$year <- 2000
accumulate_by <- function(dat, var) {
var <- lazyeval::f_eval(var, dat)
lvls <- plotly:::getLevels(var)
dats <- lapply(seq_along(lvls), function(x) {
cbind(dat[var %in% lvls[seq(1, x)], ], frame = lvls[[x]])
})
dplyr::bind_rows(dats)
}
total <- total %>%
accumulate_by(~ID)
p <- ggplot(total,aes(ID, P1.10, frame = frame)) +
geom_line()
p <- ggplotly(p) %>%
layout(
title = "",
yaxis = list(
title = "P1.10",
zeroline = F,
tickprefix = "$"
),
xaxis = list(
title = "Date",
zeroline = F,
showgrid = F
)
) %>%
animation_opts(
frame = 100,
transition = 0,
redraw = FALSE
) %>%
animation_slider(
currentvalue = list(
prefix = "Day "
)
)
The code output is a plot that I would like it be responsive, to adjust according to window dimension.
Using just ggplot gives me the result desired but I want to use the interactive tooltip of plotly, but when I do the figure is not responsive.
Is there any fix that it could work ? The code is bellow. I really appreciate any help !
library(dplyr)
library(ggplot2)
library(lubridate)
library(plotly)
df <- data.frame(matrix(c("2017-09-04","2017-09-05","2017-09-06","2017-09-07","2017-09-08",103,104,105,106,107,17356,18022,17000,20100,15230),ncol = 3, nrow = 5))
colnames(df) <- c("DATE","ORDER_ID","SALES")
df$DATE <- as.Date(df$DATE, format = "%Y-%m-%d")
df$SALES <- as.numeric(as.character(df$SALES))
df$ORDER_ID <- as.numeric(as.character(df$ORDER_ID))
TOTALSALES <- df %>% select(ORDER_ID,DATE,SALES) %>% mutate(weekday = wday(DATE, label=TRUE)) %>% mutate(DATE=as.Date(DATE)) %>% filter(!wday(DATE) %in% c(1, 7) & !(DATE %in% as.Date(c('2017-01-02','2017-02-27','2017-02-28','2017-04-14'))) ) %>% group_by(day=floor_date(DATE,"day")) %>% summarise(sales=sum(SALES)) %>% data.frame()
TOTALSALES <- ggplot(TOTALSALES ,aes(x=day,y=sales,text=paste('Vendas (R$):', format(sales,digits=9, decimal.mark=",",nsmall=2,big.mark = "."),'<br>Data: ',format(day,"%d/%m/%Y"))))+ geom_point(colour = "black", size = 1)+stat_smooth() +labs(title='TOTAL SALES',x='dias',y='valor')+ scale_x_date(date_minor_breaks = "1 week")
m <- list(
l = 120,
r = 2,
b = 2,
t = 50,
pad = 4
)
TOTALSALES <- ggplotly(TOTALSALES,tooltip = c("text")) %>% config(displayModeBar = F) %>% layout(autosize = F, width = 1000, height = 500, margin = m,xaxis = list(
zeroline = F
),
yaxis = list(
hoverformat = '.2f'
))
TOTALSALES
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.
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)