library(rsm)
library(lmtest)
library(carData)
library(car)
library(nortest)
library(NlcOptim)
library(FrF2)
library(ggthemes)
library(rio)
library(ROI)
library(MASS)
library(nloptr)

library(readxl)

DOE<-read_excel("kaio2023.xlsx")

#======================= Função y1 ======================================
funcao<-rsm(log(y1)~SO(x1,x2,x3,x4),data = DOE)
summary(funcao)

Call:
rsm(formula = log(y1) ~ SO(x1, x2, x3, x4), data = DOE)

               Estimate  Std. Error t value Pr(>|t|)  
(Intercept)  9.78955416  4.09681031  2.3896  0.03416 *
x1          -0.07834421  0.23726327 -0.3302  0.74694  
x2           0.01770484  0.05462103  0.3241  0.75141  
x3          -7.39651588  9.02236357 -0.8198  0.42831  
x4           0.72032059  0.36524762  1.9721  0.07209 .
x1:x2        0.00013723  0.00168297  0.0815  0.93636  
x1:x3        0.57778829  0.25244583  2.2888  0.04102 *
x1:x4       -0.01667476  0.01262229 -1.3211  0.21112  
x2:x3        0.03545788  0.06731889  0.5267  0.60799  
x2:x4       -0.00102694  0.00336594 -0.3051  0.76552  
x3:x4       -0.32267558  0.50489166 -0.6391  0.53477  
x1^2        -0.00351166  0.00546561 -0.6425  0.53263  
x2^2        -0.00038459  0.00038867 -0.9895  0.34194  
x3^2        -4.35477226  8.74498006 -0.4980  0.62750  
x4^2        -0.03785521  0.02186245 -1.7315  0.10896  
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Multiple R-squared:  0.5315,    Adjusted R-squared:  -0.01516 
F-statistic: 0.9723 on 14 and 12 DF,  p-value: 0.5255

Analysis of Variance Table

Response: log(y1)
                    Df  Sum Sq  Mean Sq F value Pr(>F)
FO(x1, x2, x3, x4)   4 0.10658 0.026646  0.6533 0.6356
TWI(x1, x2, x3, x4)  6 0.31688 0.052813  1.2949 0.3302
PQ(x1, x2, x3, x4)   4 0.13171 0.032928  0.8073 0.5438
Residuals           12 0.48944 0.040786               
Lack of fit         10 0.46256 0.046256  3.4424 0.2460
Pure error           2 0.02687 0.013437               

Stationary point of response surface:
        x1         x2         x3         x4 
18.4635538 42.4294158  0.4368292  3.0104023 

Eigenanalysis:
eigen() decomposition
$values
[1]  0.0223225928 -0.0004071608 -0.0385706135 -4.3798685396

$vectors
          [,1]          [,2]        [,3]         [,4]
x1  0.93854096 -0.0706245437 -0.33140536  0.065753555
x2  0.06837813  0.9974866972 -0.01812372  0.004031261
x3  0.07438735 -0.0008331845  0.01300111 -0.997144322
x4 -0.33004821  0.0056363534 -0.94322478 -0.036924525
funcao<-lm(log(y1)~ -1+ SO(x1,x2,x3,x4),data = DOE)
summary(funcao)

Call:
lm.default(formula = log(y1) ~ -1 + SO(x1, x2, x3, x4), data = DOE)

Residuals:
     Min       1Q   Median       3Q      Max 
-0.28474 -0.14459 -0.02912  0.11370  0.28880 

Coefficients:
                          Estimate Std. Error t value Pr(>|t|)  
SO(x1, x2, x3, x4)x1     3.917e-01  1.549e-01   2.529   0.0252 *
SO(x1, x2, x3, x4)x2     1.013e-01  4.897e-02   2.068   0.0592 .
SO(x1, x2, x3, x4)x3     9.316e+00  6.653e+00   1.400   0.1848  
SO(x1, x2, x3, x4)x4     1.034e+00  3.979e-01   2.598   0.0221 *
SO(x1, x2, x3, x4)x1:x2 -1.201e-03  1.852e-03  -0.648   0.5281  
SO(x1, x2, x3, x4)x1:x3  3.102e-01  2.641e-01   1.175   0.2612  
SO(x1, x2, x3, x4)x1:x4 -2.169e-02  1.453e-02  -1.493   0.1592  
SO(x1, x2, x3, x4)x2:x3 -1.212e-02  7.506e-02  -0.161   0.8742  
SO(x1, x2, x3, x4)x2:x4 -1.919e-03  3.904e-03  -0.492   0.6313  
SO(x1, x2, x3, x4)x3:x4 -5.011e-01  5.828e-01  -0.860   0.4055  
SO(x1, x2, x3, x4)x1^2  -1.144e-02  5.069e-03  -2.257   0.0418 *
SO(x1, x2, x3, x4)x2^2  -7.998e-04  4.058e-04  -1.971   0.0704 .
SO(x1, x2, x3, x4)x3^2  -1.578e+01  8.547e+00  -1.846   0.0878 .
SO(x1, x2, x3, x4)x4^2  -5.619e-02  2.389e-02  -2.352   0.0351 *
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Residual standard error: 0.2357 on 13 degrees of freedom
Multiple R-squared:  0.9997,    Adjusted R-squared:  0.9993 
F-statistic:  2662 on 14 and 13 DF,  p-value: < 2.2e-16
funcao<- lm(log(y1)~ -1 + FO(x1,x2,x3,x4)+PQ(x1,x2,x3,x4),data = DOE)
summary(funcao)

Call:
lm.default(formula = log(y1) ~ -1 + FO(x1, x2, x3, x4) + PQ(x1, 
    x2, x3, x4), data = DOE)

Residuals:
     Min       1Q   Median       3Q      Max 
-0.37389 -0.10701  0.04037  0.13657  0.41008 

Coefficients:
                         Estimate Std. Error t value Pr(>|t|)   
FO(x1, x2, x3, x4)x1    4.502e-01  1.247e-01   3.611  0.00186 **
FO(x1, x2, x3, x4)x2    7.607e-02  3.145e-02   2.419  0.02578 * 
FO(x1, x2, x3, x4)x3    1.457e+01  5.272e+00   2.763  0.01238 * 
FO(x1, x2, x3, x4)x4    3.772e-01  1.336e-01   2.824  0.01085 * 
PQ(x1, x2, x3, x4)x1^2 -1.292e-02  3.491e-03  -3.700  0.00152 **
PQ(x1, x2, x3, x4)x2^2 -8.771e-04  3.482e-04  -2.519  0.02089 * 
PQ(x1, x2, x3, x4)x3^2 -1.791e+01  6.609e+00  -2.709  0.01391 * 
PQ(x1, x2, x3, x4)x4^2 -5.961e-02  2.166e-02  -2.751  0.01270 * 
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Residual standard error: 0.2276 on 19 degrees of freedom
Multiple R-squared:  0.9995,    Adjusted R-squared:  0.9993 
F-statistic:  4997 on 8 and 19 DF,  p-value: < 2.2e-16
contour(funcao,~x1+x2,image = T)

#par(mfrow=c(1,2))
persp(funcao,~x1+x2,zlab="y1",
      col = rainbow(250),
      contours = ("colors"))

persp(funcao,~x1+x3,zlab="y1",
      col = rainbow(350),
      contours = ("colors"))

persp(funcao,~x1+x4,zlab="y1",
      col = rainbow(150),
      contours = ("colors"))


persp(funcao,~x2+x3,zlab="y1",
      col = rainbow(450),
      contours = ("colors"))


persp(funcao,~x2+x4,zlab="y1",
      col = rainbow(450),
      contours = ("colors"))

persp(funcao,~x3+x4, zlab="y1",
      col = rainbow(450),
      contours = ("colors"))


curve(dnorm(x,mean(funcao$residuals),sd(funcao$residuals)),
      from = min(funcao$residuals),to=max(funcao$residuals),
      xlab = "Observações", ylab = "Densidade", lwd=4,
      col="turquoise")
lines(density(funcao$residuals),col="blue", lwd=3,pch=2)
legend("topright", legend = c("Real","Estimada"),
       col=c("turquoise","blue"),lwd=5)

hist(funcao$residuals,lwd=3,col="yellow",
     main="Histograma dos Resíduos",xlab = "Resíduos")

#Normalidade
shapiro.test(funcao$residuals)

    Shapiro-Wilk normality test

data:  funcao$residuals
W = 0.96992, p-value = 0.5997
#Homocedasticidade
residualPlot(funcao)

bptest(funcao)

    studentized Breusch-Pagan test

data:  funcao
BP = 8.595, df = 7, p-value = 0.2831
#Autocorrelação Residual
dwt(funcao)
 lag Autocorrelation D-W Statistic p-value
   1       0.1328287      1.721409   0.412
 Alternative hypothesis: rho != 0
dwtest(funcao)

    Durbin-Watson test

data:  funcao
DW = 1.7214, p-value = 0.2182
alternative hypothesis: true autocorrelation is greater than 0
bgtest(funcao)

    Breusch-Godfrey test for serial correlation of order up to 1

data:  funcao
LM test = 0.62908, df = 1, p-value = 0.4277
#================== Grupo 2 ====================================================

funcao2<-rsm(log(y2)~ SO(x1,x2,x3,x4),data = DOE)
summary(funcao2)

Call:
rsm(formula = log(y2) ~ SO(x1, x2, x3, x4), data = DOE)

               Estimate  Std. Error t value  Pr(>|t|)    
(Intercept)  4.5737e+00  1.9856e+00  2.3034 0.0399516 *  
x1          -2.8633e-02  1.1500e-01 -0.2490 0.8075807    
x2           1.9077e-02  2.6474e-02  0.7206 0.4849486    
x3          -1.4559e+01  4.3730e+00 -3.3293 0.0060063 ** 
x4           6.9160e-01  1.7703e-01  3.9067 0.0020846 ** 
x1:x2        4.9076e-04  8.1570e-04  0.6016 0.5586063    
x1:x3       -2.2292e-01  1.2236e-01 -1.8219 0.0934701 .  
x1:x4       -1.1146e-02  6.1178e-03 -1.8219 0.0934701 .  
x2:x3        3.2971e-02  3.2628e-02  1.0105 0.3321938    
x2:x4       -4.2569e-03  1.6314e-03 -2.6093 0.0228296 *  
x3:x4       -7.8576e-01  2.4471e-01 -3.2110 0.0074786 ** 
x1^2         2.9847e-03  2.6491e-03  1.1267 0.2818933    
x2^2        -3.0915e-04  1.8838e-04 -1.6411 0.1267062    
x3^2         2.1630e+01  4.2385e+00  5.1031 0.0002605 ***
x4^2        -4.8079e-03  1.0596e-02 -0.4537 0.6581133    
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Multiple R-squared:  0.9224,    Adjusted R-squared:  0.8319 
F-statistic: 10.19 on 14 and 12 DF,  p-value: 0.0001334

Analysis of Variance Table

Response: log(y2)
                    Df  Sum Sq  Mean Sq F value    Pr(>F)
FO(x1, x2, x3, x4)   4 0.73314 0.183285 19.1294  3.84e-05
TWI(x1, x2, x3, x4)  6 0.24088 0.040147  4.1902 0.0167034
PQ(x1, x2, x3, x4)   4 0.39323 0.098307 10.2603 0.0007566
Residuals           12 0.11498 0.009581                  
Lack of fit         10 0.09005 0.009005  0.7227 0.7052373
Pure error           2 0.02492 0.012461                  

Stationary point of response surface:
         x1          x2          x3          x4 
13.47558118 60.30306499  0.36139555  0.07541881 

Eigenanalysis:
eigen() decomposition
$values
[1] 21.6373488007  0.0058586264 -0.0003357832 -0.0153731802

$vectors
            [,1]         [,2]         [,3]       [,4]
x1 -0.0051464291  0.900534819 -0.194045000 0.38904639
x2  0.0007634794  0.166935096  0.980604468 0.10269844
x3  0.9998217568 -0.002779319 -0.002246847 0.01853865
x4 -0.0181489919 -0.401449860 -0.027502146 0.91528807
funcao2<-lm(log(y2)~ -1+SO(x1,x2,x3,x4),data = DOE)
summary(funcao2)

Call:
lm.default(formula = log(y2) ~ -1 + SO(x1, x2, x3, x4), data = DOE)

Residuals:
     Min       1Q   Median       3Q      Max 
-0.19793 -0.04579  0.01175  0.04093  0.16298 

Coefficients:
                          Estimate Std. Error t value Pr(>|t|)    
SO(x1, x2, x3, x4)x1     0.1909667  0.0741922   2.574 0.023120 *  
SO(x1, x2, x3, x4)x2     0.0581172  0.0234643   2.477 0.027775 *  
SO(x1, x2, x3, x4)x3    -6.7507094  3.1874571  -2.118 0.054027 .  
SO(x1, x2, x3, x4)x4     0.8379983  0.1906325   4.396 0.000723 ***
SO(x1, x2, x3, x4)x1:x2 -0.0001344  0.0008875  -0.151 0.881930    
SO(x1, x2, x3, x4)x1:x3 -0.3479607  0.1265161  -2.750 0.016528 *  
SO(x1, x2, x3, x4)x1:x4 -0.0134906  0.0069602  -1.938 0.074617 .  
SO(x1, x2, x3, x4)x2:x3  0.0107418  0.0359611   0.299 0.769885    
SO(x1, x2, x3, x4)x2:x4 -0.0046737  0.0018707  -2.498 0.026669 *  
SO(x1, x2, x3, x4)x3:x4 -0.8691201  0.2792367  -3.112 0.008246 ** 
SO(x1, x2, x3, x4)x1^2  -0.0007201  0.0024286  -0.297 0.771513    
SO(x1, x2, x3, x4)x2^2  -0.0005031  0.0001944  -2.588 0.022515 *  
SO(x1, x2, x3, x4)x3^2  16.2923237  4.0948148   3.979 0.001574 ** 
SO(x1, x2, x3, x4)x4^2  -0.0133754  0.0114478  -1.168 0.263632    
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Residual standard error: 0.1129 on 13 degrees of freedom
Multiple R-squared:  0.9988,    Adjusted R-squared:  0.9976 
F-statistic: 787.2 on 14 and 13 DF,  p-value: < 2.2e-16
funcao2<-lm(log(y2)~ - 1+ FO(x1,x2,x3,x4)+PQ(x2,x3)+TWI(x1,x4)+TWI(x1,x3)
+TWI(x3,x4)+TWI(x2,x4), data = DOE)
summary(funcao2)

Call:
lm.default(formula = log(y2) ~ -1 + FO(x1, x2, x3, x4) + PQ(x2, 
    x3) + TWI(x1, x4) + TWI(x1, x3) + TWI(x3, x4) + TWI(x2, x4), 
    data = DOE)

Residuals:
      Min        1Q    Median        3Q       Max 
-0.162001 -0.046483 -0.005419  0.060789  0.163302 

Coefficients:
                       Estimate Std. Error t value Pr(>|t|)    
FO(x1, x2, x3, x4)x1  0.1786620  0.0372888   4.791 0.000170 ***
FO(x1, x2, x3, x4)x2  0.0567220  0.0159865   3.548 0.002472 ** 
FO(x1, x2, x3, x4)x3 -5.8962530  2.0774739  -2.838 0.011354 *  
FO(x1, x2, x3, x4)x4  0.7899106  0.1620835   4.873 0.000143 ***
PQ(x2, x3)x2^2       -0.0004614  0.0001713  -2.694 0.015373 *  
PQ(x2, x3)x3^2       16.9026002  3.5055312   4.822 0.000159 ***
TWI(x1, x4)          -0.0142844  0.0062949  -2.269 0.036563 *  
TWI(x1, x3)          -0.3902983  0.0938392  -4.159 0.000657 ***
TWI(x3, x4)          -0.8973451  0.2537110  -3.537 0.002533 ** 
TWI(x2, x4)          -0.0048148  0.0017122  -2.812 0.011998 *  
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Residual standard error: 0.1043 on 17 degrees of freedom
Multiple R-squared:  0.9987,    Adjusted R-squared:  0.9979 
F-statistic:  1292 on 10 and 17 DF,  p-value: < 2.2e-16
#contour(funcao,~x1+x2,image = T)

persp(funcao2,~x1+x2,zlab="y2",
      col = rainbow(250),
      contours = ("colors"))

persp(funcao2,~x1+x3,zlab="y2",
      col = rainbow(250),
      contours = ("colors"))

persp(funcao2,~x2+x3,zlab="y2",
      col = rainbow(250),
      contours = ("colors"))


persp(funcao2,~x3+x4,zlab="y2",
      col = rainbow(250),
      contours = ("colors"))


curve(dnorm(x,mean(funcao2$residuals),sd(funcao2$residuals)),
      from = min(funcao2$residuals),to=max(funcao2$residuals),
      xlab = "Observações", ylab = "Densidade", lwd=4,
      col="turquoise")
lines(density(funcao2$residuals),col="blue", lwd=3,pch=2)
legend("topright", legend = c("Real","Estimada"),
       col=c("turquoise","blue"),lwd=5)

hist(funcao2$residuals,lwd=3,col="yellow",main="Histograma dos Resíduos",
     xlab="Resíduos")

shapiro.test(funcao2$residuals)

    Shapiro-Wilk normality test

data:  funcao2$residuals
W = 0.98362, p-value = 0.9333
residualPlot(funcao2)

bptest(funcao2)

    studentized Breusch-Pagan test

data:  funcao2
BP = 7.0044, df = 9, p-value = 0.6367
dwt(funcao2)
 lag Autocorrelation D-W Statistic p-value
   1       0.1637541      1.650433    0.29
 Alternative hypothesis: rho != 0
dwtest(funcao2)

    Durbin-Watson test

data:  funcao2
DW = 1.6504, p-value = 0.153
alternative hypothesis: true autocorrelation is greater than 0
bgtest(funcao2)

    Breusch-Godfrey test for serial correlation of order up to 1

data:  funcao2
LM test = 2.0418, df = 1, p-value = 0.153
#================== Grupo 3 ====================================================

funcao3<-lm(y3~ SO(x1,x2,x3,x4),data = DOE)
summary(funcao3)

Call:
lm.default(formula = y3 ~ SO(x1, x2, x3, x4), data = DOE)

Residuals:
    Min      1Q  Median      3Q     Max 
-2.3750 -0.6042  0.1667  1.0833  1.8750 

Coefficients:
                          Estimate Std. Error t value Pr(>|t|)  
(Intercept)              43.708333  37.381855   1.169   0.2650  
SO(x1, x2, x3, x4)x1     -3.291667   2.164938  -1.520   0.1543  
SO(x1, x2, x3, x4)x2     -0.069444   0.498396  -0.139   0.8915  
SO(x1, x2, x3, x4)x3    -42.916667  82.325679  -0.521   0.6116  
SO(x1, x2, x3, x4)x4      6.125000   3.332747   1.838   0.0910 .
SO(x1, x2, x3, x4)x1:x2  -0.008333   0.015356  -0.543   0.5973  
SO(x1, x2, x3, x4)x1:x3   5.000000   2.303473   2.171   0.0507 .
SO(x1, x2, x3, x4)x1:x4  -0.250000   0.115174  -2.171   0.0507 .
SO(x1, x2, x3, x4)x2:x3  -0.333333   0.614260  -0.543   0.5973  
SO(x1, x2, x3, x4)x2:x4   0.058333   0.030713   1.899   0.0818 .
SO(x1, x2, x3, x4)x3:x4   1.250000   4.606947   0.271   0.7907  
SO(x1, x2, x3, x4)x1^2    0.072917   0.049872   1.462   0.1694  
SO(x1, x2, x3, x4)x2^2    0.001296   0.003546   0.366   0.7211  
SO(x1, x2, x3, x4)x3^2  -45.833333  79.794658  -0.574   0.5763  
SO(x1, x2, x3, x4)x4^2   -0.583333   0.199487  -2.924   0.0127 *
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Residual standard error: 1.843 on 12 degrees of freedom
Multiple R-squared:  0.8267,    Adjusted R-squared:  0.6246 
F-statistic:  4.09 on 14 and 12 DF,  p-value: 0.009624
funcao3<-lm(log(y3)~ -1+SO(x1,x2,x3,x4),data = DOE)
summary(funcao3)

Call:
lm.default(formula = log(y3) ~ -1 + SO(x1, x2, x3, x4), data = DOE)

Residuals:
      Min        1Q    Median        3Q       Max 
-0.198481 -0.088862  0.007507  0.076826  0.158937 

Coefficients:
                          Estimate Std. Error t value Pr(>|t|)   
SO(x1, x2, x3, x4)x1    -6.504e-03  1.010e-01  -0.064  0.94961   
SO(x1, x2, x3, x4)x2     2.238e-02  3.193e-02   0.701  0.49564   
SO(x1, x2, x3, x4)x3     5.935e+00  4.337e+00   1.369  0.19434   
SO(x1, x2, x3, x4)x4     6.439e-01  2.594e-01   2.482  0.02749 * 
SO(x1, x2, x3, x4)x1:x2 -1.067e-03  1.208e-03  -0.884  0.39298   
SO(x1, x2, x3, x4)x1:x3  2.143e-01  1.721e-01   1.245  0.23526   
SO(x1, x2, x3, x4)x1:x4 -2.172e-02  9.471e-03  -2.294  0.03911 * 
SO(x1, x2, x3, x4)x2:x3 -4.122e-02  4.893e-02  -0.842  0.41480   
SO(x1, x2, x3, x4)x2:x4  4.202e-03  2.545e-03   1.651  0.12272   
SO(x1, x2, x3, x4)x3:x4  1.882e-03  3.800e-01   0.005  0.99612   
SO(x1, x2, x3, x4)x1^2   1.419e-03  3.304e-03   0.430  0.67457   
SO(x1, x2, x3, x4)x2^2  -3.663e-05  2.645e-04  -0.138  0.89198   
SO(x1, x2, x3, x4)x3^2  -1.001e+01  5.572e+00  -1.796  0.09573 . 
SO(x1, x2, x3, x4)x4^2  -5.655e-02  1.558e-02  -3.631  0.00305 **
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Residual standard error: 0.1537 on 13 degrees of freedom
Multiple R-squared:  0.9984,    Adjusted R-squared:  0.9967 
F-statistic:   584 on 14 and 13 DF,  p-value: 8.027e-16
funcao3<-rsm(log(y3)~ FO(x1,x2,x4)+PQ(x4)+
TWI(x2,x4)+TWI(x1,x4),data = DOE)
summary(funcao3)
Near-stationary-ridge situation detected -- stationary point altered
 Change 'threshold' if this is not what you intend

Call:
rsm(formula = log(y3) ~ FO(x1, x2, x4) + PQ(x4) + TWI(x2, x4) + 
    TWI(x1, x4), data = DOE)

              Estimate Std. Error t value Pr(>|t|)   
(Intercept)  1.4374725  0.6379394  2.2533  0.03562 * 
x1           0.0751201  0.0289471  2.5951  0.01731 * 
x2          -0.0178812  0.0077192 -2.3164  0.03126 * 
x4           0.5603044  0.2130472  2.6300  0.01605 * 
x4^2        -0.0516056  0.0139505 -3.6992  0.00142 **
x2:x4        0.0045714  0.0024013  1.9037  0.07144 . 
x1:x4       -0.0196440  0.0090050 -2.1814  0.04126 * 
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Multiple R-squared:  0.719, Adjusted R-squared:  0.6347 
F-statistic:  8.53 on 6 and 20 DF,  p-value: 0.0001123

Analysis of Variance Table

Response: log(y3)
               Df  Sum Sq  Mean Sq F value    Pr(>F)
FO(x1, x2, x4)  3 0.60436 0.201453  9.7043 0.0003681
PQ(x4)          1 0.28407 0.284069 13.6840 0.0014199
TWI(x2, x4)     1 0.07523 0.075231  3.6240 0.0714424
TWI(x1, x4)     1 0.09879 0.098787  4.7587 0.0412565
Residuals      20 0.41518 0.020759                  
Lack of fit    12 0.33098 0.027582  2.6204 0.0894042
Pure error      8 0.08420 0.010526                  

Stationary point of response surface:
       x1        x2        x4 
 7.975413 -1.855968  3.828562 

Eigenanalysis:
eigen() decomposition
$values
[1]  0.001900641  0.000000000 -0.053506289

$vectors
         [,1]          [,2]       [,3]
x1  0.9571241  2.266549e-01  0.1803914
x2 -0.2227335  9.739751e-01 -0.0419791
x4 -0.1852115 -1.110223e-16  0.9826987
funcao3<-lm(log(y3)~ -1+FO(x1,x2,x3,x4)+
             PQ(x3,x4)+TWI(x1,x4)+TWI(x2,x4),data = DOE)
summary(funcao3)

Call:
lm.default(formula = log(y3) ~ -1 + FO(x1, x2, x3, x4) + PQ(x3, 
    x4) + TWI(x1, x4) + TWI(x2, x4), data = DOE)

Residuals:
     Min       1Q   Median       3Q      Max 
-0.21501 -0.09701  0.01168  0.09727  0.17383 

Coefficients:
                      Estimate Std. Error t value Pr(>|t|)    
FO(x1, x2, x3, x4)x1  0.077709   0.024980   3.111 0.005755 ** 
FO(x1, x2, x3, x4)x2 -0.017421   0.007153  -2.435 0.024899 *  
FO(x1, x2, x3, x4)x3  6.959486   2.559484   2.719 0.013616 *  
FO(x1, x2, x3, x4)x4  0.607929   0.169624   3.584 0.001979 ** 
PQ(x3, x4)x3^2       -8.805172   3.264975  -2.697 0.014286 *  
PQ(x3, x4)x4^2       -0.056249   0.013438  -4.186 0.000501 ***
TWI(x1, x4)          -0.020396   0.007908  -2.579 0.018386 *  
TWI(x2, x4)           0.004438   0.002240   1.981 0.062287 .  
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Residual standard error: 0.1404 on 19 degrees of freedom
Multiple R-squared:  0.9981,    Adjusted R-squared:  0.9972 
F-statistic:  1223 on 8 and 19 DF,  p-value: < 2.2e-16
funcao3<-lm((y3)~ -1+ FO(x1,x3,x4)+PQ(x4)+TWI(x1,x3)+TWI(x1,x4),
            data = DOE)
summary(funcao3)

Call:
lm.default(formula = (y3) ~ -1 + FO(x1, x3, x4) + PQ(x4) + TWI(x1, 
    x3) + TWI(x1, x4), data = DOE)

Residuals:
    Min      1Q  Median      3Q     Max 
-2.8216 -0.8888  0.1061  1.2105  4.2496 

Coefficients:
                 Estimate Std. Error t value Pr(>|t|)    
FO(x1, x3, x4)x1   0.3448     0.1570   2.196 0.039463 *  
FO(x1, x3, x4)x3 -36.2300    17.1591  -2.111 0.046895 *  
FO(x1, x3, x4)x4  10.6816     2.3920   4.466 0.000213 ***
PQ(x4)            -0.6513     0.1929  -3.377 0.002848 ** 
TWI(x1, x3)        2.0156     0.9902   2.036 0.054605 .  
TWI(x1, x4)       -0.3060     0.1172  -2.611 0.016321 *  
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Residual standard error: 1.997 on 21 degrees of freedom
Multiple R-squared:  0.9863,    Adjusted R-squared:  0.9824 
F-statistic: 251.5 on 6 and 21 DF,  p-value: < 2.2e-16
#contour(funcao,~x1+x2,image = T)

persp(funcao3,~x1+x3,zlab="y3",
      col = rainbow(250),
      contours = ("colors"))


persp(funcao3,~x1+x4,zlab="y3",
      col = rainbow(250),
      contours = ("colors"))

persp(funcao3,~x3+x4,zlab="y3",
      col = rainbow(250),
      contours = ("colors"))


curve(dnorm(x,mean(funcao3$residuals),sd(funcao3$residuals)),
      from = min(funcao3$residuals),to=max(funcao3$residuals),
      xlab = "Observações", ylab = "Densidade", lwd=4,
      col="turquoise")
lines(density(funcao3$residuals),col="blue", lwd=3,pch=2)
legend("topright", legend = c("Real","Estimada"),
       col=c("turquoise","blue"),lwd=5)

hist(funcao3$residuals,lwd=3,col="yellow",main="Histograma dos Resíduos",
     xlab="Resíduos")

shapiro.test(funcao3$residuals)

    Shapiro-Wilk normality test

data:  funcao3$residuals
W = 0.96008, p-value = 0.3712
residualPlot(funcao3)

bptest(funcao3)

    studentized Breusch-Pagan test

data:  funcao3
BP = 4.7593, df = 5, p-value = 0.446
dwt(funcao3)
 lag Autocorrelation D-W Statistic p-value
   1      0.01888434      1.862135    0.66
 Alternative hypothesis: rho != 0
dwtest(funcao3)

    Durbin-Watson test

data:  funcao3
DW = 1.8621, p-value = 0.3312
alternative hypothesis: true autocorrelation is greater than 0
bgtest(funcao3,order = 1)

    Breusch-Godfrey test for serial correlation of order up to 1

data:  funcao3
LM test = 0.013641, df = 1, p-value = 0.907
#=================== Otimização========================================
obj=function(x){a<- predict(funcao, newdata = data.frame(x1=x[1],
                                                         x2=x[2],
                                                         x3=x[3],
                                                         x4=x[4]))
return(-a)}

obj2=function(x){a<- predict(funcao2, newdata = data.frame(x1=x[1],
                                                         x2=x[2],
                                                         x3=x[3],
                                                         x4=x[4]))
return(-a)}

obj3=function(x){a<- predict(funcao3, newdata = data.frame(x1=x[1],
                                                           x2=x[2],
                                                           x3=x[3],
                                                           x4=x[4]))
return(-a)}

x0<-c(14,30,.3,1)
optim(par = x0,fn=obj,lower = c(14,30,.3,1),
      upper = c(22,60,.5,5),method = c("L-BFGS-B"),control =T)
$par
[1] 17.4253753 43.3637777  0.4067494  3.1639912

$value
[1] -9.130589

$counts
function gradient 
      39       39 

$convergence
[1] 0

$message
[1] "CONVERGENCE: REL_REDUCTION_OF_F <= FACTR*EPSMCH"
optim(par = x0,fn=obj2,lower = c(14,30,.3,1),
      upper = c(22,60,.5,5),method = c("L-BFGS-B"),control =T)
$par
[1] 14.00000 35.38084  0.30000  5.00000

$value
[1] -2.795558

$counts
function gradient 
      26       26 

$convergence
[1] 0

$message
[1] "CONVERGENCE: REL_REDUCTION_OF_F <= FACTR*EPSMCH"
optim(par = x0,fn=obj3,lower = c(14,30,.3,1),
      upper = c(22,60,.5,5),method = c("L-BFGS-B"),control =T)
$par
[1] 14.000000 30.000000  0.300000  4.911891

$value
[1] -18.1378

$counts
function gradient 
       7        7 

$convergence
[1] 0

$message
[1] "CONVERGENCE: NORM OF PROJECTED GRADIENT <= PGTOL"
#============== Intervalo de predição===================================
# Valores ótimos
predict(funcao, newdata = data.frame(x1=16
,x2=44,x3=.333333333,x4=3.16),
        se.fit = T,interval = "pred")
$fit
       fit      lwr     upr
1 9.007509 8.494298 9.52072

$se.fit
[1] 0.09121297

$df
[1] 19

$residual.scale
[1] 0.2276041
predict(funcao2, newdata = data.frame(x1=16
                                      ,x2=44,x3=.333333333,x4=3.16),
        se.fit = T,interval = "pred")
$fit
       fit      lwr      upr
1 2.451433 2.215513 2.687353

$se.fit
[1] 0.04027101

$df
[1] 17

$residual.scale
[1] 0.1043169
predict(funcao3, newdata = data.frame(x1=16
                                      ,x2=44,x3=.333333333,x4=3.16),
        se.fit = T,interval = "pred")
$fit
      fit      lwr      upr
1 15.9716 11.57548 20.36773

$se.fit
[1] 0.6932738

$df
[1] 21

$residual.scale
[1] 1.996997
library(nloptr)

obj=function(x){a<- predict(funcao, newdata = data.frame(x1=x[1],
                                                         x2=x[2],
                                                         x3=x[3],
                                                         x4=x[4]))

return(-a)}

constraint <- function(x) {
  return(as.integer(x)-x[1])}

#constraint2 <- function(x) {
#  return(as.integer(x)-x[2])}
#integer_constraints <- c("x1", "x2")

x0<-c(16,30,.3,1)

nloptr(x0,eval_f =obj,lb=c(14,30,.3,1),ub=c(22,60,.5,5),
      # 
      eval_g_ineq = constraint,
             # xint = variable_types,
       #eval_jac_g_eq = constraint,
       opts = list("algorithm"="NLOPT_GN_ISRES",
                   xtol_rel=1.0e-100,maxeval = 100000,
                   xint = constraint))

Call:
nloptr(x0 = x0, eval_f = obj, lb = c(14, 30, 0.3, 1), ub = c(22, 
    60, 0.5, 5), eval_g_ineq = constraint, opts = list(algorithm = "NLOPT_GN_ISRES", 
    xtol_rel = 1e-100, maxeval = 1e+05, xint = constraint))


Minimization using NLopt version 2.7.1 

NLopt solver status: 5 ( NLOPT_MAXEVAL_REACHED: Optimization stopped because 
maxeval (above) was reached. )

Number of Iterations....: 100000 
Termination conditions:  xtol_rel: 1e-100   maxeval: 1e+05 
Number of inequality constraints:  4 
Number of equality constraints:    0 
Current value of objective function:  -8.72609953406255 
Current value of controls: 22 31 0.4067437 3.163782
LS0tCnRpdGxlOiAiRGlzc2VydGHDp8Ojb19ET0VfQU5FIgpvdXRwdXQ6IGh0bWxfbm90ZWJvb2sKLS0tCgpgYGB7cn0KbGlicmFyeShyc20pCmxpYnJhcnkobG10ZXN0KQpsaWJyYXJ5KGNhckRhdGEpCmxpYnJhcnkoY2FyKQpsaWJyYXJ5KG5vcnRlc3QpCmxpYnJhcnkoTmxjT3B0aW0pCmxpYnJhcnkoRnJGMikKbGlicmFyeShnZ3RoZW1lcykKbGlicmFyeShyaW8pCmxpYnJhcnkoUk9JKQpsaWJyYXJ5KE1BU1MpCmxpYnJhcnkobmxvcHRyKQoKbGlicmFyeShyZWFkeGwpCgpET0U8LXJlYWRfZXhjZWwoImthaW8yMDIzLnhsc3giKQoKIz09PT09PT09PT09PT09PT09PT09PT09IEZ1bsOnw6NvIHkxID09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09CmZ1bmNhbzwtcnNtKGxvZyh5MSl+U08oeDEseDIseDMseDQpLGRhdGEgPSBET0UpCnN1bW1hcnkoZnVuY2FvKQpmdW5jYW88LWxtKGxvZyh5MSl+IC0xKyBTTyh4MSx4Mix4Myx4NCksZGF0YSA9IERPRSkKc3VtbWFyeShmdW5jYW8pCmZ1bmNhbzwtIGxtKGxvZyh5MSl+IC0xICsgRk8oeDEseDIseDMseDQpK1BRKHgxLHgyLHgzLHg0KSxkYXRhID0gRE9FKQpzdW1tYXJ5KGZ1bmNhbykKCmNvbnRvdXIoZnVuY2FvLH54MSt4MixpbWFnZSA9IFQpCiNwYXIobWZyb3c9YygxLDIpKQpwZXJzcChmdW5jYW8sfngxK3gyLHpsYWI9InkxIiwKICAgICAgY29sID0gcmFpbmJvdygyNTApLAogICAgICBjb250b3VycyA9ICgiY29sb3JzIikpCnBlcnNwKGZ1bmNhbyx+eDEreDMsemxhYj0ieTEiLAogICAgICBjb2wgPSByYWluYm93KDM1MCksCiAgICAgIGNvbnRvdXJzID0gKCJjb2xvcnMiKSkKcGVyc3AoZnVuY2FvLH54MSt4NCx6bGFiPSJ5MSIsCiAgICAgIGNvbCA9IHJhaW5ib3coMTUwKSwKICAgICAgY29udG91cnMgPSAoImNvbG9ycyIpKQoKcGVyc3AoZnVuY2FvLH54Mit4Myx6bGFiPSJ5MSIsCiAgICAgIGNvbCA9IHJhaW5ib3coNDUwKSwKICAgICAgY29udG91cnMgPSAoImNvbG9ycyIpKQoKcGVyc3AoZnVuY2FvLH54Mit4NCx6bGFiPSJ5MSIsCiAgICAgIGNvbCA9IHJhaW5ib3coNDUwKSwKICAgICAgY29udG91cnMgPSAoImNvbG9ycyIpKQpwZXJzcChmdW5jYW8sfngzK3g0LCB6bGFiPSJ5MSIsCiAgICAgIGNvbCA9IHJhaW5ib3coNDUwKSwKICAgICAgY29udG91cnMgPSAoImNvbG9ycyIpKQoKY3VydmUoZG5vcm0oeCxtZWFuKGZ1bmNhbyRyZXNpZHVhbHMpLHNkKGZ1bmNhbyRyZXNpZHVhbHMpKSwKICAgICAgZnJvbSA9IG1pbihmdW5jYW8kcmVzaWR1YWxzKSx0bz1tYXgoZnVuY2FvJHJlc2lkdWFscyksCiAgICAgIHhsYWIgPSAiT2JzZXJ2YcOnw7VlcyIsIHlsYWIgPSAiRGVuc2lkYWRlIiwgbHdkPTQsCiAgICAgIGNvbD0idHVycXVvaXNlIikKbGluZXMoZGVuc2l0eShmdW5jYW8kcmVzaWR1YWxzKSxjb2w9ImJsdWUiLCBsd2Q9MyxwY2g9MikKbGVnZW5kKCJ0b3ByaWdodCIsIGxlZ2VuZCA9IGMoIlJlYWwiLCJFc3RpbWFkYSIpLAogICAgICAgY29sPWMoInR1cnF1b2lzZSIsImJsdWUiKSxsd2Q9NSkKaGlzdChmdW5jYW8kcmVzaWR1YWxzLGx3ZD0zLGNvbD0ieWVsbG93IiwKICAgICBtYWluPSJIaXN0b2dyYW1hIGRvcyBSZXPDrWR1b3MiLHhsYWIgPSAiUmVzw61kdW9zIikKI05vcm1hbGlkYWRlCnNoYXBpcm8udGVzdChmdW5jYW8kcmVzaWR1YWxzKQojSG9tb2NlZGFzdGljaWRhZGUKcmVzaWR1YWxQbG90KGZ1bmNhbykKYnB0ZXN0KGZ1bmNhbykKI0F1dG9jb3JyZWxhw6fDo28gUmVzaWR1YWwKZHd0KGZ1bmNhbykKZHd0ZXN0KGZ1bmNhbykKYmd0ZXN0KGZ1bmNhbykKIz09PT09PT09PT09PT09PT09PSBHcnVwbyAyID09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT0KCmZ1bmNhbzI8LXJzbShsb2coeTIpfiBTTyh4MSx4Mix4Myx4NCksZGF0YSA9IERPRSkKc3VtbWFyeShmdW5jYW8yKQoKZnVuY2FvMjwtbG0obG9nKHkyKX4gLTErU08oeDEseDIseDMseDQpLGRhdGEgPSBET0UpCnN1bW1hcnkoZnVuY2FvMikKZnVuY2FvMjwtbG0obG9nKHkyKX4gLSAxKyBGTyh4MSx4Mix4Myx4NCkrUFEoeDIseDMpK1RXSSh4MSx4NCkrVFdJKHgxLHgzKQorVFdJKHgzLHg0KStUV0koeDIseDQpLCBkYXRhID0gRE9FKQpzdW1tYXJ5KGZ1bmNhbzIpCiNjb250b3VyKGZ1bmNhbyx+eDEreDIsaW1hZ2UgPSBUKQoKcGVyc3AoZnVuY2FvMix+eDEreDIsemxhYj0ieTIiLAogICAgICBjb2wgPSByYWluYm93KDI1MCksCiAgICAgIGNvbnRvdXJzID0gKCJjb2xvcnMiKSkKcGVyc3AoZnVuY2FvMix+eDEreDMsemxhYj0ieTIiLAogICAgICBjb2wgPSByYWluYm93KDI1MCksCiAgICAgIGNvbnRvdXJzID0gKCJjb2xvcnMiKSkKcGVyc3AoZnVuY2FvMix+eDIreDMsemxhYj0ieTIiLAogICAgICBjb2wgPSByYWluYm93KDI1MCksCiAgICAgIGNvbnRvdXJzID0gKCJjb2xvcnMiKSkKCnBlcnNwKGZ1bmNhbzIsfngzK3g0LHpsYWI9InkyIiwKICAgICAgY29sID0gcmFpbmJvdygyNTApLAogICAgICBjb250b3VycyA9ICgiY29sb3JzIikpCgpjdXJ2ZShkbm9ybSh4LG1lYW4oZnVuY2FvMiRyZXNpZHVhbHMpLHNkKGZ1bmNhbzIkcmVzaWR1YWxzKSksCiAgICAgIGZyb20gPSBtaW4oZnVuY2FvMiRyZXNpZHVhbHMpLHRvPW1heChmdW5jYW8yJHJlc2lkdWFscyksCiAgICAgIHhsYWIgPSAiT2JzZXJ2YcOnw7VlcyIsIHlsYWIgPSAiRGVuc2lkYWRlIiwgbHdkPTQsCiAgICAgIGNvbD0idHVycXVvaXNlIikKbGluZXMoZGVuc2l0eShmdW5jYW8yJHJlc2lkdWFscyksY29sPSJibHVlIiwgbHdkPTMscGNoPTIpCmxlZ2VuZCgidG9wcmlnaHQiLCBsZWdlbmQgPSBjKCJSZWFsIiwiRXN0aW1hZGEiKSwKICAgICAgIGNvbD1jKCJ0dXJxdW9pc2UiLCJibHVlIiksbHdkPTUpCmhpc3QoZnVuY2FvMiRyZXNpZHVhbHMsbHdkPTMsY29sPSJ5ZWxsb3ciLG1haW49Ikhpc3RvZ3JhbWEgZG9zIFJlc8OtZHVvcyIsCiAgICAgeGxhYj0iUmVzw61kdW9zIikKc2hhcGlyby50ZXN0KGZ1bmNhbzIkcmVzaWR1YWxzKQoKcmVzaWR1YWxQbG90KGZ1bmNhbzIpCmJwdGVzdChmdW5jYW8yKQpkd3QoZnVuY2FvMikKZHd0ZXN0KGZ1bmNhbzIpCmJndGVzdChmdW5jYW8yKQoKCiM9PT09PT09PT09PT09PT09PT0gR3J1cG8gMyA9PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09CgpmdW5jYW8zPC1sbSh5M34gU08oeDEseDIseDMseDQpLGRhdGEgPSBET0UpCnN1bW1hcnkoZnVuY2FvMykKZnVuY2FvMzwtbG0obG9nKHkzKX4gLTErU08oeDEseDIseDMseDQpLGRhdGEgPSBET0UpCnN1bW1hcnkoZnVuY2FvMykKZnVuY2FvMzwtcnNtKGxvZyh5Myl+IEZPKHgxLHgyLHg0KStQUSh4NCkrClRXSSh4Mix4NCkrVFdJKHgxLHg0KSxkYXRhID0gRE9FKQpzdW1tYXJ5KGZ1bmNhbzMpCmZ1bmNhbzM8LWxtKGxvZyh5Myl+IC0xK0ZPKHgxLHgyLHgzLHg0KSsKICAgICAgICAgICAgIFBRKHgzLHg0KStUV0koeDEseDQpK1RXSSh4Mix4NCksZGF0YSA9IERPRSkKc3VtbWFyeShmdW5jYW8zKQoKZnVuY2FvMzwtbG0oKHkzKX4gLTErIEZPKHgxLHgzLHg0KStQUSh4NCkrVFdJKHgxLHgzKStUV0koeDEseDQpLAogICAgICAgICAgICBkYXRhID0gRE9FKQpzdW1tYXJ5KGZ1bmNhbzMpCiNjb250b3VyKGZ1bmNhbyx+eDEreDIsaW1hZ2UgPSBUKQoKcGVyc3AoZnVuY2FvMyx+eDEreDMsemxhYj0ieTMiLAogICAgICBjb2wgPSByYWluYm93KDI1MCksCiAgICAgIGNvbnRvdXJzID0gKCJjb2xvcnMiKSkKCnBlcnNwKGZ1bmNhbzMsfngxK3g0LHpsYWI9InkzIiwKICAgICAgY29sID0gcmFpbmJvdygyNTApLAogICAgICBjb250b3VycyA9ICgiY29sb3JzIikpCnBlcnNwKGZ1bmNhbzMsfngzK3g0LHpsYWI9InkzIiwKICAgICAgY29sID0gcmFpbmJvdygyNTApLAogICAgICBjb250b3VycyA9ICgiY29sb3JzIikpCgpjdXJ2ZShkbm9ybSh4LG1lYW4oZnVuY2FvMyRyZXNpZHVhbHMpLHNkKGZ1bmNhbzMkcmVzaWR1YWxzKSksCiAgICAgIGZyb20gPSBtaW4oZnVuY2FvMyRyZXNpZHVhbHMpLHRvPW1heChmdW5jYW8zJHJlc2lkdWFscyksCiAgICAgIHhsYWIgPSAiT2JzZXJ2YcOnw7VlcyIsIHlsYWIgPSAiRGVuc2lkYWRlIiwgbHdkPTQsCiAgICAgIGNvbD0idHVycXVvaXNlIikKbGluZXMoZGVuc2l0eShmdW5jYW8zJHJlc2lkdWFscyksY29sPSJibHVlIiwgbHdkPTMscGNoPTIpCmxlZ2VuZCgidG9wcmlnaHQiLCBsZWdlbmQgPSBjKCJSZWFsIiwiRXN0aW1hZGEiKSwKICAgICAgIGNvbD1jKCJ0dXJxdW9pc2UiLCJibHVlIiksbHdkPTUpCmhpc3QoZnVuY2FvMyRyZXNpZHVhbHMsbHdkPTMsY29sPSJ5ZWxsb3ciLG1haW49Ikhpc3RvZ3JhbWEgZG9zIFJlc8OtZHVvcyIsCiAgICAgeGxhYj0iUmVzw61kdW9zIikKc2hhcGlyby50ZXN0KGZ1bmNhbzMkcmVzaWR1YWxzKQoKcmVzaWR1YWxQbG90KGZ1bmNhbzMpCmJwdGVzdChmdW5jYW8zKQpkd3QoZnVuY2FvMykKZHd0ZXN0KGZ1bmNhbzMpCmJndGVzdChmdW5jYW8zLG9yZGVyID0gMSkKCiM9PT09PT09PT09PT09PT09PT09IE90aW1pemHDp8Ojbz09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT0Kb2JqPWZ1bmN0aW9uKHgpe2E8LSBwcmVkaWN0KGZ1bmNhbywgbmV3ZGF0YSA9IGRhdGEuZnJhbWUoeDE9eFsxXSwKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgeDI9eFsyXSwKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgeDM9eFszXSwKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgeDQ9eFs0XSkpCnJldHVybigtYSl9CgpvYmoyPWZ1bmN0aW9uKHgpe2E8LSBwcmVkaWN0KGZ1bmNhbzIsIG5ld2RhdGEgPSBkYXRhLmZyYW1lKHgxPXhbMV0sCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIHgyPXhbMl0sCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIHgzPXhbM10sCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIHg0PXhbNF0pKQpyZXR1cm4oLWEpfQoKb2JqMz1mdW5jdGlvbih4KXthPC0gcHJlZGljdChmdW5jYW8zLCBuZXdkYXRhID0gZGF0YS5mcmFtZSh4MT14WzFdLAogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIHgyPXhbMl0sCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgeDM9eFszXSwKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICB4ND14WzRdKSkKcmV0dXJuKC1hKX0KCngwPC1jKDE0LDMwLC4zLDEpCm9wdGltKHBhciA9IHgwLGZuPW9iaixsb3dlciA9IGMoMTQsMzAsLjMsMSksCiAgICAgIHVwcGVyID0gYygyMiw2MCwuNSw1KSxtZXRob2QgPSBjKCJMLUJGR1MtQiIpLGNvbnRyb2wgPVQpCgpvcHRpbShwYXIgPSB4MCxmbj1vYmoyLGxvd2VyID0gYygxNCwzMCwuMywxKSwKICAgICAgdXBwZXIgPSBjKDIyLDYwLC41LDUpLG1ldGhvZCA9IGMoIkwtQkZHUy1CIiksY29udHJvbCA9VCkKCm9wdGltKHBhciA9IHgwLGZuPW9iajMsbG93ZXIgPSBjKDE0LDMwLC4zLDEpLAogICAgICB1cHBlciA9IGMoMjIsNjAsLjUsNSksbWV0aG9kID0gYygiTC1CRkdTLUIiKSxjb250cm9sID1UKQoKIz09PT09PT09PT09PT09IEludGVydmFsbyBkZSBwcmVkacOnw6NvPT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT0KIyBWYWxvcmVzIMOzdGltb3MKcHJlZGljdChmdW5jYW8sIG5ld2RhdGEgPSBkYXRhLmZyYW1lKHgxPTE2Cix4Mj00NCx4Mz0uMzMzMzMzMzMzLHg0PTMuMTYpLAogICAgICAgIHNlLmZpdCA9IFQsaW50ZXJ2YWwgPSAicHJlZCIpCgpwcmVkaWN0KGZ1bmNhbzIsIG5ld2RhdGEgPSBkYXRhLmZyYW1lKHgxPTE2CiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgLHgyPTQ0LHgzPS4zMzMzMzMzMzMseDQ9My4xNiksCiAgICAgICAgc2UuZml0ID0gVCxpbnRlcnZhbCA9ICJwcmVkIikKCnByZWRpY3QoZnVuY2FvMywgbmV3ZGF0YSA9IGRhdGEuZnJhbWUoeDE9MTYKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAseDI9NDQseDM9LjMzMzMzMzMzMyx4ND0zLjE2KSwKICAgICAgICBzZS5maXQgPSBULGludGVydmFsID0gInByZWQiKQoKbGlicmFyeShubG9wdHIpCgpvYmo9ZnVuY3Rpb24oeCl7YTwtIHByZWRpY3QoZnVuY2FvLCBuZXdkYXRhID0gZGF0YS5mcmFtZSh4MT14WzFdLAogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICB4Mj14WzJdLAogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICB4Mz14WzNdLAogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICB4ND14WzRdKSkKCnJldHVybigtYSl9Cgpjb25zdHJhaW50IDwtIGZ1bmN0aW9uKHgpIHsKICByZXR1cm4oYXMuaW50ZWdlcih4KS14WzFdKX0KCiNjb25zdHJhaW50MiA8LSBmdW5jdGlvbih4KSB7CiMgIHJldHVybihhcy5pbnRlZ2VyKHgpLXhbMl0pfQojaW50ZWdlcl9jb25zdHJhaW50cyA8LSBjKCJ4MSIsICJ4MiIpCgp4MDwtYygxNiwzMCwuMywxKQoKbmxvcHRyKHgwLGV2YWxfZiA9b2JqLGxiPWMoMTQsMzAsLjMsMSksdWI9YygyMiw2MCwuNSw1KSwKICAgICAgIyAKICAgICAgZXZhbF9nX2luZXEgPSBjb25zdHJhaW50LAogICAgICAgICAgICAgIyB4aW50ID0gdmFyaWFibGVfdHlwZXMsCiAgICAgICAjZXZhbF9qYWNfZ19lcSA9IGNvbnN0cmFpbnQsCiAgICAgICBvcHRzID0gbGlzdCgiYWxnb3JpdGhtIj0iTkxPUFRfR05fSVNSRVMiLAogICAgICAgICAgICAgICAgICAgeHRvbF9yZWw9MS4wZS0xMDAsbWF4ZXZhbCA9IDEwMDAwMCwKICAgICAgICAgICAgICAgICAgIHhpbnQgPSBjb25zdHJhaW50KSkKCmBgYAoKCgoKCgoK