Dane wejściowe:

n <- 4
obs <- rnorm(n)
obs
## [1] -0.4954435 -1.4919928 -0.3771459 -0.3889509
dist(obs)
##            1          2          3
## 2 0.99654931                      
## 3 0.11829757 1.11484688           
## 4 0.10649256 1.10304187 0.01180501
dist(obs)^2
##              1            2            3
## 2 0.9931105363                          
## 3 0.0139943142 1.2428835673             
## 4 0.0113406651 1.2167013740 0.0001393582
sum(dist(obs)^2)/(n*(n-1))
## [1] 0.2898475
mean(dist(obs)^2)/2
## [1] 0.2898475
var(obs)
## [1] 0.2898475

Szybka macierz kwadratów różnic:

g <- matrix(obs, ncol=n, nrow=n, byrow = T)
h <- matrix(obs, ncol=n, nrow=n, byrow = F)
k <- g - h
k
##            [,1]       [,2]       [,3]        [,4]
## [1,]  0.0000000 -0.9965493 0.11829757  0.10649256
## [2,]  0.9965493  0.0000000 1.11484688  1.10304187
## [3,] -0.1182976 -1.1148469 0.00000000 -0.01180501
## [4,] -0.1064926 -1.1030419 0.01180501  0.00000000
k^2
##            [,1]      [,2]         [,3]         [,4]
## [1,] 0.00000000 0.9931105 0.0139943142 0.0113406651
## [2,] 0.99311054 0.0000000 1.2428835673 1.2167013740
## [3,] 0.01399431 1.2428836 0.0000000000 0.0001393582
## [4,] 0.01134067 1.2167014 0.0001393582 0.0000000000

Iloczyn kartezjański w formacie długim long:

df_pre <- merge(obs, obs, all=TRUE)
df_pre
##             x          y
## 1  -0.4954435 -0.4954435
## 2  -1.4919928 -0.4954435
## 3  -0.3771459 -0.4954435
## 4  -0.3889509 -0.4954435
## 5  -0.4954435 -1.4919928
## 6  -1.4919928 -1.4919928
## 7  -0.3771459 -1.4919928
## 8  -0.3889509 -1.4919928
## 9  -0.4954435 -0.3771459
## 10 -1.4919928 -0.3771459
## 11 -0.3771459 -0.3771459
## 12 -0.3889509 -0.3771459
## 13 -0.4954435 -0.3889509
## 14 -1.4919928 -0.3889509
## 15 -0.3771459 -0.3889509
## 16 -0.3889509 -0.3889509
df <- expand.grid(x=obs,y=obs)
df
##             x          y
## 1  -0.4954435 -0.4954435
## 2  -1.4919928 -0.4954435
## 3  -0.3771459 -0.4954435
## 4  -0.3889509 -0.4954435
## 5  -0.4954435 -1.4919928
## 6  -1.4919928 -1.4919928
## 7  -0.3771459 -1.4919928
## 8  -0.3889509 -1.4919928
## 9  -0.4954435 -0.3771459
## 10 -1.4919928 -0.3771459
## 11 -0.3771459 -0.3771459
## 12 -0.3889509 -0.3771459
## 13 -0.4954435 -0.3889509
## 14 -1.4919928 -0.3889509
## 15 -0.3771459 -0.3889509
## 16 -0.3889509 -0.3889509
df$d <-  ( df$x-df$y)
df$d2 <-  df$d^2
df$d3 <-  df$d2*sign(df$d)
df
##             x          y           d           d2            d3
## 1  -0.4954435 -0.4954435  0.00000000 0.0000000000  0.0000000000
## 2  -1.4919928 -0.4954435 -0.99654931 0.9931105363 -0.9931105363
## 3  -0.3771459 -0.4954435  0.11829757 0.0139943142  0.0139943142
## 4  -0.3889509 -0.4954435  0.10649256 0.0113406651  0.0113406651
## 5  -0.4954435 -1.4919928  0.99654931 0.9931105363  0.9931105363
## 6  -1.4919928 -1.4919928  0.00000000 0.0000000000  0.0000000000
## 7  -0.3771459 -1.4919928  1.11484688 1.2428835673  1.2428835673
## 8  -0.3889509 -1.4919928  1.10304187 1.2167013740  1.2167013740
## 9  -0.4954435 -0.3771459 -0.11829757 0.0139943142 -0.0139943142
## 10 -1.4919928 -0.3771459 -1.11484688 1.2428835673 -1.2428835673
## 11 -0.3771459 -0.3771459  0.00000000 0.0000000000  0.0000000000
## 12 -0.3889509 -0.3771459 -0.01180501 0.0001393582 -0.0001393582
## 13 -0.4954435 -0.3889509 -0.10649256 0.0113406651 -0.0113406651
## 14 -1.4919928 -0.3889509 -1.10304187 1.2167013740 -1.2167013740
## 15 -0.3771459 -0.3889509  0.01180501 0.0001393582  0.0001393582
## 16 -0.3889509 -0.3889509  0.00000000 0.0000000000  0.0000000000
matrix(df$d2, nrow=n)
##            [,1]      [,2]         [,3]         [,4]
## [1,] 0.00000000 0.9931105 0.0139943142 0.0113406651
## [2,] 0.99311054 0.0000000 1.2428835673 1.2167013740
## [3,] 0.01399431 1.2428836 0.0000000000 0.0001393582
## [4,] 0.01134067 1.2167014 0.0001393582 0.0000000000

Wariancja z obserwacji wyliczona standardową funkcją :

var(obs)
## [1] 0.2898475

Wariancja wyliczona z kwadratów odległości:

 sum(df$d2)/(n*(n-1)*2)
## [1] 0.2898475
sum(obs^2)/(n-1) - (sum(obs)/n)^2
## [1] 0.4478047
sum(obs^2)/(n-1)   - mean(obs)^2  *(n/(n-1))
## [1] 0.2898475
sum(obs^2)/(n-1) -  (sum(obs))^2/(n*(n-1)) 
## [1] 0.2898475
 sum(df$d2)
## [1] 6.95634
mean(obs)
## [1] -0.6883833
df_mean <- data.frame(a = obs, b = (obs- mean(obs))^2)
df_mean
##            a          b
## 1 -0.4954435 0.03722577
## 2 -1.4919928 0.64578826
## 3 -0.3771459 0.09686870
## 4 -0.3889509 0.08965974
sum(df_mean$b)*n*2
## [1] 6.95634
# sum(df_mean$b)/(n-1)
df_mean$b
## [1] 0.03722577 0.64578826 0.09686870 0.08965974
df$d2
##  [1] 0.0000000000 0.9931105363 0.0139943142 0.0113406651 0.9931105363
##  [6] 0.0000000000 1.2428835673 1.2167013740 0.0139943142 1.2428835673
## [11] 0.0000000000 0.0001393582 0.0113406651 1.2167013740 0.0001393582
## [16] 0.0000000000
sum(df$d2[1:4])
## [1] 1.018446
sum(df$d2[5:8]) 
## [1] 3.452695
sum(df$d2[9:12]) 
## [1] 1.257017
sum(df$d2[13:16]) 
## [1] 1.228181
sum( 
  sum(df$d2[1:4]) ,
sum(df$d2[5:8]) ,
sum(df$d2[9:12]) ,
sum(df$d2[13:16]) 
)
## [1] 6.95634
 df_mean$b * n *2 
## [1] 0.2978061 5.1663060 0.7749496 0.7172779
 sum( df_mean$b * n *2 )
## [1] 6.95634
 df_mean$b
## [1] 0.03722577 0.64578826 0.09686870 0.08965974
 sum(df$d2[1:4])/n^2
## [1] 0.06365284
 sum(df$d2[4:8])/n^2
## [1] 0.2165023
 sum(df$d2[9:12])/n^2
## [1] 0.07856358
 sum(df$d2[13:16])/n^2
## [1] 0.07676134
 c(
   sum(df$w[1:5])^2/n^2  ,
   sum(df$w[6:10])^2/n^2  ,
   sum(df$w[11:15])^2/n^2  ,
   sum(df$w[16:20])^2/n^2  ,
   sum(df$w[21:25])^2/n^2  
   
 )
## [1] 0 0 0 0 0
 df_mean$b
## [1] 0.03722577 0.64578826 0.09686870 0.08965974
 sum(df_mean$b)
## [1] 0.8695425

(x1 - (x1+x2+x3+x4+x5)/n)^2

(nx1 - x1-x2-x3-x4-x5)^2 /n^2 (nx2 - x1-x2-x3-x4-x5)^2 /n^2 (nx3 - x1-x2-x3-x4-x5)^2 /n^2 (nx4 - x1-x2-x3-x4-x5)^2 /n^2 (n*x5 - x1-x2-x3-x4-x5)^2 /n^2

(x1-x1 + x1-x2+ x1-x3+ x1-x4 + x1-x5)^2 /n^2 (x2-x1 + x2-x2+ x2-x3+ x2-x4 + x2-x5)^2 /n^2 (x3-x1 + x3-x2+ x3-x3+ x3-x4 + x3-x5)^2 /n^2

require(ggplot2)
## Ładowanie wymaganego pakietu: ggplot2
df$nnn <- 1:(n*n)

ggplot(df) + theme_bw() + 
ggplot2::geom_vline(xintercept = mean(obs),  colour = "grey") +
aes(y = nnn )  + 
geom_segment(aes(x = x, xend = y, yend = nnn )    ) +
geom_point(aes(x=x), colour = "red") + 
geom_point(aes(x=y), colour = "blue")

df_dodatnie <- df[df$x > df$y,]
df_dodatnie$nnn <- 1:(nrow(df_dodatnie)) 

ggplot(df_dodatnie) + theme_bw() + 
ggplot2::geom_vline(xintercept = mean(obs),  colour = "grey") +
aes(y = nnn )  + 
geom_segment(aes(x = x, xend = y, yend = nnn )    ) +
geom_point(aes(x=x), colour = "red") + 
geom_point(aes(x=y), colour = "blue")

ggplot(df_dodatnie) + theme_bw() + 
ggplot2::geom_vline(xintercept = mean(obs),  colour = "grey") +
aes(y = cumsum(d) )  + 
geom_segment(aes(x = x, xend = y, yend = cumsum(d) )    ) +
geom_point(aes(x=x), colour = "red") + 
geom_point(aes(x=y), colour = "blue") +
 coord_fixed(ratio = 1)  + 
geom_rect(aes(xmin = x, xmax = y, ymin =   cumsum(dplyr::lag(d, default = 0)), ymax = cumsum(d) ), alpha=0.4)

df_dodatnie$d2ms <- sqrt(mean(df_dodatnie$d2))


ggplot(df_dodatnie) + theme_bw() + 
ggplot2::geom_vline(xintercept = mean(obs),  colour = "grey") +
aes(y = cumsum(d2ms) )  + 
coord_fixed(ratio = 1)  + 
geom_segment(aes(x = -d2ms/2, xend = d2ms/2, yend = cumsum(d2ms) )    ) +
geom_rect(aes(xmin = -d2ms/2, xmax = +d2ms/2, ymin =   cumsum(dplyr::lag(d2ms, default = 0)), ymax = cumsum(d2ms) ), alpha=0.4)