compile R online

Language: Layout:

# входы
x <- c(1.2, 2.1, 3.3, 4.6, 3.5, 3.7, 0.7, 2.5, 2.8, 2.0)
# выходы
y <- c(2.5, 3.0, 4.4, 4.1, 3.0, 2.4, 1.1, 4.0, 1.5, 1.4)

# таблица входов и выходов
df <- data.frame(x, y)

# коэффициент пересечения НЛА
b <- coef(lm(df$y ~ df$x))[1]
# коэффициент наклона НЛА
k <- coef(lm(df$y ~ df$x))[2]

# красная линия — плохая
kRed <- -(k * 0.3)
bRed <- (5.5 - b)

# синяя линия — первая хорошая
kBlue <- k * 0.80
bBlue <- b * 1.30

# зелёная линия — вторая хорошая
kGreen <- k * 1.10
bGreen <- b * 0.80

# оценки НЛА
df$yEst <- k * df$x + b

# точка для демонстрации
p <- list(x = 3.3, y = 4.4, yEst = subset(df, x == 3.3 & y == 4.4)$yEst)

# центр масс
mc <- list(x = mean(df$x), y = mean(df$y))

# запись текущих графических параметров
op <- par()

# смена шрифта
#par(family = 'Times', pin = c(3.5, 3.5))
par(family = 'Times')

# график (диаграмма рассеяния)
plot(
    df$x, 
    df$y, 
    type = 'p', 
    pch = 20, 
    xlim = c(0, 6), 
    ylim = c(0, 6), 
    xaxt = 'n', 
    yaxt = 'n', 
    ann = FALSE, 
    bty = 'n'
)

# начало координат
mtext('0', side = 1, line = -0.6, at = -0.15, cex = 1.0, font = 1)

# ось абсцисс
arrows(-2, 0, 6, 0, code = 2, length = 0.15, angle = 7)
# подпись оси абсцисс
mtext('x', side = 1, line = -0.5, at = 6, cex = 1.0, font = 4)

# ось ординат
arrows(0, -2, 0, 6, code = 2, length = 0.15, angle = 7)
# подпись оси ординат
mtext('y', side = 2, line = -0.5, at = 6, cex = 1.0, font = 4, las = 2)

# координаты точки, выбранной для демонстрации
#arrows(p$x, 0, p$x, p$y, code = 0, lty = 2)
#arrows(0, p$y, p$x, p$y, code = 0, lty = 2)

# подписи координат точки, выбранной для демонстрации
#mtext(expression(italic(x[i])), side = 1, line = -0.5, at = p$x, cex = 1.0, font = 3)
#mtext(expression(italic(y[i])), side = 2, line = -0.5, at = p$y, cex = 1.0, font = 3, las = 2)

# красная линия — плохая
#lines(c(min(df$x) - 0.3, max(df$x) + 0.3), kRed * c(min(df$x) - 0.3, max(df$x) + 0.3) + bRed, type = 'l', col = 'red')
# синяя линяя — хорошая
#lines(c(min(df$x) - 0.3, max(df$x) + 0.3), kBlue * c(min(df$x) - 0.3, max(df$x) + 0.3) + bBlue, type = 'l', col = 'blue')
# зелёная линия — хорошая
#lines(c(min(df$x) - 0.3, max(df$x) + 0.3), kGreen * c(min(df$x) - 0.3, max(df$x) + 0.3) + bGreen, type = 'l', col = 'green')

# линия НЛА
#lines(c(min(df$x) - 0.3, max(df$x) + 0.3), k * c(min(df$x) - 0.3, max(df$x) + 0.3) + b, type = 'l', col = 'brown')
# оценка точки, выбранной для демонстрации
#lines(p$x, p$yEst, type = 'p', pch = 20, col = 'brown')
# координата оценки точки, выбранной для демонстрации
#arrows(0, p$yEst, p$x, p$yEst, code = 0, lty = 2)
# подпись координаты оценки точки, выбранной для демонстрации
#mtext(expression(italic(hat(y)[i])), side = 2, line = -0.5, at = p$yEst, cex = 1.0, font = 3, las = 2)

# величина отклонения
#arrows(p$x, min(p$y, p$yEst), p$x, max(p$y, p$yEst), code = 3, length = 0.10, angle = 7)
# подпись отклонения
#text(p$x + 0.2, ((p$y + p$yEst) / 2), expression(italic(d[i])), cex = 1.0, font = 3)

# координаты центр масс
#arrows(mc$x, 0, mc$x, mc$y, code = 0, lty = 2)
#arrows(0, mc$y, mc$x, mc$y, code = 0, lty = 2)

# подписи координат центра масс
#mtext(expression(italic(bar(x))), side = 1, line = -0.6, at = mc$x, cex = 1.2, font = 3)
#mtext(expression(italic(bar(y))), side = 2, line = -0.4, at = mc$y, cex = 1.2, font = 3, las = 2)

# центр масс
#lines(mc$x, mc$y, type = 'p', pch = 20, col = 'brown')

# возврат к текущим графическим параметрам
par <- op

[ + ] Show input
Absolute running time: 0.53 sec, cpu time: 0.39 sec, memory peak: 36 Mb, absolute service time: 0.54 sec