Shell correlation

Vignette Author

2017-06-27

Get z at selected Ppr and Tpr

# get a z value using HY
library(zFactor)

z.Shell(pres.pr = 1.5, temp.pr = 2.0)
[1] 0.9785767

From the Standing-Katz chart we obtain a digitized point:

# get a z value from the SK chart at the same Ppr and Tpr
library(zFactor)

tpr_vec <- c(2.0)
getStandingKatzMatrix(tpr_vector = tpr_vec, 
                      pprRange = "lp")[1, "1.5"]
  1.5 
0.956 

Get z at selected Ppr and Tpr

library(zFactor)


z.Shell(pres.pr = 1.5, temp.pr = 1.1)
[1] 0.4816432

From the Standing-Katz chart we obtain a digitized point:

library(zFactor)

tpr_vec <- c(1.1)
getStandingKatzMatrix(tpr_vector = tpr_vec, 
                      pprRange = "lp")[1, "1.5"]
  1.5 
0.426 

We perceive a noticeable difference between the values of z from the HY calculation and the value read from the Standing-Katz chart.

Get values of z for several Ppr and Tpr

In this example we provide vectors instead of a single point.

library(zFactor)

ppr <- c(0.5, 1.5, 2.5, 3.5, 4.5, 5.5, 6.5) 
tpr <- c(1.3, 1.5, 1.7, 2) 


z.Shell(ppr, tpr)
          0.5       1.5       2.5       3.5       4.5       5.5       6.5
1.3 0.9178838 0.7518864 0.6451993 0.6256371 0.6803635 0.7638985 0.8502710
1.5 0.9495503 0.8508783 0.7833739 0.7606142 0.7780715 0.8232803 0.8839834
1.7 0.9710083 0.9144427 0.8728874 0.8549373 0.8616338 0.8890694 0.9314239
2   0.9929208 0.9785767 0.9681390 0.9652473 0.9718700 0.9884569 1.0143097

Which is equivalent to using the sapply function with the internal function .z.HallYarborough, which we call adding the prefix zFactor:::. That is, the package name and three dots.

# test HY with 1st-derivative using the values from paper 
 
ppr <- c(0.5, 1.5, 2.5, 3.5, 4.5, 5.5, 6.5) 
tpr <- c(1.3, 1.5, 1.7, 2) 
 
hy <- sapply(ppr, function(x)  
    sapply(tpr, function(y) zFactor:::.z.Shell(pres.pr = x, temp.pr = y))) 
 
rownames(hy) <- tpr 
colnames(hy) <- ppr 
print(hy) 
          0.5       1.5       2.5       3.5       4.5       5.5       6.5
1.3 0.9178838 0.7518864 0.6451993 0.6256371 0.6803635 0.7638985 0.8502710
1.5 0.9495503 0.8508783 0.7833739 0.7606142 0.7780715 0.8232803 0.8839834
1.7 0.9710083 0.9144427 0.8728874 0.8549373 0.8616338 0.8890694 0.9314239
2   0.9929208 0.9785767 0.9681390 0.9652473 0.9718700 0.9884569 1.0143097

With the same ppr and tpr vector, we do the same for the Standing-Katz chart:

library(zFactor)

sk <- getStandingKatzMatrix(ppr_vector = ppr, tpr_vector = tpr)
sk
       0.5   1.5   2.5   3.5   4.5   5.5   6.5
1.30 0.916 0.756 0.638 0.633 0.684 0.759 0.844
1.50 0.948 0.859 0.794 0.770 0.790 0.836 0.892
1.70 0.968 0.914 0.876 0.857 0.864 0.897 0.942
2.00 0.982 0.956 0.941 0.937 0.945 0.969 1.003

Subtract and find the difference:

err <- round((sk - hy) / sk * 100, 2)
err
       0.5   1.5   2.5   3.5   4.5   5.5   6.5
1.30 -0.21  0.54 -1.13  1.16  0.53 -0.65 -0.74
1.50 -0.16  0.95  1.34  1.22  1.51  1.52  0.90
1.70 -0.31 -0.05  0.36  0.24  0.27  0.88  1.12
2.00 -1.11 -2.36 -2.88 -3.01 -2.84 -2.01 -1.13

Error by Ppr and by PPr

print(colSums(err))
  0.5   1.5   2.5   3.5   4.5   5.5   6.5 
-1.79 -0.92 -2.31 -0.39 -0.53 -0.26  0.15 
print(rowSums(err))
  1.30   1.50   1.70   2.00 
 -0.50   7.28   2.51 -15.34 

Analyze the error for smaller values of Tpr

library(zFactor)

tpr2 <- c(1.05, 1.1) 
ppr2 <- c(0.5, 1.5, 2.5, 3.5, 4.5, 5.5) 

sk2 <- getStandingKatzMatrix(ppr_vector = ppr2, tpr_vector = tpr2, pprRange = "lp")
sk2
       0.5   1.5   2.5   3.5   4.5   5.5
1.05 0.829 0.253 0.343 0.471 0.598 0.727
1.10 0.854 0.426 0.393 0.500 0.615 0.729

We do the same with the correlation:

# calculate z values at lower values of Tpr
library(zFactor)

tpr <- c(1.05, 1.1)
ppr <- c(0.5, 1.5, 2.5, 3.5, 4.5, 5.5) 

corr2 <- z.Shell(pres.pr = ppr, temp.pr = tpr) 

print(corr2)
           0.5       1.5       2.5       3.5       4.5       5.5
1.05 0.8294221 0.3240119 0.3423544 0.4694593 0.5955314 0.7199048
1.1  0.8584285 0.4816432 0.3838066 0.4984101 0.6133854 0.7273952
err2 <- round((sk2 - corr2) / sk2 * 100, 2)
err2
       0.5    1.5  2.5  3.5  4.5  5.5
1.05 -0.05 -28.07 0.19 0.33 0.41 0.98
1.10 -0.52 -13.06 2.34 0.32 0.26 0.22

We can see that using Hall-Yarborough correlation shows a very high error at values of Tpr lower or equal than 1.1 being Tpr=1.05 the worst curve to calculate z values from.

t_err2 <- t(err2)
t_err2
      1.05   1.10
0.5  -0.05  -0.52
1.5 -28.07 -13.06
2.5   0.19   2.34
3.5   0.33   0.32
4.5   0.41   0.26
5.5   0.98   0.22

Applying the function summary:

sum_t_err2 <- summary(t_err2)
sum_t_err2
      1.05              1.10        
 Min.   :-28.070   Min.   :-13.060  
 1st Qu.:  0.010   1st Qu.: -0.335  
 Median :  0.260   Median :  0.240  
 Mean   : -4.368   Mean   : -1.740  
 3rd Qu.:  0.390   3rd Qu.:  0.305  
 Max.   :  0.980   Max.   :  2.340  

We can see that the errors in z are considerable with a Min. :-28.070 % and Max. : 0.980 % for Tpr=1.05, and a Min. :-13.060 % and Max. : 2.340 % for Tpr=1.10

Prepare to plot SK chart values vs HY correlation

library(zFactor)
library(tibble)

tpr2 <- c(1.05, 1.1, 1.2, 1.3) 
ppr2 <- c(0.5, 1.0, 1.5, 2, 2.5, 3.0, 3.5, 4.0, 4.5, 5.0, 5.5, 6.0, 6.5) 

sk_corr_2 <- createTidyFromMatrix(ppr2, tpr2, correlation = "SH")
as.tibble(sk_corr_2)
# A tibble: 52 x 5
     Tpr   Ppr z.chart    z.calc           dif
   <chr> <dbl>   <dbl>     <dbl>         <dbl>
 1  1.05   0.5   0.829 0.8294221 -0.0004221265
 2   1.1   0.5   0.854 0.8584285 -0.0044285193
 3   1.2   0.5   0.893 0.8943922 -0.0013922130
 4   1.3   0.5   0.916 0.9178838 -0.0018837657
 5  1.05   1.0   0.589 0.5827255  0.0062744847
 6   1.1   1.0   0.669 0.6787470 -0.0097470141
 7   1.2   1.0   0.779 0.7770740  0.0019259690
 8   1.3   1.0   0.835 0.8310296  0.0039703927
 9  1.05   1.5   0.253 0.3240119 -0.0710119239
10   1.1   1.5   0.426 0.4816432 -0.0556431731
# ... with 42 more rows

Plotting the difference between the z values in the Standing-Katz and the values calculated by Hall-Yarborough:

library(ggplot2)

p <- ggplot(sk_corr_2, aes(x=Ppr, y=z.calc, group=Tpr, color=Tpr)) +
    geom_line() +
    geom_point() +
    geom_errorbar(aes(ymin=z.calc-dif, ymax=z.calc+dif), width=.4,
                  position=position_dodge(0.05))
print(p)

Analyzing the error for all the Tpr curves

library(zFactor)
library(ggplot2)
library(tibble)

# get all `lp` Tpr curves
tpr_all <- getCurvesDigitized(pprRange = "lp")
ppr <- c(0.5, 1.5, 2.5, 3.5, 4.5, 5.5, 6.5) 

sk_corr_all <- createTidyFromMatrix(ppr, tpr_all, correlation = "SH")
as.tibble(sk_corr_all)

p <- ggplot(sk_corr_all, aes(x=Ppr, y=z.calc, group=Tpr, color=Tpr)) +
    geom_line() +
    geom_point() +
    geom_errorbar(aes(ymin=z.calc-dif, ymax=z.calc+dif), width=.4,
                  position=position_dodge(0.05))
print(p)

# A tibble: 112 x 5
     Tpr   Ppr z.chart    z.calc           dif
   <chr> <dbl>   <dbl>     <dbl>         <dbl>
 1  1.05   0.5   0.829 0.8294221 -0.0004221265
 2   1.1   0.5   0.854 0.8584285 -0.0044285193
 3   1.2   0.5   0.893 0.8943922 -0.0013922130
 4   1.3   0.5   0.916 0.9178838 -0.0018837657
 5   1.4   0.5   0.936 0.9354852  0.0005147804
 6   1.5   0.5   0.948 0.9495503 -0.0015502871
 7   1.6   0.5   0.959 0.9611852 -0.0021852045
 8   1.7   0.5   0.968 0.9710083 -0.0030082959
 9   1.8   0.5   0.974 0.9794076 -0.0054076310
10   1.9   0.5   0.978 0.9866478 -0.0086478046
# ... with 102 more rows

The greatest errors are localized in two of the Tpr curves: at 1.05 and 1.1

# MSE: Mean Squared Error
# RMSE: Root Mean Sqyared Error
# RSS: residual sum of square
# ARE:  Average Relative Error, %
# AARE: Average Absolute Relative Error, %
library(dplyr)
grouped <- group_by(sk_corr_all, Tpr, Ppr)
smry_tpr_ppr <- summarise(grouped, 
          RMSE= sqrt(mean((z.chart-z.calc)^2)), 
          MSE = sum((z.calc - z.chart)^2) / n(), 
          RSS = sum((z.calc - z.chart)^2),
          ARE = sum((z.calc - z.chart) / z.chart) * 100 / n(),
          AARE = sum( abs((z.calc - z.chart) / z.chart)) * 100 / n()
          )

ggplot(smry_tpr_ppr, aes(Ppr, Tpr)) + 
    geom_tile(data=smry_tpr_ppr, aes(fill=AARE), color="white") +
    scale_fill_gradient2(low="blue", high="red", mid="yellow", na.value = "pink",
                         midpoint=12.5, limit=c(0, 25), name="AARE") + 
    theme(axis.text.x = element_text(angle=45, vjust=1, size=11, hjust=1)) + 
    coord_equal() +
    ggtitle("Shell", subtitle = "SH")

Looking numerically at the errors

# get all `lp` Tpr curves
tpr <- getCurvesDigitized(pprRange = "lp")
ppr <- c(0.5, 1.5, 2.5, 3.5, 4.5, 5.5, 6.5) 

# calculate HY for the given Tpr
all_corr <- sapply(ppr, function(x)  
    sapply(tpr, function(y) z.Shell(pres.pr = x, temp.pr = y))) 

rownames(all_corr) <- tpr 
colnames(all_corr) <- ppr 
cat("Calculated correlation\n")
print(all_corr) 

cat("\nStanding-Katz chart\n")
all_sk <- getStandingKatzMatrix(ppr_vector = ppr, tpr_vector = tpr)
all_sk

# find the error
cat("\n Errors in percentage \n")
all_err <- round((all_sk - all_corr) / all_sk * 100, 2)  # in percentage
all_err

cat("\n Errors in Ppr\n")
summary(all_err)

# for the transposed matrix
cat("\n Errors for the transposed matrix: Tpr \n")
summary(t(all_err))
Calculated correlation
           0.5       1.5       2.5       3.5       4.5       5.5       6.5
1.05 0.8294221 0.3240119 0.3423544 0.4694593 0.5955314 0.7199048 0.8417472
1.1  0.8584285 0.4816432 0.3838066 0.4984101 0.6133854 0.7273952 0.8399666
1.2  0.8943922 0.6648553 0.5151372 0.5486504 0.6458856 0.7439699 0.8415896
1.3  0.9178838 0.7518864 0.6451993 0.6256371 0.6803635 0.7638985 0.8502710
1.4  0.9354852 0.8081121 0.7247708 0.7021065 0.7304906 0.7904217 0.8641045
1.5  0.9495503 0.8508783 0.7833739 0.7606142 0.7780715 0.8232803 0.8839834
1.6  0.9611852 0.8855205 0.8316268 0.8104459 0.8210864 0.8561318 0.9068328
1.7  0.9710083 0.9144427 0.8728874 0.8549373 0.8616338 0.8890694 0.9314239
1.8  0.9794076 0.9390340 0.9087579 0.8951898 0.9002186 0.9222033 0.9576280
1.9  0.9866478 0.9602009 0.9402627 0.9318069 0.9369389 0.9553795 0.9852958
2    0.9929208 0.9785767 0.9681390 0.9652473 0.9718700 0.9884569 1.0143097
2.2  1.0031184 1.0087024 1.0151173 1.0240698 1.0368088 1.0541013 1.0762644
2.4  1.0108525 1.0320007 1.0529024 1.0741069 1.0960954 1.1192683 1.1439377
2.6  1.0167087 1.0501519 1.0836518 1.1172342 1.1509230 1.1847409 1.2187090
2.8  1.0211227 1.0643599 1.1089595 1.1549926 1.2025594 1.2517920 1.3028590
3    1.0244369 1.0755584 1.1301093 1.1887613 1.2524060 1.3222220 1.3997691

Standing-Katz chart
       0.5   1.5   2.5   3.5   4.5   5.5   6.5
1.05 0.829 0.253 0.343 0.471 0.598 0.727 0.846
1.10 0.854 0.426 0.393 0.500 0.615 0.729 0.841
1.20 0.893 0.657 0.519 0.565 0.650 0.741 0.841
1.30 0.916 0.756 0.638 0.633 0.684 0.759 0.844
1.40 0.936 0.816 0.727 0.705 0.734 0.792 0.865
1.50 0.948 0.859 0.794 0.770 0.790 0.836 0.892
1.60 0.959 0.888 0.839 0.816 0.829 0.868 0.918
1.70 0.968 0.914 0.876 0.857 0.864 0.897 0.942
1.80 0.974 0.933 0.905 0.891 0.901 0.929 0.967
1.90 0.978 0.945 0.924 0.916 0.924 0.949 0.985
2.00 0.982 0.956 0.941 0.937 0.945 0.969 1.003
2.20 0.989 0.973 0.963 0.963 0.976 1.000 1.029
2.40 0.993 0.984 0.980 0.983 0.999 1.023 1.049
2.60 0.997 0.994 0.994 1.000 1.016 1.038 1.062
2.80 0.999 1.002 1.008 1.016 1.030 1.049 1.069
3.00 1.002 1.009 1.018 1.029 1.041 1.056 1.075

 Errors in percentage 
       0.5    1.5    2.5    3.5    4.5    5.5    6.5
1.05 -0.05 -28.07   0.19   0.33   0.41   0.98   0.50
1.10 -0.52 -13.06   2.34   0.32   0.26   0.22   0.12
1.20 -0.16  -1.20   0.74   2.89   0.63  -0.40  -0.07
1.30 -0.21   0.54  -1.13   1.16   0.53  -0.65  -0.74
1.40  0.05   0.97   0.31   0.41   0.48   0.20   0.10
1.50 -0.16   0.95   1.34   1.22   1.51   1.52   0.90
1.60 -0.23   0.28   0.88   0.68   0.95   1.37   1.22
1.70 -0.31  -0.05   0.36   0.24   0.27   0.88   1.12
1.80 -0.56  -0.65  -0.42  -0.47   0.09   0.73   0.97
1.90 -0.88  -1.61  -1.76  -1.73  -1.40  -0.67  -0.03
2.00 -1.11  -2.36  -2.88  -3.01  -2.84  -2.01  -1.13
2.20 -1.43  -3.67  -5.41  -6.34  -6.23  -5.41  -4.59
2.40 -1.80  -4.88  -7.44  -9.27  -9.72  -9.41  -9.05
2.60 -1.98  -5.65  -9.02 -11.72 -13.28 -14.14 -14.76
2.80 -2.21  -6.22 -10.02 -13.68 -16.75 -19.33 -21.88
3.00 -2.24  -6.60 -11.01 -15.53 -20.31 -25.21 -30.21

 Errors in Ppr
      0.5               1.5                2.5               3.5          
 Min.   :-2.2400   Min.   :-28.0700   Min.   :-11.010   Min.   :-15.5300  
 1st Qu.:-1.5225   1st Qu.: -5.7925   1st Qu.: -5.918   1st Qu.: -7.0725  
 Median :-0.5400   Median : -1.9850   Median : -0.775   Median : -0.1150  
 Mean   :-0.8625   Mean   : -4.4550   Mean   : -2.683   Mean   : -3.4062  
 3rd Qu.:-0.1975   3rd Qu.:  0.0325   3rd Qu.:  0.455   3rd Qu.:  0.4775  
 Max.   : 0.0500   Max.   :  0.9700   Max.   :  2.340   Max.   :  2.8900  
      4.5                5.5                6.5         
 Min.   :-20.3100   Min.   :-25.2100   Min.   :-30.210  
 1st Qu.: -7.1025   1st Qu.: -6.4100   1st Qu.: -5.705  
 Median :  0.1750   Median : -0.5250   Median : -0.050  
 Mean   : -4.0875   Mean   : -4.4581   Mean   : -4.846  
 3rd Qu.:  0.4925   3rd Qu.:  0.7675   3rd Qu.:  0.600  
 Max.   :  1.5100   Max.   :  1.5200   Max.   :  1.220  

 Errors for the transposed matrix: Tpr 
      1.05              1.10              1.20              1.30         
 Min.   :-28.070   Min.   :-13.060   Min.   :-1.2000   Min.   :-1.13000  
 1st Qu.:  0.070   1st Qu.: -0.200   1st Qu.:-0.2800   1st Qu.:-0.69500  
 Median :  0.330   Median :  0.220   Median :-0.0700   Median :-0.21000  
 Mean   : -3.673   Mean   : -1.474   Mean   : 0.3471   Mean   :-0.07143  
 3rd Qu.:  0.455   3rd Qu.:  0.290   3rd Qu.: 0.6850   3rd Qu.: 0.53500  
 Max.   :  0.980   Max.   :  2.340   Max.   : 2.8900   Max.   : 1.16000  
      1.40            1.50             1.60              1.70        
 Min.   :0.050   Min.   :-0.160   Min.   :-0.2300   Min.   :-0.3100  
 1st Qu.:0.150   1st Qu.: 0.925   1st Qu.: 0.4800   1st Qu.: 0.0950  
 Median :0.310   Median : 1.220   Median : 0.8800   Median : 0.2700  
 Mean   :0.360   Mean   : 1.040   Mean   : 0.7357   Mean   : 0.3586  
 3rd Qu.:0.445   3rd Qu.: 1.425   3rd Qu.: 1.0850   3rd Qu.: 0.6200  
 Max.   :0.970   Max.   : 1.520   Max.   : 1.3700   Max.   : 1.1200  
      1.80               1.90             2.00             2.20       
 Min.   :-0.65000   Min.   :-1.760   Min.   :-3.010   Min.   :-6.340  
 1st Qu.:-0.51500   1st Qu.:-1.670   1st Qu.:-2.860   1st Qu.:-5.820  
 Median :-0.42000   Median :-1.400   Median :-2.360   Median :-5.410  
 Mean   :-0.04429   Mean   :-1.154   Mean   :-2.191   Mean   :-4.726  
 3rd Qu.: 0.41000   3rd Qu.:-0.775   3rd Qu.:-1.570   3rd Qu.:-4.130  
 Max.   : 0.97000   Max.   :-0.030   Max.   :-1.110   Max.   :-1.430  
      2.40             2.60              2.80             3.00        
 Min.   :-9.720   Min.   :-14.760   Min.   :-21.88   Min.   :-30.210  
 1st Qu.:-9.340   1st Qu.:-13.710   1st Qu.:-18.04   1st Qu.:-22.760  
 Median :-9.050   Median :-11.720   Median :-13.68   Median :-15.530  
 Mean   :-7.367   Mean   :-10.079   Mean   :-12.87   Mean   :-15.873  
 3rd Qu.:-6.160   3rd Qu.: -7.335   3rd Qu.: -8.12   3rd Qu.: -8.805  
 Max.   :-1.800   Max.   : -1.980   Max.   : -2.21   Max.   : -2.240