Shell correlation

Vignette Author

2017-06-28

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.9788911

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.4869976

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.9183713 0.7543948 0.6481600 0.6270891 0.6805765 0.7639026 0.8502710
1.5 0.9497469 0.8520454 0.7852495 0.7624706 0.7794104 0.8240209 0.8842996
1.7 0.9711067 0.9150837 0.8740757 0.8563697 0.8629757 0.8901157 0.9321262
2   0.9929641 0.9788911 0.9688153 0.9662328 0.9730328 0.9896472 1.0154033

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.9183713 0.7543948 0.6481600 0.6270891 0.6805765 0.7639026 0.8502710
1.5 0.9497469 0.8520454 0.7852495 0.7624706 0.7794104 0.8240209 0.8842996
1.7 0.9711067 0.9150837 0.8740757 0.8563697 0.8629757 0.8901157 0.9321262
2   0.9929641 0.9788911 0.9688153 0.9662328 0.9730328 0.9896472 1.0154033

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.26  0.21 -1.59  0.93  0.50 -0.65 -0.74
1.50 -0.18  0.81  1.10  0.98  1.34  1.43  0.86
1.70 -0.32 -0.12  0.22  0.07  0.12  0.77  1.05
2.00 -1.12 -2.39 -2.96 -3.12 -2.97 -2.13 -1.24

Error by Ppr and by PPr

print(colSums(err))
  0.5   1.5   2.5   3.5   4.5   5.5   6.5 
-1.88 -1.49 -3.23 -1.14 -1.01 -0.58 -0.07 
print(rowSums(err))
  1.30   1.50   1.70   2.00 
 -1.60   6.34   1.79 -15.93 

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.8326386 0.3283475 0.3423544 0.4694593 0.5955314 0.7199048
1.1  0.8603678 0.4869976 0.3838746 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.44 -29.78 0.19 0.33 0.41 0.98
1.10 -0.75 -14.32 2.32 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.44  -0.75
1.5 -29.78 -14.32
2.5   0.19   2.32
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.   :-29.7800   Min.   :-14.3200  
 1st Qu.: -0.2825   1st Qu.: -0.5075  
 Median :  0.2600   Median :  0.2400  
 Mean   : -4.7183   Mean   : -1.9917  
 3rd Qu.:  0.3900   3rd Qu.:  0.3050  
 Max.   :  0.9800   Max.   :  2.3200  

We can see that the errors in z are considerable with a Min. :-29.7800 % and Max. : 0.9800 % for Tpr=1.05, and a Min. :-14.3200 % and Max. : 2.3200 % 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.8326386 -0.0036386379
 2   1.1   0.5   0.854 0.8603678 -0.0063677545
 3   1.2   0.5   0.893 0.8952802 -0.0022801812
 4   1.3   0.5   0.916 0.9183713 -0.0023713210
 5  1.05   1.0   0.589 0.5902581 -0.0012581169
 6   1.1   1.0   0.669 0.6839190 -0.0149190357
 7   1.2   1.0   0.779 0.7797105 -0.0007104794
 8   1.3   1.0   0.835 0.8325494  0.0024506149
 9  1.05   1.5   0.253 0.3283475 -0.0753475126
10   1.1   1.5   0.426 0.4869976 -0.0609975876
# ... 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.8326386 -0.0036386379
 2   1.1   0.5   0.854 0.8603678 -0.0063677545
 3   1.2   0.5   0.893 0.8952802 -0.0022801812
 4   1.3   0.5   0.916 0.9183713 -0.0023713210
 5   1.4   0.5   0.936 0.9357838  0.0002162375
 6   1.5   0.5   0.948 0.9497469 -0.0017468881
 7   1.6   0.5   0.959 0.9613216 -0.0023215848
 8   1.7   0.5   0.968 0.9711067 -0.0031066681
 9   1.8   0.5   0.974 0.9794808 -0.0054807773
10   1.9   0.5   0.978 0.9867035 -0.0087035343
# ... 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.8326386 0.3283475 0.3423544 0.4694593 0.5955314 0.7199048 0.8417472
1.1  0.8603678 0.4869976 0.3838746 0.4984101 0.6133854 0.7273952 0.8399666
1.2  0.8952802 0.6687882 0.5174626 0.5487317 0.6458856 0.7439699 0.8415896
1.3  0.9183713 0.7543948 0.6481600 0.6270891 0.6805765 0.7639026 0.8502710
1.4  0.9357838 0.8097802 0.7271788 0.7040931 0.7315325 0.7907497 0.8641572
1.5  0.9497469 0.8520454 0.7852495 0.7624706 0.7794104 0.8240209 0.8842996
1.6  0.9613216 0.8863715 0.8331061 0.8120822 0.8224613 0.8570695 0.9073678
1.7  0.9711067 0.9150837 0.8740757 0.8563697 0.8629757 0.8901157 0.9321262
1.8  0.9794808 0.9395295 0.9097288 0.8964473 0.9015059 0.9233190 0.9584750
1.9  0.9867035 0.9605922 0.9410678 0.9329169 0.9381644 0.9565406 0.9862724
2    0.9929641 0.9788911 0.9688153 0.9662328 0.9730328 0.9896472 1.0154033
2.2  1.0031459 1.0089143 1.0156106 1.0248610 1.0378540 1.0553199 1.0775617
2.4  1.0108707 1.0321501 1.0532754 1.0747568 1.0970399 1.1204950 1.1454111
2.6  1.0167213 1.0502610 1.0839424 1.1177793 1.1517845 1.1859696 1.2203452
2.8  1.0211317 1.0644420 1.1091916 1.1554588 1.2033542 1.2530243 1.3046568
3    1.0244435 1.0756217 1.1302991 1.1891676 1.2531487 1.3234649 1.4017387

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.44 -29.78   0.19   0.33   0.41   0.98   0.50
1.10 -0.75 -14.32   2.32   0.32   0.26   0.22   0.12
1.20 -0.26  -1.79   0.30   2.88   0.63  -0.40  -0.07
1.30 -0.26   0.21  -1.59   0.93   0.50  -0.65  -0.74
1.40  0.02   0.76  -0.02   0.13   0.34   0.16   0.10
1.50 -0.18   0.81   1.10   0.98   1.34   1.43   0.86
1.60 -0.24   0.18   0.70   0.48   0.79   1.26   1.16
1.70 -0.32  -0.12   0.22   0.07   0.12   0.77   1.05
1.80 -0.56  -0.70  -0.52  -0.61  -0.06   0.61   0.88
1.90 -0.89  -1.65  -1.85  -1.85  -1.53  -0.79  -0.13
2.00 -1.12  -2.39  -2.96  -3.12  -2.97  -2.13  -1.24
2.20 -1.43  -3.69  -5.46  -6.42  -6.34  -5.53  -4.72
2.40 -1.80  -4.89  -7.48  -9.33  -9.81  -9.53  -9.19
2.60 -1.98  -5.66  -9.05 -11.78 -13.36 -14.26 -14.91
2.80 -2.22  -6.23 -10.04 -13.73 -16.83 -19.45 -22.04
3.00 -2.24  -6.60 -11.03 -15.57 -20.38 -25.33 -30.39

 Errors in Ppr
      0.5               1.5               2.5               3.5          
 Min.   :-2.2400   Min.   :-29.780   Min.   :-11.030   Min.   :-15.5700  
 1st Qu.:-1.5225   1st Qu.: -5.803   1st Qu.: -5.965   1st Qu.: -7.1475  
 Median :-0.6550   Median : -2.090   Median : -1.055   Median : -0.2700  
 Mean   :-0.9169   Mean   : -4.741   Mean   : -2.823   Mean   : -3.5181  
 3rd Qu.:-0.2600   3rd Qu.: -0.045   3rd Qu.:  0.240   3rd Qu.:  0.3675  
 Max.   : 0.0200   Max.   :  0.810   Max.   :  2.320   Max.   :  2.8800  
      4.5                5.5               6.5         
 Min.   :-20.3800   Min.   :-25.330   Min.   :-30.390  
 1st Qu.: -7.2075   1st Qu.: -6.530   1st Qu.: -5.838  
 Median :  0.0300   Median : -0.525   Median : -0.100  
 Mean   : -4.1806   Mean   : -4.540   Mean   : -4.923  
 3rd Qu.:  0.4325   3rd Qu.:  0.650   3rd Qu.:  0.590  
 Max.   :  1.3400   Max.   :  1.430   Max.   :  1.160  

 Errors for the transposed matrix: Tpr 
      1.05              1.10              1.20              1.30        
 Min.   :-29.780   Min.   :-14.320   Min.   :-1.7900   Min.   :-1.5900  
 1st Qu.: -0.125   1st Qu.: -0.315   1st Qu.:-0.3300   1st Qu.:-0.6950  
 Median :  0.330   Median :  0.220   Median :-0.0700   Median :-0.2600  
 Mean   : -3.973   Mean   : -1.690   Mean   : 0.1843   Mean   :-0.2286  
 3rd Qu.:  0.455   3rd Qu.:  0.290   3rd Qu.: 0.4650   3rd Qu.: 0.3550  
 Max.   :  0.980   Max.   :  2.320   Max.   : 2.8800   Max.   : 0.9300  
      1.40              1.50              1.60              1.70        
 Min.   :-0.0200   Min.   :-0.1800   Min.   :-0.2400   Min.   :-0.3200  
 1st Qu.: 0.0600   1st Qu.: 0.8350   1st Qu.: 0.3300   1st Qu.:-0.0250  
 Median : 0.1300   Median : 0.9800   Median : 0.7000   Median : 0.1200  
 Mean   : 0.2129   Mean   : 0.9057   Mean   : 0.6186   Mean   : 0.2557  
 3rd Qu.: 0.2500   3rd Qu.: 1.2200   3rd Qu.: 0.9750   3rd Qu.: 0.4950  
 Max.   : 0.7600   Max.   : 1.4300   Max.   : 1.2600   Max.   : 1.0500  
      1.80              1.90             2.00             2.20       
 Min.   :-0.7000   Min.   :-1.850   Min.   :-3.120   Min.   :-6.420  
 1st Qu.:-0.5850   1st Qu.:-1.750   1st Qu.:-2.965   1st Qu.:-5.935  
 Median :-0.5200   Median :-1.530   Median :-2.390   Median :-5.460  
 Mean   :-0.1371   Mean   :-1.241   Mean   :-2.276   Mean   :-4.799  
 3rd Qu.: 0.2750   3rd Qu.:-0.840   3rd Qu.:-1.685   3rd Qu.:-4.205  
 Max.   : 0.8800   Max.   :-0.130   Max.   :-1.120   Max.   :-1.430  
      2.40             2.60              2.80              3.00        
 Min.   :-9.810   Min.   :-14.910   Min.   :-22.040   Min.   :-30.390  
 1st Qu.:-9.430   1st Qu.:-13.810   1st Qu.:-18.140   1st Qu.:-22.855  
 Median :-9.190   Median :-11.780   Median :-13.730   Median :-15.570  
 Mean   :-7.433   Mean   :-10.143   Mean   :-12.934   Mean   :-15.934  
 3rd Qu.:-6.185   3rd Qu.: -7.355   3rd Qu.: -8.135   3rd Qu.: -8.815  
 Max.   :-1.800   Max.   : -1.980   Max.   : -2.220   Max.   : -2.240