Добавить уравнение наклона к регрессии рассеяния в Shiny -R - PullRequest
Новая
       9

Добавить уравнение наклона к регрессии рассеяния в Shiny -R

0 голосов
/ 26 апреля 2018

Код ниже, взятый из здесь , создает интерактивную корреляционную тепловую карту.Можно выбрать плитки и увидеть соответствующий график рассеяния с линией регрессии.Я новичок в shiny, и мне интересно, как я могу получить уравнение наклона регрессии и значения r-квадрата, добавленного к графику?Спасибо 

library(plotly)
library(shiny)

# compute a correlation matrix
correlation <- round(cor(mtcars), 3)
nms <- names(mtcars)

ui <- fluidPage(
  mainPanel(
    plotlyOutput("heat"),
    plotlyOutput("scatterplot")
  ),
  verbatimTextOutput("selection")
)

server <- function(input, output, session) {
  output$heat <- renderPlotly({
    plot_ly(x = nms, y = nms, z = correlation, 
            key = correlation, type = "heatmap", source = "heatplot") %>%
      layout(xaxis = list(title = ""), 
             yaxis = list(title = ""))
  })

  output$selection <- renderPrint({
    s <- event_data("plotly_click")
    if (length(s) == 0) {
      "Click on a cell in the heatmap to display a scatterplot"
    } else {
      cat("You selected: \n\n")
      as.list(s)
    }
  })

  output$scatterplot <- renderPlotly({
    s <- event_data("plotly_click", source = "heatplot")
    if (length(s)) {
      vars <- c(s[["x"]], s[["y"]])
      d <- setNames(mtcars[vars], c("x", "y"))
      yhat <- fitted(lm(y ~ x, data = d))
      plot_ly(d, x = ~x) %>%
        add_markers(y = ~y) %>%
        add_lines(y = ~yhat) %>%
        layout(xaxis = list(title = s[["x"]]), 
               yaxis = list(title = s[["y"]]), 
               showlegend = FALSE)
    } else {
      plotly_empty()
    }
  })

}

shinyApp(ui, server)

1 Ответ

0 голосов
/ 26 апреля 2018

Разобрался.Я получил уравнение линии регрессии, используя найденную функцию здесь .Затем включил этот вывод в вызов add_annotations в функции scatterplot.Также добавлены имена к точкам, используя add_text.

Полный код: 

library(plotly)
library(shiny)
library(magrittr)

# compute a correlation matrix
correlation <- round(cor(mtcars), 3)
nms <- names(mtcars)

ui <- fluidPage(
mainPanel(
plotlyOutput("heat"),
plotlyOutput("scatterplot")
),
verbatimTextOutput("selection")
)

server <- function(input, output, session) {
output$heat <- renderPlotly({
plot_ly(x = nms, y = nms, z = correlation, 
key = correlation, type = "heatmap", source = "heatplot") %>%
layout(xaxis = list(title = ""), 
yaxis = list(title = ""))
})

output$selection <- renderPrint({
s <- event_data("plotly_click")
if (length(s) == 0) {
"Click on a cell in the heatmap to display a scatterplot"
} else {
cat("You selected: \n\n")
as.list(s)
}
})

lm_eqn <- function(df){
g<-as.character("y = a + b x, R2= r2 ");
m <- lm(y ~ x, df);
eq <- g %<>%
gsub("a", format(coef(m)[1], digits = 2), .) %>%
gsub("b", format(coef(m)[2], digits = 2), .) %>%
gsub("r2", format(summary(m)$r.squared, digits = 3), .);                 
}

output$scatterplot <- renderPlotly({
s <- event_data("plotly_click", source = "heatplot")
if (length(s)) {
vars <- c(s[["x"]], s[["y"]])
d <- setNames(mtcars[vars], c("x", "y"))
yhat <- fitted(lm(y ~ x, data = d))
plot_ly(d, x = ~x, text= rownames(mtcars)) %>%
add_markers(y = ~y) %>%
add_lines(y = ~yhat) %>%
add_text(y=~y, textposition='top right')%>%
add_annotations(x=-1,y=-1,text=lm_eqn(d))%>%
layout(xaxis = list(title = s[["x"]]), 
yaxis = list(title = s[["y"]]), 
showlegend = FALSE)
} else {
plotly_empty()
}
})

}

shinyApp(ui, server)
...