library(car)
## Loading required package: carData
library(PMCMR)
## PMCMR is superseded by PMCMRplus and will be no longer maintained. You may wish to install PMCMRplus instead.
library(nortest)
library(MASS)
library(HH)
## Loading required package: lattice
## Loading required package: grid
## Loading required package: latticeExtra
## Loading required package: multcomp
## Loading required package: mvtnorm
## Loading required package: survival
## Loading required package: TH.data
## 
## Attaching package: 'TH.data'
## The following object is masked from 'package:MASS':
## 
##     geyser
## Loading required package: gridExtra
## 
## Attaching package: 'HH'
## The following objects are masked from 'package:car':
## 
##     logit, vif
library(lattice)
library(ggplot2)
## 
## Attaching package: 'ggplot2'
## The following object is masked from 'package:latticeExtra':
## 
##     layer
library(pscl)
## Classes and Methods for R developed in the
## Political Science Computational Laboratory
## Department of Political Science
## Stanford University
## Simon Jackman
## hurdle and zeroinfl functions by Achim Zeileis
library(boot)
## 
## Attaching package: 'boot'
## The following object is masked from 'package:HH':
## 
##     logit
## The following object is masked from 'package:survival':
## 
##     aml
## The following object is masked from 'package:lattice':
## 
##     melanoma
## The following object is masked from 'package:car':
## 
##     logit
library(Lock5Data)
library(scatterplot3d)
library(rgl)
library(rsm)
library(writexl)
library(Metrics)
library(pracma)
## 
## Attaching package: 'pracma'
## The following object is masked from 'package:boot':
## 
##     logit
## The following object is masked from 'package:HH':
## 
##     logit
## The following object is masked from 'package:car':
## 
##     logit
library(readxl)
library(psych)
## 
## Attaching package: 'psych'
## The following objects are masked from 'package:pracma':
## 
##     logit, polar
## The following object is masked from 'package:boot':
## 
##     logit
## The following objects are masked from 'package:ggplot2':
## 
##     %+%, alpha
## The following object is masked from 'package:HH':
## 
##     logit
## The following object is masked from 'package:car':
## 
##     logit

1.Pasar datos de R a excel

set.seed(1964)

t = rep(c(0,7,14,21,28,35,42,49,56,63,70,77),each=3)

mediast = tapply(as.numeric(t),as.factor(t),mean)

W <- c(0,0,0,5.69,5.74,5.68,6.52,6.58,6.51,6.96,7.03,6.95,7.26,7.32,
      7.25,7.47,7.54,7.46,7.64,7.71,7.63,7.78,7.84,7.77,7.89,7.96,
      7.88,7.99,8.05,7.98,8.07,8.14,8.06,8.14,8.21,8.14)

df <- as.data.frame(cbind(t,mediast,W))

write_xlsx(df,"C:/Users/faile/Downloads/DF.xlsx") #Exportando a excel

2. Buscar diferencias entre el modelo BLUMBERG y el modelo de excel (Generalized Reduced Gradient - GRG Non Linear)

m <- nls(W~a*t/(b+t),start = list(a= 1, b=1))

summary(m)
## 
## Formula: W ~ a * t/(b + t)
## 
## Parameters:
##   Estimate Std. Error t value Pr(>|t|)    
## a  8.39629    0.04148  202.40   <2e-16 ***
## b  3.69987    0.14761   25.07   <2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.1222 on 34 degrees of freedom
## 
## Number of iterations to convergence: 5 
## Achieved convergence tolerance: 5.172e-06
#Parámetros estimados por modelo Blumberg

# a = 8.39629
# b = 3.69987

#Parámetros estimados por modelo Generalized Reduced Gradient - GRG Non Linear

# a = 8.39629
# b = 3.69987

#Se aprecia que los parámetros estimados no presentan diferencias

Los valores estimados para mse, rmse y mae demuestran que las predicciones generadas por los modelos son muy similares entre si, teniendo valores de RMSE cercanos a 0.12

3. Buscar por que el R2 no aplica a modelos no lineales R/ Entendiendo que el Coeficiente de determinación se define como \[R^2=\frac{Varianza ~ explicada ~ por ~ el ~ modelo}{Varianza ~ total}\] y además esta condicionado al supuesto de que: Varianza explicada + Varianza del error oscila entre 0 y 100, en los modelos no lineales este supuesto subyacente no se cumple dado que la Varianza explicada + Varianza del error no necesariamente esta acotada dentro de este rango.

4. Ajustar el modelo y calcular AIC

\[W=a*\sqrt{\frac{t}{b+t}}\]

# Comparación de modelos mediante criterio AIC 

#m3 modelo con el termino del numerador elevado al cuadrado

m3 <- nls( W ~ (a*t)^2/(b+t),start = list(a= 1, b=1))

AIC(m) # -45.27101
## [1] -45.27101
AIC(m3) # 156.8385
## [1] 156.8385

Modelo inicial

m1<-nls(W~a*t/(b+t),start = list(a= 1, b=1))
summary(m1)
## 
## Formula: W ~ a * t/(b + t)
## 
## Parameters:
##   Estimate Std. Error t value Pr(>|t|)    
## a  8.39629    0.04148  202.40   <2e-16 ***
## b  3.69987    0.14761   25.07   <2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.1222 on 34 degrees of freedom
## 
## Number of iterations to convergence: 5 
## Achieved convergence tolerance: 5.172e-06
cf=c(coef(m1));cf#guardando los coeficientes del modelo estimado
##        a        b 
## 8.396295 3.699871
x=seq(0,49,0.1)
fit=c(cf[1]*cf[2]/(cf[2]+x)^2)
dffit=data.frame(x,fit)
data07<-subset(dffit,dffit$x<=7)
summary(data07$fit)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##  0.2713  0.3879  0.5993  0.7917  1.0462  2.2693

Series de taylor

k <- c(1:50)
h <- function(t){(8.4*t)/(3.7+t)}
v <- h(t=k)
plot(v)

p <- taylor(h,3.5,3)
x <- c(0:7)
yf <- h(x)
yp <- polyval(p, x)
k <- seq(1,7,0.1)
j <- function(t){p[1]*3*t^2+p[2]*2*t+p[3]}
o <- j(t=k)
summary(o)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##  0.3997  0.4219  0.5249  0.6325  0.8008  1.2327

Comparacion de tasas medias de cambio