Построить асимптотическую кривую регрессии модели NLS с использованием базы R - PullRequest
Новая
       5

Построить асимптотическую кривую регрессии модели NLS с использованием базы R

0 голосов
/ 09 ноября 2019

Я пытаюсь предсказать, достигнет ли Моника ее цели в 30 000 долларов. Я вычислил асимптоту для накопленных пожертвований ее кампании и составил значения. Теперь я хочу добавить кривую прогнозируемых значений из нелинейной оценки наименьших квадратов.

Как нарисовать эту кривую?

Вот как выглядит моя визуализация с кодом, представленным ниже:

enter image description here

Я хочу добавить кривую к нижнему правому графику под названием «Суммарная сумма пожертвований». Зеленая линия показывает цель (30 000 долл. США), красная линия показывает прогнозируемый максимум (16 171,11 долл. США).

Я хотел бы построить кривую, используя основание R, а не ggplot2.

код. 

donations <- read.table(textConnection("
donation datum
20 2019-11-08
50 2019-11-08
50 2019-11-08
120 2019-11-08
10 2019-11-08
50 2019-11-08
50 2019-11-08
25 2019-11-08
25 2019-11-08
20 2019-11-08
25 2019-11-08
10 2019-11-08
50 2019-11-08
15 2019-11-08
10 2019-11-08
25 2019-11-08
25 2019-11-07
10 2019-11-07
10 2019-11-07
25 2019-11-07
75 2019-11-07
50 2019-11-07
100 2019-11-07
20 2019-11-07
14 2019-11-07
40 2019-11-07
10 2019-11-07
26 2019-11-07
100 2019-11-06
600 2019-11-06
50 2019-11-06
25 2019-11-06
50 2019-11-06
50 2019-11-06
15 2019-11-06
100 2019-11-06
50 2019-11-06
100 2019-11-06
25 2019-11-05
45 2019-11-05
5 2019-11-05
100 2019-11-05
10 2019-11-05
50 2019-11-05
50 2019-11-05
50 2019-11-05
50 2019-11-05
10 2019-11-05
29 2019-11-04
100 2019-11-04
100 2019-11-04
42 2019-11-04
50 2019-11-04
40 2019-11-04
20 2019-11-04
15 2019-11-03
10 2019-11-03
30 2019-11-03
23 2019-11-03
100 2019-11-03
20 2019-11-02
5 2019-11-02
25 2019-11-02
25 2019-11-02
20 2019-11-02
300 2019-11-02
500 2019-11-02
30 2019-11-02
100 2019-11-02
200 2019-11-02
50 2019-11-02
25 2019-11-02
20 2019-11-02
10 2019-11-02
30 2019-11-02
300 2019-11-02
100 2019-11-02
10 2019-11-02
50 2019-11-02
10 2019-11-02
20 2019-11-02
50 2019-11-02
125 2019-11-01
15 2019-11-01
100 2019-11-01
64 2019-11-01
200 2019-11-01
15 2019-11-01
10 2019-11-01
20 2019-11-01
100 2019-11-01
50 2019-11-01
10 2019-11-01
10 2019-11-01
10 2019-11-01
10 2019-11-01
10 2019-11-01
42 2019-11-01
10 2019-11-01
100 2019-11-01
10 2019-11-01
5 2019-10-31
50 2019-10-31
5 2019-10-31
20 2019-10-31
5 2019-10-31
100 2019-10-31
20 2019-10-31
100 2019-10-31
19 2019-10-31
17 2019-10-31
10 2019-10-31
10 2019-10-31
50 2019-10-31
50 2019-10-31
25 2019-10-31
20 2019-10-31
20 2019-10-31
20 2019-10-31
25 2019-10-31
20 2019-10-31
22 2019-10-31
50 2019-10-31
50 2019-10-31
9 2019-10-31
10 2019-10-31
50 2019-10-31
50 2019-10-31
10 2019-10-31
20 2019-10-31
18 2019-10-31
5 2019-10-31
10 2019-10-30
100 2019-10-30
30 2019-10-30
50 2019-10-30
10 2019-10-30
10 2019-10-30
160 2019-10-30
50 2019-10-30
14 2019-10-30
500 2019-10-30
25 2019-10-30
100 2019-10-30
20 2019-10-30
120 2019-10-30
50 2019-10-30
10 2019-10-30
14 2019-10-30
100 2019-10-30
50 2019-10-30
50 2019-10-30
20 2019-10-30
50 2019-10-30
25 2019-10-30
40 2019-10-30
20 2019-10-30
10 2019-10-30
50 2019-10-30
20 2019-10-30
20 2019-10-30
50 2019-10-30
15 2019-10-30
5 2019-10-30
10 2019-10-30
65 2019-10-30
20 2019-10-30
50 2019-10-30
25 2019-10-30
10 2019-10-30
50 2019-10-30
10 2019-10-30
20 2019-10-30
42 2019-10-30
50 2019-10-30
20 2019-10-30
25 2019-10-30
100 2019-10-30
25 2019-10-30
25 2019-10-30
50 2019-10-30
25 2019-10-30
10 2019-10-30
50 2019-10-30
20 2019-10-30
25 2019-10-30
500 2019-10-30
10 2019-10-30
50 2019-10-30
10 2019-10-30
10 2019-10-30
10 2019-10-30
50 2019-10-30
10 2019-10-30
30 2019-10-30
100 2019-10-30
20 2019-10-30
100 2019-10-30
100 2019-10-30
50 2019-10-30
200 2019-10-30
20 2019-10-30
50 2019-10-30
20 2019-10-30
15 2019-10-30
50 2019-10-30
50 2019-10-30
10 2019-10-30
50 2019-10-30
50 2019-10-30
70 2019-10-29
15 2019-10-29
32 2019-10-29
100 2019-10-29
36 2019-10-29
20 2019-10-29
50 2019-10-29
50 2019-10-29
25 2019-10-29
50 2019-10-29
20 2019-10-29
30 2019-10-29
100 2019-10-29
200 2019-10-29
1000 2019-10-29
100 2019-10-29
512 2019-10-29
100 2019-10-29
150 2019-10-29
100 2019-10-29
200 2019-10-29
100 2019-10-29
25 2019-10-29
50 2019-10-29
25 2019-10-29
25 2019-10-29
100 2019-10-29
50 2019-10-29
50 2019-10-29
500 2019-10-29
60 2019-10-29
25 2019-10-29
500 2019-10-29
500 2019-10-29
5 2019-10-29
55 2019-10-29
"), header = TRUE, colClasses=c("integer", "Date"))

par(mfrow = c(2,2))
plot(aggregate(donations$donation, list(donations$datum), length), xlab = "Date", ylab = "Number of Donations", main = "Number of Donations per Day")
plot(aggregate(donations$donation, list(donations$datum), sum), xlab = "Date", ylab = "Sum of Donations", main = "Total Amount Donated each Day")
plot(table(donations$donation), xlab = "Amount", ylab = "Number of Donations", main = "Frequency of Amounts")

donations.aggregated <- aggregate(donations$donation, list(donations$datum), sum)
colnames(donations.aggregated) <- c("datum", "donated")
donations.aggregated$day <- abs(as.numeric(as.Date("2019-10-28") - donations.aggregated$datum))
# donations.aggregated <- donations.aggregated[, 2:3]
donations.aggregated$donated <- ave(donations.aggregated$donated, FUN = cumsum)

fm <- nls(donated ~ SSasymp(day, Asym, R0, lrc), data = donations.aggregated)
summary(fm)

plot(donated ~ datum, donations.aggregated, ylim = c(0, 30000), xlab = "Day", ylab = "Cumulative Donations", main = "Cumulative Amount Donated")
abline(h = coef(fm)[1], col = "red")
abline(h = 30000, col = "green")

1 Ответ

1 голос
/ 11 ноября 2019

Вы можете использовать функцию curve. Его первым параметром является выражение, где x заменяется значениями, соответствующими диапазону x-данных на графике. 

curve(predict(fm, 
              newdata = data.frame(day = abs(as.numeric(as.Date("2019-10-28") - x)))), 
      add = TRUE)

resulting plot

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.

Нет похожих вопросов

...