Axis range resetting after plotly animation in shiny using plotlyProxyInvoke

shiny
1

I have an animated plot where data changes should trigger changes in the axis scaling and trace colouring. How do I get these things to occur in a smooth sequence? I want the bars to move, then the axis to change, then the color to change, without having any user intervention. A manual version of what I want is below. When I put all the proxy calls together I lose all the animations. Thanks.

library(shiny)
library(plotly)
library(dplyr)

ui <- fluidPage(
	actionButton("move", "Click to animate"),
	actionButton("stretch", "Click to rescale"),
	actionButton("recolour", "Click to recolour"),
	plotlyOutput("plot")
)

gendata <- function(){
	ndata <- 10
	d <- tibble(text=LETTERS[1:ndata], f=1, x=runif(ndata)) %>% mutate(r = rank(x))
	rbind(mutate(d, x=-1), d, mutate(d, x=-1)) %>%
		arrange(text)
}

server <- function(input, output, session){

	origdata <- gendata()
	if (FALSE){ # for offline testing
		print(head(origdata))
		my <- list(olddata = origdata, newdata = origdata)
	}

	my <- reactiveValues(
		olddata = origdata,
		newdata = origdata,
		xrange = list(0,1.1)
		)

	output$plot <- renderPlotly({
		cat("renderPlotly\n")
		plot_ly() %>%
			add_trace(x=origdata$x, y=origdata$r, frame=origdata$f, line=list(width=20, simplify=FALSE), type="scatter", opacity=0.3, color=I("green"), mode="lines", name="Rank") %>%
			add_trace(x=origdata$x + 0.02, y=origdata$r, frame=origdata$f, text=origdata$text, type="scatter", mode="text", showlegend=FALSE) %>%
			layout(xaxis=list(range=isolate(my$xrange))) %>%
			animation_opts(frame=500, transition=500, redraw=FALSE)
	})

	proxy <- plotlyProxy("plot", session=session, deferUntilFlush=FALSE)

	observeEvent(input$move, {
		req(my$newdata)
		cat("observeEvent input$move\n")
		my$olddata <- my$newdata # save old data
		my$newdata <- gendata() %>% # generate new data
			mutate(f=my$olddata$f+1)
		my$xrange <- list(-runif(1)*0.1, 1+runif(1)*0.1) # new range also
		print(head(my$newdata))
		# https://plot.ly/javascript/plotlyjs-function-reference/#plotlyanimate
		plotlyProxyInvoke(proxy, "animate",
						  # frameOrGroupNameOrFrameList
						  list(
						  	data = list(list(
										  	x = my$newdata$x,
										  	y = my$newdata$r,
										  	frame = my$newdata$f
							  	        ),
						  				list(
							  			 	x = my$newdata$x + 0.02,
							  			 	y = my$newdata$r,
							  			 	text = my$newdata$text,
							  			 	frame = my$newdata$f
						  			 )),
						  	traces = list(as.integer(0), as.integer(1)),
						  	layout = list()
						  ),
  					  	  # animationAttributes
	                      list()
						  )# plotlyProxyInvoke
	})

	observeEvent(input$stretch, {
		plotlyProxyInvoke(proxy, "relayout",
						  # update
						  list(
						  	xaxis=list(range=my$xrange)
						  )
		)
	})

	observeEvent(input$recolour, {
		plotlyProxyInvoke(proxy, "restyle",
						  # update
						  list(
					  		line=list(width=20, simplify=FALSE, color=sample(c(I("red"), I("green"), I("blue")), 1))
 					  	  ),
						  # tradeIndices
						  list(as.numeric(0))
		)
	})

}

shinyApp(ui, server)
2

I made some progress. I was surprised that plotly can animate the colours and the axis range! But not at the same time. I still have a problem that the axis range is resetting after each time I rescale it. How do I fix this?

library(shiny)
library(plotly)
library(dplyr)

ui <- fluidPage(
	plotlyOutput("plot")
)

gendata <- function(){
	cat("gendata\n")
	ndata <- 10
	d <- tibble(text=LETTERS[1:ndata], f=1, x=runif(ndata)) %>% mutate(r = rank(x))
	rbind(mutate(d, x=-1), d, mutate(d, x=-1)) %>%
		arrange(text)
}

server <- function(input, output, session){

	origdata <- gendata()

	axrange <- function(x){
		list(-0.1*runif(1), 1+0.1*runif(1))
	}

	my <- reactiveValues(
		data = origdata,
		xrange = list(0,1)
		)

	output$plot <- renderPlotly({
		isolate({
			cat("renderPlotly\n")
			plot_ly() %>%
				add_trace(x=my$data$x, y=my$data$r, frame=my$data$f, line=list(width=20, simplify=FALSE), opacity=0.3, color=I("orange"), type="scatter", mode="lines", name="Rank") %>%
				add_trace(x=my$data$x + 0.02, y=my$data$r, frame=my$data$f, text=my$data$text, type="scatter", mode="text", showlegend=FALSE) %>%
				layout(xaxis=list(range=my$xrange, autorange=FALSE)) %>%
				animation_opts(frame=500, transition=500, redraw=FALSE)
		})
	})

	proxy <- plotlyProxy("plot", session=session, deferUntilFlush=FALSE)

	# https://shiny.rstudio.com/reference/shiny/0.14/reactiveTimer.html
	speed = 1000 # redraw every 1 second
	autoInvalidate <- reactiveTimer(speed)
	observe({
		autoInvalidate()
	})

	observeEvent(autoInvalidate(), {
		# req(NULL)
		cat("observeEvent autoInvalidate()\n")
		my$data <- gendata() %>% mutate(f = my$data$f + 1)
		# print(head(my$data))
		# https://plot.ly/javascript/plotlyjs-function-reference/#plotlyanimate
		data <- list(list(
			x = my$data$x,
			y = my$data$r,
			line=list(width=20, simplify=FALSE, color=sample(c(I("red"), I("green"), I("blue")), 1)),
			frame = my$data$f
		),
		list(
			x = my$data$x + 0.02,
			y = my$data$r,
			text = my$data$text,
			frame = my$data$f
		))
		cat("animate scatter\n")
		plotlyProxyInvoke(proxy, "animate",
						  # frameOrGroupNameOrFrameList
						  list(
						  	data = data,
						  	traces = as.list(as.integer(0:1)),
						  	layout = list(xaxis=list(autorange=FALSE))
						  ),
						  # animationAttributes
						  list(
						  	frame=as.list(rep(list(duration=speed), length(0:1))),
						  	transition=as.list(rep(list(duration=speed), length(0:1)))
						  )
		)# plotlyProxyInvoke
		my$data$f <- my$data$f + 1
		my$xrange <- axrange(my$data$x)
		data <- list(list(
			frame = my$data$f
		),
		list(
			frame = my$data$f
		))
		cat("animate axis\n")
		plotlyProxyInvoke(proxy, "animate",
						  # frameOrGroupNameOrFrameList
						  list(
						  	data = data,
						  	traces = as.list(as.integer(0:1)),
						  	layout = list(xaxis=list(range=my$xrange))
						  ),
						  # animationAttributes
						  list(
						  	frame=as.list(rep(list(duration=speed), length(0:1))),
						  	transition=as.list(rep(list(duration=speed), length(0:1)))
						  )
		)# plotlyProxyInvoke

	}) # observeEvent

}

shinyApp(ui, server)
3

This topic was automatically closed 54 days after the last reply. New replies are no longer allowed.