We will convert K_core calculated to a log scale due to the high costs of direct scaling from core samples

Firstly, importing data…

data_1 <- read.csv("karpur.csv")
data_1$phi.core = data_1$phi.core / 100   #convert phi to fraction
summary(data_1)
     depth         caliper         ind.deep          ind.med       
 Min.   :5667   Min.   :8.487   Min.   :  6.532   Min.   :  9.386  
 1st Qu.:5769   1st Qu.:8.556   1st Qu.: 28.799   1st Qu.: 27.892  
 Median :5872   Median :8.588   Median :217.849   Median :254.383  
 Mean   :5873   Mean   :8.622   Mean   :275.357   Mean   :273.357  
 3rd Qu.:5977   3rd Qu.:8.686   3rd Qu.:566.793   3rd Qu.:544.232  
 Max.   :6083   Max.   :8.886   Max.   :769.484   Max.   :746.028  
     gamma            phi.N            R.deep            R.med        
 Min.   : 16.74   Min.   :0.0150   Min.   :  1.300   Min.   :  1.340  
 1st Qu.: 40.89   1st Qu.:0.2030   1st Qu.:  1.764   1st Qu.:  1.837  
 Median : 51.37   Median :0.2450   Median :  4.590   Median :  3.931  
 Mean   : 53.42   Mean   :0.2213   Mean   : 24.501   Mean   : 21.196  
 3rd Qu.: 62.37   3rd Qu.:0.2640   3rd Qu.: 34.724   3rd Qu.: 35.853  
 Max.   :112.40   Max.   :0.4100   Max.   :153.085   Max.   :106.542  
       SP          density.corr          density         phi.core     
 Min.   :-73.95   Min.   :-0.067000   Min.   :1.758   Min.   :0.1570  
 1st Qu.:-42.01   1st Qu.:-0.016000   1st Qu.:2.023   1st Qu.:0.2390  
 Median :-32.25   Median :-0.007000   Median :2.099   Median :0.2760  
 Mean   :-30.98   Mean   :-0.008883   Mean   :2.102   Mean   :0.2693  
 3rd Qu.:-19.48   3rd Qu.: 0.002000   3rd Qu.:2.181   3rd Qu.:0.3070  
 Max.   : 25.13   Max.   : 0.089000   Max.   :2.387   Max.   :0.3630  
     k.core            Facies         
 Min.   :    0.42   Length:819        
 1st Qu.:  657.33   Class :character  
 Median : 1591.22   Mode  :character  
 Mean   : 2251.91                     
 3rd Qu.: 3046.82                     
 Max.   :15600.00                     
plot (data_1$phi.N , data_1$phi.core , xlab = "Porosity log" , ylab = "Porosity core")

We will be using simple linear regression between phi_core and phi_log with facies.

porosity_model = lm(phi.core ~ phi.N + Facies - 1 , data = data_1)
summary(porosity_model)

Call:
lm(formula = phi.core ~ phi.N + Facies - 1, data = data_1)

Residuals:
      Min        1Q    Median        3Q       Max 
-0.103530 -0.011573 -0.000206  0.010463  0.102852 

Coefficients:
          Estimate Std. Error t value Pr(>|t|)    
phi.N     0.013364   0.018060    0.74     0.46    
FaciesF1  0.314805   0.002777  113.37   <2e-16 ***
FaciesF10 0.207680   0.005072   40.95   <2e-16 ***
FaciesF2  0.175233   0.009390   18.66   <2e-16 ***
FaciesF3  0.231939   0.004955   46.81   <2e-16 ***
FaciesF5  0.272953   0.003914   69.74   <2e-16 ***
FaciesF7  0.225164   0.008730   25.79   <2e-16 ***
FaciesF8  0.305884   0.005019   60.94   <2e-16 ***
FaciesF9  0.264448   0.004825   54.81   <2e-16 ***
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Residual standard error: 0.02326 on 810 degrees of freedom
Multiple R-squared:  0.9928,    Adjusted R-squared:  0.9928 
F-statistic: 1.246e+04 on 9 and 810 DF,  p-value: < 2.2e-16

we can predict in the phi_core corrected to phi_log.

PhiCore_corrected <- predict(porosity_model , data_1)
permeability_model <- lm (k.core ~ PhiCore_corrected + Facies - 1 , data = data_1)
summary(permeability_model)

Call:
lm(formula = k.core ~ PhiCore_corrected + Facies - 1, data = data_1)

Residuals:
    Min      1Q  Median      3Q     Max 
-5613.4  -596.9  -130.3   475.0 10449.1 

Coefficients:
                  Estimate Std. Error t value Pr(>|t|)    
PhiCore_corrected  -412352      89814  -4.591 5.11e-06 ***
FaciesF1            132659      28386   4.673 3.47e-06 ***
FaciesF10            87869      18969   4.632 4.21e-06 ***
FaciesF2             73980      16049   4.610 4.69e-06 ***
FaciesF3             97910      21087   4.643 4.00e-06 ***
FaciesF5            118916      24729   4.809 1.81e-06 ***
FaciesF7             95868      20496   4.677 3.40e-06 ***
FaciesF8            130990      27786   4.714 2.86e-06 ***
FaciesF9            111324      24050   4.629 4.28e-06 ***
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Residual standard error: 1546 on 810 degrees of freedom
Multiple R-squared:  0.7652,    Adjusted R-squared:  0.7626 
F-statistic: 293.2 on 9 and 810 DF,  p-value: < 2.2e-16

predict the K_core corrected to log scale.

Kcore_corrected <- predict(permeability_model , data_1)

plotting phi_core , phi_log , phi_corrected.

par(mfrow = c(1,4))

boxplot(depth ~ Facies, data = df, ylim = rev(c(5667,6083)) , col = "blue")
plot(data_1$phi.N, data_1$depth, ylim = rev(c(5667,6083)), xlim = c(0.01,0.5), type = "l", ylab = "depth" , xlab = "Phi log", lwd = 2 , col = "green" )
grid()
plot(data_1$phi.core, data_1$depth, ylim = rev(c(5667,6083)), xlim = c(0.1,0.4), type = "l", ylab = "depth" , xlab = "Phi Core", lwd = 2, col = "green" )
grid()
plot(PhiCore_corrected, data_1$depth, ylim = rev(c(5667,6083)), xlim = c(0.1,0.4), type = "l", ylab = "depth" , xlab = "Corrected Phi log", lwd = 2 , col = "green")
grid()

plotting K_core , K_corrected.

par(mfrow = c (1,3))

boxplot(depth ~ Facies, data = data_1, ylim = rev(c(5667,6083)) , col = "blue")
plot(data_1$k.core, df$depth, ylim = rev(c(5667,6083)), xlim = c(0.4,16000), type = "l", ylab = "depth m" , xlab = "K core", lwd = 2 , col = "red" )
grid()
plot(Kcore_corrected, data_1$depth, ylim = rev(c(5667,6083)), xlim = c(0.4,6000), type = "l", ylab = "depth m" , xlab = "Corrected K core", lwd = 2 , col = "red")
grid()

LS0tDQp0aXRsZTogIlNMRyBvZiBDb3JyZWN0aW9uIFNjYWxlIG9mIEtfQ29yZSINCmF1dGhvcjogIk5vb3IgUml5YWRoIE1vaGFtbWVkIg0KZGF0ZTogIjE0IE9jdG9ib2VyIDIwMjQiDQpvdXRwdXQ6IGh0bWxfbm90ZWJvb2sNCi0tLQ0KDQpXZSB3aWxsIGNvbnZlcnQgS19jb3JlIGNhbGN1bGF0ZWQgdG8gYSBsb2cgc2NhbGUgZHVlIHRvIHRoZSBoaWdoIGNvc3RzIG9mIGRpcmVjdCBzY2FsaW5nIGZyb20gY29yZSBzYW1wbGVzDQoNCkZpcnN0bHksIGltcG9ydGluZyBkYXRhLi4uDQoNCmBgYHtyfQ0KZGF0YV8xIDwtIHJlYWQuY3N2KCJrYXJwdXIuY3N2IikNCmRhdGFfMSRwaGkuY29yZSA9IGRhdGFfMSRwaGkuY29yZSAvIDEwMCAgICNjb252ZXJ0IHBoaSB0byBmcmFjdGlvbg0Kc3VtbWFyeShkYXRhXzEpDQpgYGANCg0KYGBge3J9DQpwbG90IChkYXRhXzEkcGhpLk4gLCBkYXRhXzEkcGhpLmNvcmUgLCB4bGFiID0gIlBvcm9zaXR5IGxvZyIgLCB5bGFiID0gIlBvcm9zaXR5IGNvcmUiKQ0KYGBgDQoNCldlIHdpbGwgYmUgdXNpbmcgc2ltcGxlIGxpbmVhciByZWdyZXNzaW9uIGJldHdlZW4gcGhpX2NvcmUgYW5kIHBoaV9sb2cgd2l0aCBmYWNpZXMuDQoNCmBgYHtyfQ0KcG9yb3NpdHlfbW9kZWwgPSBsbShwaGkuY29yZSB+IHBoaS5OICsgRmFjaWVzIC0gMSAsIGRhdGEgPSBkYXRhXzEpDQpzdW1tYXJ5KHBvcm9zaXR5X21vZGVsKQ0KYGBgDQoNCndlIGNhbiBwcmVkaWN0IGluIHRoZSBwaGlfY29yZSBjb3JyZWN0ZWQgdG8gcGhpX2xvZy4NCg0KYGBge3J9DQpQaGlDb3JlX2NvcnJlY3RlZCA8LSBwcmVkaWN0KHBvcm9zaXR5X21vZGVsICwgZGF0YV8xKQ0KDQpgYGANCg0KYGBge3J9DQpwZXJtZWFiaWxpdHlfbW9kZWwgPC0gbG0gKGsuY29yZSB+IFBoaUNvcmVfY29ycmVjdGVkICsgRmFjaWVzIC0gMSAsIGRhdGEgPSBkYXRhXzEpDQpzdW1tYXJ5KHBlcm1lYWJpbGl0eV9tb2RlbCkNCmBgYA0KDQpwcmVkaWN0IHRoZSBLX2NvcmUgY29ycmVjdGVkIHRvIGxvZyBzY2FsZS4NCg0KYGBge3J9DQpLY29yZV9jb3JyZWN0ZWQgPC0gcHJlZGljdChwZXJtZWFiaWxpdHlfbW9kZWwgLCBkYXRhXzEpDQoNCmBgYA0KDQpwbG90dGluZyBwaGlfY29yZSAsIHBoaV9sb2cgLCBwaGlfY29ycmVjdGVkLg0KDQpgYGB7cn0NCnBhcihtZnJvdyA9IGMoMSw0KSkNCg0KYm94cGxvdChkZXB0aCB+IEZhY2llcywgZGF0YSA9IGRmLCB5bGltID0gcmV2KGMoNTY2Nyw2MDgzKSkgLCBjb2wgPSAiYmx1ZSIpDQpwbG90KGRhdGFfMSRwaGkuTiwgZGF0YV8xJGRlcHRoLCB5bGltID0gcmV2KGMoNTY2Nyw2MDgzKSksIHhsaW0gPSBjKDAuMDEsMC41KSwgdHlwZSA9ICJsIiwgeWxhYiA9ICJkZXB0aCIgLCB4bGFiID0gIlBoaSBsb2ciLCBsd2QgPSAyICwgY29sID0gImdyZWVuIiApDQpncmlkKCkNCnBsb3QoZGF0YV8xJHBoaS5jb3JlLCBkYXRhXzEkZGVwdGgsIHlsaW0gPSByZXYoYyg1NjY3LDYwODMpKSwgeGxpbSA9IGMoMC4xLDAuNCksIHR5cGUgPSAibCIsIHlsYWIgPSAiZGVwdGgiICwgeGxhYiA9ICJQaGkgQ29yZSIsIGx3ZCA9IDIsIGNvbCA9ICJncmVlbiIgKQ0KZ3JpZCgpDQpwbG90KFBoaUNvcmVfY29ycmVjdGVkLCBkYXRhXzEkZGVwdGgsIHlsaW0gPSByZXYoYyg1NjY3LDYwODMpKSwgeGxpbSA9IGMoMC4xLDAuNCksIHR5cGUgPSAibCIsIHlsYWIgPSAiZGVwdGgiICwgeGxhYiA9ICJDb3JyZWN0ZWQgUGhpIGxvZyIsIGx3ZCA9IDIgLCBjb2wgPSAiZ3JlZW4iKQ0KZ3JpZCgpDQpgYGANCg0KcGxvdHRpbmcgS19jb3JlICwgS19jb3JyZWN0ZWQuDQoNCmBgYHtyfQ0KcGFyKG1mcm93ID0gYyAoMSwzKSkNCg0KYm94cGxvdChkZXB0aCB+IEZhY2llcywgZGF0YSA9IGRhdGFfMSwgeWxpbSA9IHJldihjKDU2NjcsNjA4MykpICwgY29sID0gImJsdWUiKQ0KcGxvdChkYXRhXzEkay5jb3JlLCBkZiRkZXB0aCwgeWxpbSA9IHJldihjKDU2NjcsNjA4MykpLCB4bGltID0gYygwLjQsMTYwMDApLCB0eXBlID0gImwiLCB5bGFiID0gImRlcHRoIG0iICwgeGxhYiA9ICJLIGNvcmUiLCBsd2QgPSAyICwgY29sID0gInJlZCIgKQ0KZ3JpZCgpDQpwbG90KEtjb3JlX2NvcnJlY3RlZCwgZGF0YV8xJGRlcHRoLCB5bGltID0gcmV2KGMoNTY2Nyw2MDgzKSksIHhsaW0gPSBjKDAuNCw2MDAwKSwgdHlwZSA9ICJsIiwgeWxhYiA9ICJkZXB0aCBtIiAsIHhsYWIgPSAiQ29ycmVjdGVkIEsgY29yZSIsIGx3ZCA9IDIgLCBjb2wgPSAicmVkIikNCmdyaWQoKQ0KYGBgDQo=