Расчет значения R2 для логистического роста Функция: - PullRequest
Новая
       30

Расчет значения R2 для логистического роста Функция:

0 голосов
/ 22 мая 2019

Вот простой набор данных.Я хотел бы оценить значение R2 для этой наилучшей кривой логистического роста.Есть идеи, как это сделать?

###### Модель логистического роста в ggplot2 

library(tidyverse)
theme_set(theme_bw())
colors <- list(
  data = "#41414550",
  # data = "grey80",
  fit = "#414145")
#build the dataset 
points <- tibble(
  age = c(38, 45, 52, 61, 80, 74), 
  prop = c(0.146, 0.241, 0.571, 0.745, 0.843, 0.738))

ggplot(points, aes(x = age, y = prop)) + 
  geom_point(size = 3.5, color = colors$data) +
  scale_x_continuous(name = "Age in months", limits = c(0, 96), 
    # Because age is in months, I want breaks to land on multiples
    # of 12. The `Q` in `extended_breaks()` are "nice" numbers to use
    # for axis breaks.
    breaks = scales::extended_breaks(Q = c(24, 12))) + 
  scale_y_continuous( name = "Intelligibility", limits = c(0, NA),labels = scales::percent_format(accuracy = 1))

Создание уравнения наилучшего соответствия: 

xs <- seq(0, 96, length.out = 80) #80 observations ranging from 0-96
# Create the curve from the equation parameters
trend <- tibble( age = xs, asymptote = .8, scale = .2, midpoint = 48,
  prop = asymptote / (1 + exp((midpoint - age) * scale)))
trend

Построение графика 

colors$asym <- "#E7552C"
colors$mid <- "#3B7B9E"
colors$scale <- "#1FA35C"

logi.p <- ggplot(points, aes(x = age, y = prop))  +
  annotate("segment",color = colors$mid,x = 48, xend = 48,y = 0, yend = .4,linetype = "dashed") +
  annotate("segment",color = colors$asym, x = 20, xend = Inf, y = .8, yend = .8, linetype = "dashed") +
  geom_line(data = trend, size = 1, color = colors$fit) +
  geom_point(size = 3.5, color = colors$data) +
  annotate("text",label = "growth plateaus at asymptote",x = 20, y = .84,
    # horizontal justification = 0 sets x position to left edge of text
    hjust = 0,
    color = colors$asym) +
  annotate("text",
    label = "growth steepest at midpoint", x = 49, y = .05, hjust = 0, color = colors$mid) +
  scale_x_continuous( name = "Age in months", limits = c(0, 96), breaks = scales::extended_breaks(Q = c(24, 12))) + 
  scale_y_continuous( name = "Intelligibility", limits = c(0, NA),labels = scales::percent_format(accuracy = 1))
logi.p

enter image description here

...