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

Firstly, importing data…

df <- read.csv("karpur.csv") 
df$phi.core = df$phi.core / 100   #convert phi to fraction
summary(df)
     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                     

We will be using machine learning ( simple linear regression ) between phi_core and phi_log with facies to get phi_corrected to the log scale.

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

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

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

After completing Porosity model, Now we can predict in the phi_core corrected to phi_log.

PhiCore_corrected <- predict(porosity_model , df) 

We will be using ML again to get permeability core corrected from the relationship between K_core and phi_corrected to log scale.

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

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

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 , df) 

plotting ( phi_core , phi_log , phi_corrected ) with depth.

par(mfrow = c(1,4)) 
boxplot(depth ~ Facies, data = df, ylim = rev(c(5667,6083))) 
plot(df$phi.N, df$depth, ylim = rev(c(5667,6083)), xlim = c(0.01,0.5), type = "l", ylab = "depth m" , xlab = "Porosity log", lwd = 2 )
grid() 
plot(df$phi.core, df$depth, ylim = rev(c(5667,6083)), xlim = c(0.1,0.4), type = "l", ylab = "depth m" , xlab = "Porosity Core", lwd = 2 )
grid() 
plot(PhiCore_corrected, df$depth, ylim = rev(c(5667,6083)), xlim = c(0.1,0.4), type = "l", ylab = "depth m" , xlab = "Corrected Porosity log", lwd = 2 ) 
grid()

plotting ( K_core , K_corrected ) with depth.

par(mfrow = c (1,3)) 
boxplot(depth ~ Facies, data = df, ylim = rev(c(5667,6083))) 
plot(df$k.core, df$depth, ylim = rev(c(5667,6083)), xlim = c(0.4,16000), type = "l", ylab = "depth m" , xlab = "Permeability core", lwd = 2 )
grid() 
plot(Kcore_corrected, df$depth, ylim = rev(c(5667,6083)), xlim = c(0.4,6000), type = "l", ylab = "depth m" , xlab = "Corrected Permeability core", lwd = 2 ) 
grid()

LS0tDQp0aXRsZTogIkNvcnJlY3Rpb24gU2NhbGUgb2YgQ29yZSBQZXJtZWFiaWxpdHkiDQphdXRob3I6ICJBbGkgTWF6aW4gTW9oYW1tZWQiIA0KZGF0ZTogIjE1IE9jdG9ib2VyIDIwMjQiDQpvdXRwdXQ6IGh0bWxfbm90ZWJvb2sNCi0tLQ0KDQpXZSB3aWxsIGNvbnZlcnQgY29yZSBwZXJtZWFiaWxpdHkgbWVhc3VyZW1lbnRzIHRvIGEgbG9nIHNjYWxlIGR1ZSB0byB0aGUgaGlnaCBjb3N0cyBvZiBkaXJlY3Qgc2NhbGluZyBmcm9tIGNvcmUgc2FtcGxlcw0KDQpGaXJzdGx5LCBpbXBvcnRpbmcgZGF0YS4uLg0KDQpgYGB7cn0NCmRmIDwtIHJlYWQuY3N2KCJrYXJwdXIuY3N2IikgDQpkZiRwaGkuY29yZSA9IGRmJHBoaS5jb3JlIC8gMTAwICAgI2NvbnZlcnQgcGhpIHRvIGZyYWN0aW9uDQpzdW1tYXJ5KGRmKQ0KYGBgDQoNCldlIHdpbGwgYmUgdXNpbmcgbWFjaGluZSBsZWFybmluZyAoIHNpbXBsZSBsaW5lYXIgcmVncmVzc2lvbiApIGJldHdlZW4gcGhpX2NvcmUgYW5kIHBoaV9sb2cgd2l0aCBmYWNpZXMgdG8gZ2V0IHBoaV9jb3JyZWN0ZWQgdG8gdGhlIGxvZyBzY2FsZS4NCg0KYGBge3J9DQpwb3Jvc2l0eV9tb2RlbCA9IGxtKHBoaS5jb3JlIH4gcGhpLk4gKyBGYWNpZXMgLSAxICwgZGF0YSA9IGRmKQ0Kc3VtbWFyeShwb3Jvc2l0eV9tb2RlbCkNCmBgYA0KDQpBZnRlciBjb21wbGV0aW5nIFBvcm9zaXR5IG1vZGVsLCBOb3cgd2UgY2FuIHByZWRpY3QgaW4gdGhlIHBoaV9jb3JlIGNvcnJlY3RlZCB0byBwaGlfbG9nLg0KDQpgYGB7cn0NClBoaUNvcmVfY29ycmVjdGVkIDwtIHByZWRpY3QocG9yb3NpdHlfbW9kZWwgLCBkZikgDQpgYGANCg0KV2Ugd2lsbCBiZSB1c2luZyBNTCBhZ2FpbiB0byBnZXQgcGVybWVhYmlsaXR5IGNvcmUgY29ycmVjdGVkIGZyb20gdGhlIHJlbGF0aW9uc2hpcCBiZXR3ZWVuIEtfY29yZSBhbmQgcGhpX2NvcnJlY3RlZCB0byBsb2cgc2NhbGUuDQoNCmBgYHtyfQ0KcGVybWVhYmlsaXR5X21vZGVsIDwtIGxtIChrLmNvcmUgfiBQaGlDb3JlX2NvcnJlY3RlZCArIEZhY2llcyAtIDEgLCBkYXRhID0gZGYpIA0Kc3VtbWFyeShwZXJtZWFiaWxpdHlfbW9kZWwpDQpgYGANCg0KcHJlZGljdCB0aGUgS19jb3JlIGNvcnJlY3RlZCB0byBsb2cgc2NhbGUuDQoNCmBgYHtyfQ0KS2NvcmVfY29ycmVjdGVkIDwtIHByZWRpY3QocGVybWVhYmlsaXR5X21vZGVsICwgZGYpIA0KYGBgDQoNCnBsb3R0aW5nICggcGhpX2NvcmUgLCBwaGlfbG9nICwgcGhpX2NvcnJlY3RlZCApIHdpdGggZGVwdGguDQoNCmBgYHtyfQ0KcGFyKG1mcm93ID0gYygxLDQpKSANCmJveHBsb3QoZGVwdGggfiBGYWNpZXMsIGRhdGEgPSBkZiwgeWxpbSA9IHJldihjKDU2NjcsNjA4MykpKSANCnBsb3QoZGYkcGhpLk4sIGRmJGRlcHRoLCB5bGltID0gcmV2KGMoNTY2Nyw2MDgzKSksIHhsaW0gPSBjKDAuMDEsMC41KSwgdHlwZSA9ICJsIiwgeWxhYiA9ICJkZXB0aCBtIiAsIHhsYWIgPSAiUG9yb3NpdHkgbG9nIiwgbHdkID0gMiApDQpncmlkKCkgDQpwbG90KGRmJHBoaS5jb3JlLCBkZiRkZXB0aCwgeWxpbSA9IHJldihjKDU2NjcsNjA4MykpLCB4bGltID0gYygwLjEsMC40KSwgdHlwZSA9ICJsIiwgeWxhYiA9ICJkZXB0aCBtIiAsIHhsYWIgPSAiUG9yb3NpdHkgQ29yZSIsIGx3ZCA9IDIgKQ0KZ3JpZCgpIA0KcGxvdChQaGlDb3JlX2NvcnJlY3RlZCwgZGYkZGVwdGgsIHlsaW0gPSByZXYoYyg1NjY3LDYwODMpKSwgeGxpbSA9IGMoMC4xLDAuNCksIHR5cGUgPSAibCIsIHlsYWIgPSAiZGVwdGggbSIgLCB4bGFiID0gIkNvcnJlY3RlZCBQb3Jvc2l0eSBsb2ciLCBsd2QgPSAyICkgDQpncmlkKCkNCmBgYA0KDQpwbG90dGluZyAoIEtfY29yZSAsIEtfY29ycmVjdGVkICkgd2l0aCBkZXB0aC4NCg0KYGBge3J9DQpwYXIobWZyb3cgPSBjICgxLDMpKSANCmJveHBsb3QoZGVwdGggfiBGYWNpZXMsIGRhdGEgPSBkZiwgeWxpbSA9IHJldihjKDU2NjcsNjA4MykpKSANCnBsb3QoZGYkay5jb3JlLCBkZiRkZXB0aCwgeWxpbSA9IHJldihjKDU2NjcsNjA4MykpLCB4bGltID0gYygwLjQsMTYwMDApLCB0eXBlID0gImwiLCB5bGFiID0gImRlcHRoIG0iICwgeGxhYiA9ICJQZXJtZWFiaWxpdHkgY29yZSIsIGx3ZCA9IDIgKQ0KZ3JpZCgpIA0KcGxvdChLY29yZV9jb3JyZWN0ZWQsIGRmJGRlcHRoLCB5bGltID0gcmV2KGMoNTY2Nyw2MDgzKSksIHhsaW0gPSBjKDAuNCw2MDAwKSwgdHlwZSA9ICJsIiwgeWxhYiA9ICJkZXB0aCBtIiAsIHhsYWIgPSAiQ29ycmVjdGVkIFBlcm1lYWJpbGl0eSBjb3JlIiwgbHdkID0gMiApIA0KZ3JpZCgpDQpgYGANCg==