Построение «лестницы» с использованием ggplot2/plotly

Я пытаюсь следовать этому руководству здесь: https://rviews.rstudio.com/2017/09/25/survival-analysis-with-r/ (внизу страницы).

Я немного изменил код для этого урока и начертил «лестницы» (то есть «функции выживания», на рисунке ниже «красный», «синий», «зеленый»), соответствующие 3 наблюдениям в данных:

 library(survival)
    library(dplyr)
    library(ranger)
    library(data.table)
library(ggplot2)
library(plotly)
    
a = na.omit(lung)
a$ID <- seq_along(a[,1])

r_fit <- ranger(Surv(time,status) ~ age + sex + ph.ecog + ph.karno + pat.karno + meal.cal + wt.loss, data = a, mtry = 4, 
importance = "permutation", splitrule = "extratrees", verbose = TRUE)

death_times <- r_fit$unique.death.times
surv_prob  <-data.frame(r_fit$survival)
avg_prob <- sapply(surv_prob, mean)

plot(r_fit$unique.death.times, r_fit$survival[1,], type = "l", ylim = c(0,1), col = "red", xlab = "Days", ylab = "survival", main = "Survival Curves")

new = a[1:3,]

pred <- predict(r_fit, new, type = 'response')$survival
pred <- data.table(pred)
colnames(pred) <- as.character(r_fit$unique.death.times)

plot(r_fit$unique.death.times, pred[1,], type = "l", col = "red")

lines(r_fit$unique.death.times, r_fit$survival[2,], type = "l", col = "green")

lines(r_fit$unique.death.times, r_fit$survival[3,], type = "l", col = "blue")

Отсюда я хочу сделать приведенный выше сюжет «интерактивным». Хочу сделать так, чтобы при наведении мышки на одну из кривых:

  1. «Свойства», принадлежащие этой кривой (из объекта «а»), зависают (например, идентификатор, возраст, пол, ph.ecog и т. д.)

  2. В том же «поле наведения» из 1) также покажите координату x (r_fit $unique) и координату y (из «pred») для каждой позиции, над которой находится мышь (для данной кривой)

Мой план состоял в том, чтобы сначала взять объект «grob» и преобразовать его в объект «ggplot», а затем преобразовать объект «ggplot» в объект «plotly»:

 grob= plot(r_fit$unique.death.times, pred[1,], type = "l", col = "red")
basic_plot = ggpubr::as_ggplot(grob)

Но когда я пытаюсь проверить «basic_plot», он отображается как «NULL».

 ggplot(f)
Error: `data` must be a data frame, or other object coercible by `fortify()`, not an S3 object with class gg/ggplot

Если бы это сработало, я бы в конечном итоге преобразовал объект ggplot в plotly:

plotly_plot = ggplotly(final_plot)

Как сделать этот интерактивный сюжет?

Я пытаюсь добиться чего-то похожего на это: https://plotly.com/python/v3/ipython-notebooks/survival-analysis-r-vs-python/ (внизу страницы, график с название «продолжительность жизни различных профилей опухолевой ДНК»)

(Обратите внимание: я работаю с компьютером, у которого нет USB-порта или подключения к Интернету, только R с несколькими предустановленными библиотеками... У меня нет «ggplotify» или «survminer»)

base сюжеты не работают как объекты, подобные ggplot. Вам может понадобиться as.grobcran.r-project.org/web/packages/ggplotify/vignettes/…. Или вы пробовали делать сюжет в ggplot или plotly для начала?
QAsena 25.12.2020 09:39

К сожалению, на моем рабочем компьютере нет ggplotify (нет интернета, нет USB-порта).

stats_noob 25.12.2020 09:42

Ну, в таком случае, возможно, построить сюжет в ggplot и преобразовать с помощью ggplotly (или напрямую в plotly). Я не могу смотреть на данный момент со своего телефона, но подозреваю, что проблема описана здесь stackoverflow.com/a/29583945/10142537. Может быть, grob=plot() возвращается NULL?

QAsena 25.12.2020 09:46

Хорошо, это была проблема, я добавил ответ сейчас. Код ggplot, который я использовал, является базовым примером, который я могу улучшить, если хотите. Для ggplot грамматика лучше было бы, чтобы данные находились в одном кадре данных (длинные данные) и использовали один вызов geom_line, а не 3!

QAsena 25.12.2020 10:48

можно ли изменить ответ так, чтобы: p <- ggplot(var1 = a$ID, var2 = a$age )+ geom_line(aes(x = r_fit$unique.death.times, y = t(pred[1, ])), col = "red") + geom_line(aes(x = r_fit$unique.death.times, y = r_fit$survival[2,]), col = "green") + geom_line(aes(x = r_fit $unique.death.times, y = r_fit$survival[3,]), col = "blue") ggplotly(p, tooltip = c("var1", "var2"))

stats_noob 25.12.2020 21:08

спасибо QAsena! Я отредактировал исходный вопрос, чтобы спросить вас кое-что о текстовых метках при наведении, если у вас есть время, не могли бы вы взглянуть на него. Ваша помощь очень ценится!

stats_noob 26.12.2020 00:01
Стоит ли изучать PHP в 2026-2027 годах?
Стоит ли изучать PHP в 2026-2027 годах?
Привет всем, сегодня я хочу высказать свои соображения по поводу вопроса, который я уже много раз получал в своем сообществе: "Стоит ли изучать PHP в...
Поведение ключевого слова "this" в стрелочной функции в сравнении с нормальной функцией
Поведение ключевого слова "this" в стрелочной функции в сравнении с нормальной функцией
В JavaScript одним из самых запутанных понятий является поведение ключевого слова "this" в стрелочной и обычной функциях.
Приемы CSS-макетирования - floats и Flexbox
Приемы CSS-макетирования - floats и Flexbox
Здравствуйте, друзья-студенты! Готовы совершенствовать свои навыки веб-дизайна? Сегодня в нашем путешествии мы рассмотрим приемы CSS-верстки - в...
Тестирование функциональных ngrx-эффектов в Angular 16 с помощью Jest
В системе управления состояниями ngrx, совместимой с Angular 16, появились функциональные эффекты. Это здорово и делает код определенно легче для...
Концепция локализации и ее применение в приложениях React ⚡️
Концепция локализации и ее применение в приложениях React ⚡️
Локализация - это процесс адаптации приложения к различным языкам и культурным требованиям. Это позволяет пользователям получить опыт, соответствующий...
Пользовательский скаляр GraphQL
Пользовательский скаляр GraphQL
Листовые узлы системы типов GraphQL называются скалярами. Достигнув скалярного типа, невозможно спуститься дальше по иерархии типов. Скалярный тип...
0
6
285
1
Перейти к ответу Данный вопрос помечен как решенный

Ответы 1

Ответ принят как подходящий

Дело в том, что при рисовании сюжета в baseграфика рисуется прямо на устройстве. Строка вашего кода grob= plot(r_fit$unique.death.times, pred[1,], type = "l", col = "red") создает объект NULL (в отличие от ggplot, который возвращает объект графика).

Вы можете сделать график прямо в ggplot (есть несколько способов сделать это, но я сделал простой пример ниже) и преобразовать его с помощью ggplotly:

fig_dat <- data.frame(time = r_fit$unique.death.times,
                      pred_1 = t(pred[1,]),
                      fit_1 = r_fit$survival[2,],
                      fit_2 = r_fit$survival[3,])

fig_dat_long <- fig_dat %>% pivot_longer(-time, names_to = "pred_fit", values_to = "pred_fit_values")

gg_p <- ggplot(fig_dat_long, aes(x = time, y = pred_fit_values, colour = pred_fit)) +
  geom_line()

ggplotly(gg_p)

В качестве альтернативы вы также можете построить график plotly напрямую:

fig_dat <- data.frame(time = r_fit$unique.death.times,
                      pred_1 = t(pred[1,]),
                      fit_1 <- r_fit$survival[2,],
                      fit_2 <- r_fit$survival[3,])


fig <- plot_ly(fig_dat, x = ~time, y = ~pred_1, name = 'pred1', type = 'scatter', mode = 'lines')
fig <- fig %>% add_trace(y = ~fit_1, name = 'fit 1', mode = 'lines') 
fig <- fig %>% add_trace(y = ~fit_2, name = 'fit 2', mode = 'lines')

## make dataframe of variables to plot:
fig_dat <- data.frame(time = r_fit$unique.death.times,
                      pred_1 = t(pred[1,]),
                      fit_1 = r_fit$survival[2,],
                      fit_2 = r_fit$survival[3,])

# to include the variables from 'a' we need to put them in the same dataframe for plotting
# Trouble is they are different lengths the predicted data are a little shorter
dim(fig_dat)
dim(a)
# We can join the two with inner join: https://stackoverflow.com/questions/1299871/how-to-join-merge-data-frames-inner-outer-left-right
fig_dat_join <- inner_join(fig_dat, a, by = "time")
dim(fig_dat_join)
# now they are equal dimensions and joined together but we have a slight issue with duplicate values:
sort(a$time) # we can see here that time 53 appears twice for example
a$time[duplicated(a$time)] # this tells us which values in time are duplicated
sort(death_times) # some
death_times[duplicated(death_times)] #none
# because of the duplicates some combinations are returned: see rows 9 and 10
fig_dat_join 

# I'm not familiar with the analysis so I'm not sure what the correct way in this case is to remove the duplicates in 'a' so that the dimentions of 'a' match the output of 'r-fit'
# You might need to look into that but it might not make much difference to the visualisation

# I've not used plotly a great deal so there is probably a better way of doing this but I've done my best and included the links as comments: https://plotly-r.com/overview.html
# labels: https://plotly.com/r/figure-labels/
x_labs <- list(
  title = "Time")

y_labs <- list(
  title = "y axis")

# T include extra info in hovertext: I https://stackoverflow.com/questions/49901771/how-to-set-different-text-and-hoverinfo-text

p1 <- plot_ly(data = fig_dat_join,
              x = ~time,
              # text = ~n,
              # textposition = "auto",
              # hoverinfo = "text",
              hovertext = paste("Time :", fig_dat_join$time,
                                "<br> Sex :", fig_dat_join$sex,
                                "<br> Inst :", fig_dat_join$inst,
                                "<br> ID :", fig_dat_join$ID,
                                "<br> Age :", fig_dat_join$age
                                )) %>% 
  add_trace(y = ~pred_1,
            type = 'scatter',
            name = 'Predictor 1',
            mode = 'lines') %>% 
  add_trace( y = ~fit_1,
            type = 'scatter',
            name = 'Fit 1',
            mode = 'lines') %>% 
  add_trace( y = ~fit_2,
             type = 'scatter',
             name = 'Fit 2',
             mode = 'lines') %>% 
  layout(xaxis = x_labs, yaxis = y_labs)

p1


Я сопоставлял фрейм данных a с unique.death.times, используя left_join() выше. Если вам это не нужно, мы могли бы просто переместить код hovertext в каждый add_trace?

fig_dat <- data.frame(time = r_fit$unique.death.times,
                      pred_1 = t(pred[1,]),
                      fit_1 = r_fit$survival[2,],
                      fit_2 = r_fit$survival[3,])


p2 <- plot_ly(data = fig_dat,
              x = ~time,
              # text = ~n,
              # textposition = "auto",
              hoverinfo = "text"
) %>% 
  add_trace(y = ~pred_1,
            type = 'scatter',
            name = 'Predictor 1',
            mode = 'lines',
            hovertext = paste("Time :", fig_dat$time,
                              "<br> y axis :", fig_dat$pred_1,
                              "<br> Sex :", a$sex[1],
                              "<br> Inst :", a$inst[1],
                              "<br> ID :", a$ID[1],
                              "<br> Age :", a$age[1]
            )) %>% 
  add_trace( y = ~fit_1,
             type = 'scatter',
             name = 'Fit 1',
             mode = 'lines',
             hovertext = paste("Time :", fig_dat$time,
                               "<br> y axis :", fig_dat$fit_1,
                               "<br> Sex :", a$sex[2],
                               "<br> Inst :", a$inst[2],
                               "<br> ID :", a$ID[2],
                               "<br> Age :", a$age[2]
             )) %>% 
  add_trace( y = ~fit_2,
             type = 'scatter',
             name = 'Fit 2',
             mode = 'lines',
             hovertext = paste("Time :", fig_dat$time,
                               "<br> y axis :", fig_dat$fit_2,
                               "<br> Sex :", a$sex[3],
                               "<br> Inst :", a$inst[3],
                               "<br> ID :", a$ID[3],
                               "<br> Age :", a$age[3]
             )) %>% 
  layout(xaxis = x_labs, yaxis = y_labs)

p2

Счастливого Рождества! Спасибо большое, это лучший подарок на Новый год, о котором я только могла мечтать! Всего 2 вопроса: 1) в тексте при наведении, как изменить заголовок «r_fit $ survival» на «ось Y»? 2) Можете ли вы также добавить к тексту при наведении информацию из объекта «а» (например, возраст, пол, идентификатор, ph.ecog и т. д.)? Спасибо и счастливого Рождества!

stats_noob 25.12.2020 19:22

можно ли изменить ответ так, чтобы: p <- ggplot(var1 = a$ID, var2 = a$age )+ geom_line(aes(x = r_fit$unique.death.times, y = t(pred[1, ])), col = "red") + geom_line(aes(x = r_fit$unique.death.times, y = r_fit$survival[2,]), col = "green") + geom_line(aes(x = r_fit $unique.death.times, y = r_fit$survival[3,]), col = "blue") ggplotly(p, tooltip = c("var1", "var2"))

stats_noob 25.12.2020 21:08

Я обновил, чтобы включить ответ, который работает для сюжета. Только что увидел ваш комментарий для ggplot. Я посмотрю, смогу ли я добраться до этого тоже.

QAsena 25.12.2020 21:45

Хорошо, я изменил код ggplot выше. ggplot любит длинные данные, но после преобразования в с помощью ggplotly() я не знаю, как настроить текст при наведении... Может быть, использовать код plotly XD

QAsena 25.12.2020 23:08

спасибо QAsena! Я отредактировал исходный вопрос, чтобы спросить вас кое-что о текстовых метках при наведении, если у вас есть время, не могли бы вы взглянуть на него. Ваша помощь очень ценится!

stats_noob 26.12.2020 00:00

Ах хорошо, я не получил эту часть. Я думал, что это одно значение за раз. В таком случае мы можем забыть join я думаю. Новое обновление то, что вам нужно? Каждый add_trace ссылается на предиктор или подходит сейчас, а также ссылается на первый второй или третий индекс фрейма данных a. Вы можете перепроверить некоторые значения, чтобы убедиться, что они соответствуют вашим ожиданиям!

QAsena 26.12.2020 00:43

Здравствуйте QAsena! Я разместил новый вопрос, касающийся сюжета - если возможно, не могли бы вы взглянуть на него? stackoverflow.com/questions/65679523/… Спасибо!

stats_noob 12.01.2021 23:10

Не уверен, что смогу помочь с вашим новым вопросом. Не знаком с пакетом и, к сожалению, сейчас не смогу в нем покопаться!

QAsena 13.01.2021 06:32

@QAsena: отличный ответ! если у вас есть время, не могли бы вы взглянуть на этот вопрос? stackoverflow.com/questions/68242473/… спасибо

stats_noob 05.07.2021 05:32

Другие вопросы по теме