Segmenty linii lub prostokąty z informacją na zawiasach w R sprytnie rysunek

Question

Chcę utworzyć interaktywną figurę segmentów linii lub prostokątów, tak aby każdy segment lub prostokąt dawał inne informacje, gdy użytkownik najedzie na niego myszą. Spojrzałem na htmlwidgets showcase i pomyślałem, że wyglądał obiecująco. (Jestem otwarty na inne metody związane z R).

Poniżej znajduje się prosty przykład. Mogę utworzyć wykres punktów końcowych (t1 i t2), które dostarczają informacji o najechaniu. Chciałbym jednak, aby informacje o zawisaniu pojawiały się za każdym razem, gdy użytkownik unosi się nad przestrzenią między dwoma punktami końcowymi).

Mogę dodać segment linii za pomocą add_trace(), ale nie mogę uruchomić funkcji Hover. A jeśli dodać segment drugiego wiersza, otrzymuję komunikat o błędzie:

Error in plot_ly(data = mydat, x = t2, y = y, mode = "markers", hoverinfo = "text", : 
    requires numeric/complex matrix/vector arguments 

mogę dodać prostokąty za pomocą layout(), ale znowu, nie mogę uzyskać unoszą się do pracy.

Jeśli ktoś zaproponuje sposób, w jaki można zastosować argumenty najeżdżania dla któregoś z tych podejść, z zadowoleniem przyjmuję również sugestie, jak zakodować to dla dużej liczby segmentów/prostokątów (nie tylko 2, jak w tym prostym przykładzie).

Wszelkie sugestie?

mydat <- data.frame(t1=c(1, 3), t2=c(4, 5), y=c(1, 2), task=c("this", "that")) 
library(plotly) 

# attempt with one line segment - hover doesn't work 
plot_ly(data=mydat, x=t2, y=y, mode="markers", 
    hoverinfo="text", text=task) %>% 
add_trace(data=mydat, x=t1, y=y, mode="markers", 
    hoverinfo="text", text=task) %>% 
add_trace(
    x=c(mydat$t1[1], mydat$t2[1]), y=c(mydat$y[1], mydat$y[1]), 
    mode="lines", hoverinfo="text", text=mydat$task[1]) 

# attempt with both line segments - 
# Error in plot_ly, requires numeric/complex matrix/vector arguments 
plot_ly(data=mydat, x=t2, y=y, mode="markers", 
    hoverinfo="text", text=task) %>% 
add_trace(data=mydat, x=t1, y=y, mode="markers", 
    hoverinfo="text", text=task) %>% 
add_trace(
    x=c(mydat$t1[1], mydat$t2[1]), y=c(mydat$y[1], mydat$y[1]), 
    mode="lines", hoverinfo="text", text=mydat$task[1]) %*% 
add_trace(
    x=c(mydat$t1[2], mydat$t2[2]), y=c(mydat$y[2], mydat$y[2]), 
    mode="lines", hoverinfo="text", text=mydat$task[2]) 

# attempt with rectangles - hover doesn't work 
plot_ly(data=mydat, x=t2, y=y, mode="markers", 
    hoverinfo="text", text=task) %>% 
add_trace(data=mydat, x=t1, y=y, mode="markers", 
    hoverinfo="text", text=task) %>% 
layout(shapes=list(
    list(type="rect", x0=mydat$t1[1], x1=mydat$t2[1], xref="x", 
    y0=mydat$y[1], y1=mydat$y[1]+0.1, yref="y", 
    hoverinfo="text", text=mydat$task[1]), 
    list(type="rect", x0=mydat$t1[2], x1=mydat$t2[2], xref="x", 
    y0=mydat$y[2], y1=mydat$y[2]+0.1, yref="y", 
    hoverinfo="text", text=mydat$task[2]) 
)) 

Answer 1

Można użyć highcharter, który otacza biblioteki Highcharts.js.

# note i'm renaming y to x, since that's how highcharts will treat this dataset 
mydat <- data.frame(t1=c(1, 3), t2=c(4, 5), x=c(1, 2), task=c("this", "that")) 

library(highcharter) 

highchart(hc_opts = list(
    chart = list(inverted = 'true') 
)) %>% 
    hc_add_series_df(data = mydat, type = 'columnrange', 
        group = task, 
        x = x, low = t1, high = t2) 

działa dobrze bez dodatkowego kodu wymaganego do większej liczby barów:

set.seed(123) 
n <- 20 
largedat <- data.frame(t1 = runif(n, 1, 10), 
         x = 1:n, 
         task = paste('series', 1:n)) 
largedat$t2 <- largedat$t1 + runif(n, 2, 5) 

highchart(hc_opts = list(
    chart = list(inverted = 'true') 
)) %>% 
    hc_add_series_df(data = largedat, type = 'columnrange', 
        group = task, 
        x = x, low = t1, high = t2) %>% 
    hc_legend(enabled = FALSE) # disable legend on this one 

Answer 2

można dostać najechaniu informacji wzdłuż linii poprzez wprowadzenie wielu punktów na linii. Nie trzeba umieścić znaczniki w tych punktach, więc fabuła będzie nadal wyglądają tak samo:

NP=100 
mydat <- data.frame(t1=seq(1,3,len=NP), t2=seq(4,5,len=NP), y1=rep(1,NP), y2=rep(2,NP)) 

plot_ly(data=mydat) %>% 
    add_trace(x=t1, y=y1, mode="lines", hoverinfo="text", text="hello") %>% 
    add_trace(x=t2, y=y2, mode="lines", hoverinfo="text", text="there") 

Rozszerzenie to prostokątów, możemy zrobić

plot_ly() %>% 
    add_trace(x=c(seq(1,3,len=NP), rep(3,NP), seq(3,1,len=NP), rep(1,NP)), 
      y=c(rep(1,NP), seq(1,2,len=NP), rep(2,NP), seq(2,1,len=NP)), 
      mode="lines", hoverinfo="text", text="A sublime rectangle") %>% 
    layout(hovermode = 'closest') 

OR, jeśli chcesz oznaczyć każdą stronę prostokąta osobno:

plot_ly() %>% 
    add_trace(x=c(seq(1,3,len=NP), rep(3,NP), seq(3,1,len=NP), rep(1,NP)), 
      y=c(rep(1,NP), seq(1,2,len=NP), rep(2,NP), seq(2,1,len=NP)), 
      mode="lines", hoverinfo="text", 
      text=c(rep("bottom",NP),rep("right",NP),rep("top",NP),rep("left",NP))) %>% 
    layout(hovermode = 'closest') 

I dla dia linie pozycyjne:

plot_ly() %>% 
    add_trace(x=seq(1,3,len=NP), y=seq(1,2,len=NP), mode="lines", hoverinfo="text", text="diagonal") %>% 
    layout(hovermode = 'closest') 

W odpowiedzi na dodatkowe pytanie "jak zakodować to dla dużej liczby segmentów/prostokątów"? Nie określasz, ile jest "dużej liczby". Ale mogę powiedzieć, że dodawanie wielu oddzielnych śladów w spiskach może sprawić, że proces będzie dość powolny. Z nieznośną powolnością z dużą ilością śladów. Sposób obejścia tego polega na dodaniu wszystkich segmentów linii w jednym przebiegu. W przypadku niektórych efektów (takich jak kontrola kolorów niezależnie od grup i wpisów w legendach) może być konieczne dodanie wartości NA oddzielających segmenty i użycie opcji connectgaps=FALSE w add_trace (patrz here i here), ale nie jest to konieczne w tym prostym przypadku . Oto minimalne przykład

line1 <- data.frame(x=seq(3.5,4.5,len=NP), y=rep(2.5,NP), text="hello") 
line2 <- data.frame(x=seq(3,3.5,len=NP), y=seq(3,2.5,len=NP), text="mouth") 
line3 <- data.frame(x=seq(4.5,5,len=NP), y=seq(2.5,3,len=NP), text="mouth") 
line4 <- data.frame(x=rep(4,NP), y=seq(2.75,3.5,len=NP), text="nose") 
rect1 <- data.frame(x=c(seq(2,6,len=NP), rep(6,NP), seq(6,2,len=NP), rep(2,NP)), 
        y=c(rep(2,NP), seq(2,4.5,len=NP), rep(4.5,NP), seq(4.5,2,len=NP)), 
        text="head") 
rect2 <- data.frame(x=c(seq(2.5,3.5,len=NP), rep(3.5,NP), seq(3.5,2.5,len=NP), rep(2.5,NP)), 
        y=c(rep(3.5,NP), seq(3.5,4,len=NP), rep(4,NP), seq(4,3.5,len=NP)), 
        text="left eye") 
rect3 <- data.frame(x=c(seq(4.5,5.5,len=NP), rep(5.5,NP), seq(5.5,4.5,len=NP), rep(4.5,NP)), 
        y=c(rep(3.5,NP), seq(3.5,4,len=NP), rep(4,NP), seq(4,3.5,len=NP)), 
        text="right eye") 

trace_dat <- rbind(line1, line2, line3, line4, rect1, rect2, rect3) 

plot_ly(data=trace_dat, x=x, y=y, mode="lines", hoverinfo="text", text=text, group = text) %>% 
    layout(hovermode = 'closest')