Plotly and ggplot with facet_grid in R: How to to get yaxis labels to use ticktext value instead of range value?

前端 未结 2 1967
予麋鹿
予麋鹿 2021-01-20 08:32

I would like to use ggplot2 facets with plotly but am running into issues with the y-axis labels showing the yaxis range values instead of the ticktext. Is there something I

2条回答
  •  清酒与你
    2021-01-20 08:51

    This looks like some weird artifact from the ggplot to Plotly conversion. Anyways, all what you need to do is to add an empty string to ticktext and expand tickvals by 1.

    for (i in 2:22) {
      tick_l <- length(p[['x']][['layout']][[paste('yaxis', i, sep='')]][['ticktext']]) + 1
      p[['x']][['layout']][[paste('yaxis', i, sep='')]][['tickvals']] <- seq(1, tick_l)
      p[['x']][['layout']][[paste('yaxis', i, sep='')]][['ticktext']][[tick_l]] <- ''
    }
    

    The first yaxis layout is identical to the rest but does not need fixing since it already already correctly shown.



    Fixing the whole plot needs some more tweaking. I tried to make as generic as possible but probably the conversion will break something different for each plot.

    library(plotly)
    library(ggplot2)
    library(data.table)
    library(datasets)    
    
    #add fake model for use in facet
    dt<-data.table(mtcars)
    dt[,car.id:=rownames(mtcars)]
    dt[,model:=substr(car.id,1,regexpr(" ",car.id)-1)][model=="",model:=car.id]
    
    #Optional toggle: pick a few models and issue seems to go away 
    #Use data=dt[model %in% c("Mazda","Merc","Toyota","Honda","Hornet")]
    ggplot.test<-ggplot(dt,aes(mpg,car.id))+geom_point()+facet_grid(model~.,scales="free_y",space="free",drop=TRUE)
    
    p <- ggplotly(ggplot.test)
    len <- length(unique(dt$model))
    
    total <- 1
    for (i in 2:len) {
      total <- total + length(p[['x']][['layout']][[paste('yaxis', i, sep='')]][['ticktext']])
    }
    
    spacer <- 0.01 #space between the horizontal plots
    total_length = total + len * spacer
    end <- 1
    start <- 1
    
    for (i in c('', seq(2, len))) {
      tick_l <- length(p[['x']][['layout']][[paste('yaxis', i, sep='')]][['ticktext']]) + 1
    
      #fix the y-axis
      p[['x']][['layout']][[paste('yaxis', i, sep='')]][['tickvals']] <- seq(1, tick_l)
      p[['x']][['layout']][[paste('yaxis', i, sep='')]][['ticktext']][[tick_l]] <- ''
    
      end <- start - spacer
      start <- start - (tick_l - 1) / total_length
      v <- c(start, end)
      #fix the size
      p[['x']][['layout']][[paste('yaxis', i, sep='')]]$domain <- v
    }
    
    #fix the first entry which has a different name than the rest
    p[['x']][['layout']][['annotations']][[3]][['y']] <- (p[['x']][['layout']][['yaxis']]$domain[2] + p[['x']][['layout']][['yaxis']]$domain[1]) /2
    p[['x']][['layout']][['shapes']][[2]][['y0']] <- p[['x']][['layout']][['yaxis']]$domain[1]
    p[['x']][['layout']][['shapes']][[2]][['y1']] <- p[['x']][['layout']][['yaxis']]$domain[2]
    
    #fix the annotations
    for (i in 3:len + 1) {
      #fix the y position
      p[['x']][['layout']][['annotations']][[i]][['y']] <- (p[['x']][['layout']][[paste('yaxis', i - 2, sep='')]]$domain[1] + p[['x']][['layout']][[paste('yaxis', i - 2, sep='')]]$domain[2]) /2
      #trim the text
      p[['x']][['layout']][['annotations']][[i]][['text']] <- substr(p[['x']][['layout']][['annotations']][[i]][['text']], 1, length(p[['x']][['layout']][[paste('yaxis', i - 2, sep='')]][['ticktext']]) * 3 - 3)
    }
    
    #fix the rectangle shapes in the background
    for (i in seq(0,(len - 2) * 2, 2)) {
      p[['x']][['layout']][['shapes']][[i+4]][['y0']] <- p[['x']][['layout']][[paste('yaxis', i /2 + 2, sep='')]]$domain[1]
      p[['x']][['layout']][['shapes']][[i+4]][['y1']] <- p[['x']][['layout']][[paste('yaxis', i /2 + 2, sep='')]]$domain[2]
    }
    p
    

提交回复
热议问题