使用plotly包将多个平行平面添加到3D绘图中(datacamp exercise)

问题描述 投票:0回答:1

我试图使用plotly包在3D绘图中可视化两个平行平面(对于那些可以访问Datacamp的人来说,就是这个练习:https://campus.datacamp.com/courses/multiple-and-logistic-regression/multiple-regression?ex=9

在构建此图形的某个时刻,您需要创建一个矩阵以适合与分类变量匹配的平面(plane_new = condition是new,plane_used = condition)。问题是,我用作输入的两个数据集(对应于两个条件级别)具有不同的观察数量。我似乎无法弄清楚如何使这些矩阵具有可比性,以便平面正确地适合作为图中的几何对象。

我希望R-wizard可以帮助我;)。这是我的代码:

# libraries
library(openintro) #exemplary datasets
library(modelr) #multivariate methods
library(broom) #tidy
library(ggplot2) #visualizing data
library(plotly) #visualizing models in 3D

## Fit the model

lm_ext <- lm(totalPr ~ duration + startPr + cond,           # Interpretation: With every 1 unit increase of auction duration (unit = day), the price of the game decreases with .51 units in the response variable (total price), when keeping startPr constant. The eventual value of the predicted value also depends on condition (categorical), for which the y-intercept is different
             data = marioKart)          


## Visualize the model (including predictions)

marioKart_ss_new <- subset(marioKart, cond == "new")        # To visualize planes in a 3D graph in plotly, the dataframe needs to be split in the number of levels of the categorical variable
marioKart_ss_used <- subset(marioKart, cond == "used")

duration_new <- as.vector(marioKart_ss_new$duration)        # These vectors represent the linear model for condition = new
startPr_new <- as.vector(marioKart_ss_new$startPr)

duration_used <- as.vector(marioKart_ss_used$duration)      # These vectors represent the linear model for condition = used
startPr_used <- as.vector(marioKart_ss_used$startPr)

lm_new <- lm(totalPr ~ duration + startPr,                  # Create two linear models
             data = marioKart_ss_new) 
lm_used <- lm(totalPr ~ duration + startPr, 
             data = marioKart_ss_used) 

grid_new <- marioKart_ss_new %>%                            # Make two grids with all combinations of the levels of the two numerical explanatory variables
              data_grid(duration = 
                          seq_range(duration, by = 1),
                        startPr = 
                          seq_range(startPr, by = 1))
grid_used <- marioKart_ss_used %>%  
              data_grid(duration = 
                          seq_range(duration, by = 1),
                        startPr = 
                          seq_range(startPr, by = 1))

lm_new <- lm(totalPr ~ duration + startPr,                  # Make two seperate models based on the two levels of the categorical explanatory variable
             data = marioKart_ss_new) 
lm_used <- lm(totalPr ~ duration + startPr,                
             data = marioKart_ss_used) 

pred_new <- augment(lm_new, newdata = grid_new)             # Predictions
pred_used <- augment(lm_used, newdata = grid_used) 

plane_new <- matrix(pred_new$.fitted,                       # Matrix of preditions as input for planes
                    nrow = 70,
                    ncol = 70)

plane_used <- matrix(pred_used$.fitted,                     
                     nrow = 55,
                     ncol = 55)

plot <- plot_ly(data = marioKart,                           # 3D plot of datapoints
                z = ~totalPr, 
                x = ~duration, 
                y = ~startPr, 
                opacity = 0.6) %>%
  add_markers(color = ~cond) 

plot %>%                                                    # Add planes
  add_surface(x = ~duration_new,                            ### NOT WORKING, WAIT FOR DATACAMP
              y = ~startPr_new, 
              z = ~plane_new, 
              showscale = FALSE) %>%
  add_surface(x = ~duration_used, 
              y = ~duration_used, 
              z = ~plane_used, 
              showscale = FALSE)
matrix data-visualization plotly linear-regression
1个回答
1
投票

这里没有代码向导,但要求同样的事情:

library(tidyverse)
library(modelr)

grid <- mario_kart %>%
  modelr::data_grid(
    duration = seq_range(duration, n = 70),
    startPr = seq_range(startPr, n = 70),
    cond
  )

library(broom)

tidy_planes <- mod %>%
  augment(newdata = grid)

x <- unique(grid$duration)
y <- unique(grid$startPr)

plane0 <- tidy_planes %>%
  filter(cond == "new") %>%
  pull(.fitted) %>%
  matrix(nrow = length(x), byrow = TRUE)

plane1 <- tidy_planes %>%
  filter(cond == "used") %>%
  pull(.fitted) %>%
  matrix(nrow = length(x), byrow = TRUE)
© www.soinside.com 2019 - 2024. All rights reserved.