Scatter textposition resets during animation (plotly.js bug?)

My shiny app shows text that moves when the data is changed. I noticed that sometimes the grey text to the right of the bar reverts to textposition=“middle center” during animation, where is was set at “middle right”. Bug in plotly.js?

library(shiny)
library(plotly)
library(dplyr)
library(XML)
library(RCurl)

# utility functions
"%notin%" <- function(x,y)!("%in%"(x,y))
numerify_factor <- function(f){as.numeric(as.character(f))}

# set up
ev_vars <- c("fat", "protein", "milk", "liveweight", "residual_survival",
			 "somatic_cell", "fertility", "body_condition_score")
ev_names <- c("Milk Fat", "Milk Protein", "Milk Volume", "Live Weight",
			  "Residual Survival", "Somatic Cell Count", "Fertility",
			  "Body Condition Score")
breed_order <- c("All Breeds", "Friesian", "Jersey", "Cross", "Ayrshire", "Other")

# get ev data from website (or wherever)
cat("Get EV data from website\n")
url <- "https://www.dairynz.co.nz/animal/animal-evaluation/interpreting-the-info/economic-values/"
xdata <- RCurl::getURL(url)
ev <- tibble::as_tibble(XML::readHTMLTable(xdata, header=TRUE)[[1]])
ev <- ev %>%
	magrittr::set_colnames(tolower(names(ev))) %>%
	mutate(
		ev_var = ev_vars,
		ev_name = ev_names,
		trait = as.character(trait)
	)
this_year <- as.character(year(Sys.time()))
cat("System clock says it's",  this_year, "\n")
if (this_year %notin% names(ev)){
	cat("Error: EV values not found for", this_year, "\n")
	ev[[this_year]] <- factor(c(3.49, 4.38, -0.092, -1.30, 0.112, -37.3, 5.88, 96.3))
}
ev[[this_year]] <- numerify_factor(ev[[this_year]])
ev$ev_min <- round(pmin(ev[[this_year]] * 0.5, ev[[this_year]] * 1.5), 2) # could be negative
ev$ev_max <- round(pmax(ev[[this_year]] * 0.5, ev[[this_year]] * 1.5), 2) # could be negative
ev$ev_step <- (ev$ev_max - ev$ev_min)/50 # bigger steps look better
print(ev)

# read bull data 2
cat("Get RAS data from website\n")
url <- "https://www.dairynz.co.nz/animal/animal-evaluation/ranking-of-active-sires-ras/"
xdata <- RCurl::getURL(url)
temp <- XML::readHTMLTable(xdata, header=TRUE) # read all tables
bv <- vector("list", 4)
bv_breeds <- c("F", "J", "X", "O")
bv_breeds <- c("Friesian", "Jersey", "Cross", "Other")
bv_names <- c("name", "bw_rel", ev_vars[c(2,1,3,4,7,6,5,8)])
for (i in 1:4){
	j <- c(6,11,16,21)[i]
	bv[[i]] <- tibble::as_tibble(temp[[j]]) %>%
		select(seq_along(bv_names)) %>%
		magrittr::set_colnames(bv_names) %>%
		mutate(breed=bv_breeds[i])
}
bv <- suppressWarnings(bind_rows(bv)) # converts factors to character
bv <- bv %>%
	mutate_at(ev_vars, numerify_factor) %>%
	mutate_at(bv_names[1:2], as.character)

# calculate initial BW for bv using matrix mult
ev_this_year <- ev[[this_year]]
bwm <- function(bv, ev_vars, ev_this_year){
	bvm <- as.matrix(dplyr::select(bv, one_of(ev_vars)))
	i <- match(ev_vars, colnames(bvm))
	evm <- as.numeric(as.matrix(ev_this_year[i]))
	round(bvm %*% evm, 1)
}
topn <- 10
totn <- 20
bv$f <- 1
bv$bwm <- bwm(bv, ev_vars, ev_this_year)
bv$bwr <- rank(-bv$bwm, ties.method="first")
bv$top <- (bv$bwr <= topn) # top bulls ranked on current EV
bv <- bv %>%
	dplyr::rename(bullname=name) %>%
	dplyr::filter(bwr<=100) # reduce data

# define colours
dnzwhite <- "white"
dnzdaveslate <- "#e6e6e6"
dnzgreen <- "#69BE28"
dnzblue <- "#009AA6"

#### ui ####

# https://gist.github.com/guybowden/90f42413649148df7632
sliderstyle <- gsub("#000069", dnzblue,
	".irs-single, .irs-bar-edge, .irs-bar {background: #000069; border-top: 1px solid #000039; border-bottom: 1px solid #000039;}
	.irs-from, .irs-to, .irs-single {background: #000069;}
	.irs {margin: 0px 0px;}"
)

ui <- fluidPage(

	theme = shinythemes::shinytheme("spacelab"), # kinda similar to DairyNZ and plotly
	align="center",

	# https://www.w3schools.com/css/default.asp
	fluidRow(
		column(4,
			   strong("Economic Values", style="font-size: 14px;"),
			   br(""),
			   tags$style(HTML(sliderstyle)),
			   uiOutput("sliders")
		),
		column(8,
			   align="left",
			   uiOutput("radio1"),
			   strong("Bull Rank", style="font-size: 14px"),
			   plotlyOutput("bull_plot")
		)
	)

) # fluidPage

#### server ####

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

	output$radio1  <- renderUI(radioButtons("radio",
											strong("Display:", style="font-size: 14px"),
											choices=list("Current Rank"=1, "Future Rank"=2, "Reset Sliders"=3),
											selected=2,
											inline=TRUE))
    # https://groups.google.com/forum/#!topic/shiny-discuss/xW8f5g5gm4s
	output$sliders <- renderUI({
		sliders <- vector("list", 8)
		for (i in 1:8){
			# https://www.w3schools.com/css/default.asp
			sliders[[i]] <- sliderInput(paste0("ev",i),
										strong(ev$trait[i], style="line-height: 0.0; font-size: 14px"),
										ev$ev_min[i],
										ev$ev_max[i],
										ev[[this_year]][i],
										ev$ev_step[i]
										)
		}
		return(sliders)
	})

	output$bull_plot <- renderPlotly({
		cat("renderPlotly\n")
		topten <- dplyr::filter(bv, top) %>%
			dplyr::select(bwm, bwr, bullname, breed, f) %>%
			dplyr::filter(bwr<=totn)
		others <- dplyr::filter(bv, !top) %>%
			dplyr::select(bwm, bwr, bullname, breed, f) %>%
			dplyr::filter(bwr<=totn)
		xmin <- 0
		xname <- 5
		xmax <- max(topten$bwm)*1.2
		xrange <- list(xmin, xmax)
		yrange <- list(0, topn*2+1)
		yticks <- as.list(c(0:(topn*2+1)))
		ylabels <- as.list(paste0(c("", 1:(topn*2), ""), " "))
		topten <- bind_rows(mutate(topten, bwm=xmin-20, bullname="", breed=""),
							topten,
							mutate(topten, bwm=xmin-20, bullname="", breed="")) %>%
			arrange(bwr)
		others <- bind_rows(mutate(others, bwm=xmin-20, bullname="", breed=""),
							others,
							mutate(others, bwm=xmin-20, bullname="", breed="")) %>%
			arrange(bwr)
		plot_ly(height=700) %>%
			add_trace(x=topten$bwm, y=topten$bwr, frame=topten$f, line=list(width=20, simplify=FALSE), type="scatter", opacity=1, color=I(dnzblue), mode="lines", showlegend=FALSE, hoverinfo="x") %>%
			add_trace(x=others$bwm, y=others$bwr, frame=others$f, line=list(width=20, simplify=FALSE), type="scatter", opacity=1, color=I(dnzgreen), mode="lines", showlegend=FALSE, hoverinfo="x") %>%
			add_trace(x=topten$bwm-xname, y=topten$bwr, frame=topten$f, text=paste0("<b>",topten$bullname,"</b>"), color=I(dnzwhite), textfont=list(), textposition="middle left", type="scatter", mode="text", showlegend=FALSE, hoverinfo="none") %>%
			add_trace(x=others$bwm-xname, y=others$bwr, frame=others$f, text=paste0("<b>",others$bullname,"</b>"), color=I(dnzwhite), textfont=list(), textposition="middle left", type="scatter", mode="text", showlegend=FALSE, hoverinfo="none") %>%
			add_trace(x=topten$bwm+xname, y=topten$bwr, frame=topten$f, text=paste0("<b>",topten$breed,"</b>"), color=I(dnzdaveslate), textfont=list(), textposition="middle right", type="scatter", mode="text", showlegend=FALSE, hoverinfo="none") %>%
			add_trace(x=others$bwm+xname, y=others$bwr, frame=others$f, text=paste0("<b>",others$breed,"</b>"), color=I(dnzdaveslate), textfont=list(), textposition="middle right", type="scatter", mode="text", showlegend=FALSE, hoverinfo="none") %>%
			layout(xaxis=list(range=xrange, title=list(text="<b>BW</b>"), tickprefix="$"),
				   yaxis=list(range=yrange, title=list(text="<b>Rank</b>"), autorange="reversed", dtick=1, zeroline=FALSE, ticktext=ylabels, tickmode="array", tickvals=yticks)
				   ) %>%
			animation_opts(frame=500, transition=500, redraw=FALSE)
	})

	observeEvent({
				input$ev1
				input$ev2
				input$ev3
				input$ev4
				input$ev5
				input$ev6
				input$ev7
				input$ev8
				input$radio
			},{

			cat("observed input\n")
			ev_future <- c(
				input$ev1,
				input$ev2,
				input$ev3,
				input$ev4,
				input$ev5,
				input$ev6,
				input$ev7,
				input$ev8
				)
			print(ev_future)
			cat("input$radio = ", input$radio, "\n")
			if (input$radio %in% 3){ # reset sliders
				for (i in 1:8){
					updateSliderInput(session, paste0("ev",i), value=ev[[this_year]][i])
				}
				updateRadioButtons(session, "radio", selected=2)
			}
			if (input$radio %in% c(1,3)){
				bv$f <- bv$f + 1
				bv$bwm <- bwm(bv, ev_vars, ev_this_year)
				bv$bwr <- rank(-bv$bwm, ties.method="first")
			} else {
				bv$f <- bv$f + 1
				bv$bwm <- bwm(bv, ev_vars, ev_future)
				bv$bwr <- rank(-bv$bwm, ties.method="first")
			}

		cat("update data\n")
		topten <- dplyr::filter(bv, top) %>%
			dplyr::select(bwm, bwr, bullname, breed, f) %>%
			dplyr::filter(bwr<=totn)
		others <- dplyr::filter(bv, !top) %>%
			dplyr::select(bwm, bwr, bullname, breed, f) %>%
			dplyr::filter(bwr<=totn)
		xmin <- 0
		xname <- 5
		xmax <- max(topten$bwm)*1.2
		xrange <- list(xmin, xmax)
		yrange <- list(1, topn*2)
		topten <- bind_rows(mutate(topten, bwm=xmin-20, bullname="", breed=""),
							topten,
							mutate(topten, bwm=xmin-20, bullname="", breed="")) %>%
			arrange(bwr)
		others <- bind_rows(mutate(others, bwm=xmin-20, bullname="", breed=""),
							others,
							mutate(others, bwm=xmin-20, bullname="", breed="")) %>%
			arrange(bwr)

		# https://plot.ly/javascript/plotlyjs-function-reference/#plotlyanimate
		cat("update bull_plot\n")
		# add_trace(x=topten$bwm, y=topten$bwr, frame=topten$f, line=list(width=20, simplify=FALSE), type="scatter", opacity=1, color=I(dnzred), mode="lines", name=paste("Top", topn)) %>%
		# 	add_trace(x=others$bwm, y=others$bwr, frame=others$f, line=list(width=20, simplify=FALSE), type="scatter", opacity=1, color=I(dnzblue), mode="lines", name="Others") %>%
		# 	add_trace(x=topten$bwm-xname, y=topten$bwr, frame=topten$f, text=paste0("<b>",topten$bullname,"</b>"), color=I(dnzwhite), textfont=list(), textposition="middle left", type="scatter", mode="text", showlegend=FALSE) %>%
		# 	add_trace(x=others$bwm-xname, y=others$bwr, frame=others$f, text=paste0("<b>",others$bullname,"</b>"), color=I(dnzwhite), textfont=list(), textposition="middle left", type="scatter", mode="text", showlegend=FALSE) %>%
		plotlyProxy("bull_plot", session=session, deferUntilFlush=FALSE) %>%
			plotlyProxyInvoke("animate",
							  # frameOrGroupNameOrFrameList
							  list(
							  	data = list( # new data for each traces in the original plot
							  		list(x = topten$bwm, y = topten$bwr, frame = topten$f),
							  		list(x = others$bwm, y = others$bwr, frame = others$f),
							  		list(x = topten$bwm-xname, y = topten$bwr, text = paste0("<b>",topten$bullname,"</b>"), frame = topten$f),
							  		list(x = others$bwm-xname, y = others$bwr, text = paste0("<b>",others$bullname,"</b>"), frame = others$f),
							  		list(x = topten$bwm+xname, y = topten$bwr, text = paste0("<b>",topten$breed,"</b>"), frame = topten$f),
							  		list(x = others$bwm+xname, y = others$bwr, text = paste0("<b>",others$breed,"</b>"), frame = others$f)
							  	),
							  	traces = list( # trace numbers starting at 0
							  		as.integer(0),
							  		as.integer(1),
							  		as.integer(2),
							  		as.integer(3),
							  		as.integer(4),
							  		as.integer(5)
							  		),
							  	layout = list()
							  ),
  						  	  # animationAttributes
		                      list()
							  )# plotlyProxyInvoke
	})

} # server

shinyApp(ui, server)


Ok, I figured this out. The problem was new text items entering the plot didn’t inherit the textposition aesthetic set in the original plot. So I had to specify it again when I provided a new frame. Not a bug.