Полиномиальная регрессия не дает линий наилучшего соответствия - PullRequest
Новая
       38

Полиномиальная регрессия не дает линий наилучшего соответствия

0 голосов
/ 02 октября 2019

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

Однако я обнаружил, что мои выходные значения значительно отличаются (я ввожу значение, зная выходные данные, но оно сильно отличается). Я также обеспокоен высокими значениями r2.

Основные вопросы, которые у меня есть, следующие: 1: это проблема из-за моего непонимания статистики или ошибки в моем коде 2: это то, что я хочудостичь даже возможно? 3: Должен ли я просто принять, казалось бы, большие поля для ошибки.

Любая помощь или предложения будут с благодарностью. Я боролся с этим самостоятельно без конца слишком долго.

Graph Output

library(ggplot2)
library(tidyverse)
library(cowplot)

setwd("/Users/jakobparrish/Dropbox/Jakob/2019/Lake Nganoke-Thesis Prep/Core Work/Hyperspectral-Chlorophyl 'A'/Graphs R/Chlorophyll A")
SPEC <-read_csv("Correlations.csv")
Correlations <-read_csv("Correlations.csv")

lm_eqn <- function(df, degree, raw=TRUE){
  m <- lm(y ~ poly(x, degree, raw=raw), df)  # get the fit
  cf <- round(coef(m), 5)  # round the coefficients
  r2 <- round(summary(m)$r.squared, 5)  # round the r.squared
  powers <- paste0("^", seq(length(cf)-1))  # create the powers for the equation
  powers[1] <- ""  # remove the first one as it's redundant (x^1 = x)
  # first check the sign of the coefficient and assign +/- and paste it with
  # the appropriate *italic(x)^power. collapse the list into a string
  pcf <- paste0(ifelse(sign(cf[-1])==1, " + ", " - "), abs(cf[-1]),
                paste0("*italic(x)", powers), collapse = "")
  # paste the rest of the equation together
  eq <- paste0("italic(y) == ", cf[1], pcf, "*','", "~italic(r)^2==", r2)
  eq
}

###############################
#Plots LC1U vs LC3U
df1 <- data.frame("x"=Correlations$LC3U, "y"=Correlations$LC1U)
df1 <- na.omit(df1)

p1v3 <- ggplot(df1, aes(x = x, y = y)) +
  geom_point()+
  labs(x ='LC3U [cm]', y ='LC1U [cm]', title = 'Core Correlations of Lake Nganoke LC1U & LC3U') +
  stat_smooth(method = "lm", formula = y ~ poly(x, 2, raw = TRUE), size = 1) +
  annotate("text", x = 10, y = 10, label = lm_eqn(df1, 2, raw = TRUE),
           hjust = 0, family = "Times", parse = TRUE) +
  scale_y_continuous(breaks = c(0,10,20,30,40,50,60,70,80,90)) + #add limits in
  scale_x_continuous(breaks = c(0,10,20,30,40,50,60,70,80,90)) +
  expand_limits(y=c(10,90),x=c(10,90)) +
  theme_classic()

p1v3

###############################
#Plots LC2U vs LC3U
df2 <- data.frame("x"=Correlations$LC3U, "y"=Correlations$LC2U)
df2 <- na.omit(df2)

p2v3 <- ggplot(df2, aes(x = x, y = y)) +
  geom_point()+
  labs(x ='LC3U [cm]', y ='LC2U [cm]', title = 'Core Correlations of Lake Nganoke LC2U & LC3U') +
  stat_smooth(method = "lm", formula = y ~ poly(x, 4, raw = TRUE), size = 1) +
  annotate("text", x = 10, y = 10, label = lm_eqn(df2, 4, raw = TRUE),
           hjust = 0, family = "Times", parse = TRUE) +
  scale_y_continuous(breaks = c(0,10,20,30,40,50,60,70,80,90)) + #add limits in
  scale_x_continuous(breaks = c(0,10,20,30,40,50,60,70,80,90)) +
  expand_limits(y=c(10,90),x=c(10,90)) +
  theme_classic() 


p2v3

#################################
#Plots all two together

P_Correlations <-plot_grid(p1v3, p2v3, labels = "AUTO")

P_Correlations

Sample Data

...