Untitled

x = c(3.5,1,4,2,1,3,4.5,1.5,3,5)
y = c(825,215,1070,550,480,920,1350,325,670,1215)
z = data.frame(x,y)
lm4.1 <- lm(y ~ x);lm4.1

## 
## Call:
## lm(formula = y ~ x)
## 
## Coefficients:
## (Intercept)            x  
##       46.15       251.17

x_hat <- 46.15 + 251.17*x
sigma2 <- t(x_hat - y)%*%(x_hat - y)/(10-1-1);sigma2

##          [,1]
## [1,] 16143.37

(summary(lm4.1) $ sigma)^2

## [1] 16143.37

SSR <- t(x_hat - mean(y))%*%(x_hat - mean(y))
SST <- t(y - mean(y))%*%(y - mean(y))
R2 <- SSR / SST;R2

##           [,1]
## [1,] 0.9004631

(summary(lm4.1) $ r.squared)

## [1] 0.9004924

anova(lm4.1)

## Analysis of Variance Table
## 
## Response: y
##           Df  Sum Sq Mean Sq F value    Pr(>F)    
## x          1 1168713 1168713  72.396 2.795e-05 ***
## Residuals  8  129147   16143                      
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

res <- residuals(lm4.1);res

##           1           2           3           4           5           6 
## -100.263158  -82.327935   19.149798    1.497976  182.672065  120.323887 
##           7           8           9          10 
##  173.562753  -97.914980 -129.676113  -87.024291

plot(x,res,main='残差散点图',xlab='新保单数目',ylab='残差')

plot(lm4.1)

lm4.1_1 <- lm(y ~ x,data = z)
pre <- predict(lm4.1_1,newdata = data.frame(y = 1000))

## Warning: 'newdata'必需有1行 但变量里有10行

lxy <- function(x1,y1){n = length(x1)
                     sum(x1*y1) -sum(x1)*sum(y1)/n}
a = lxy(x,y)/lxy(x,x)
mean(x)

## [1] 2.85

mean(y)

## [1] 762

b=mean(y)/(mean(x)+1)
y0 = 1000
x0 = (y0-b)/a;x0

## [1] 3.193315