Tarea 2 CE

set.seed(2020)
PCP<-runif(30,0,300)
dias<-seq(1,30,1)
plot(dias,PCP,type="l")
abline(h=mean(PCP),col="red")

x = dias
y= sin(x)+ 30
plot(x,y, type="l")
abline(h=mean(y))

acf(y) #Función de autocorrelación

#_____________________________________________________________________

set.seed(123)
# aceite del cultivo de limonaria en cc de aceite
acc = rnorm (120, 5, 0.25)
hist(acc, col = 'orange', ylim = c(0, 30), main = 'Distribución del contenido de aceite (CC)',
     xlab = 'Contenido de aceite', breaks = 10)
rug(acc)

# viscosidad (pascal segundo)
vis = runif(120, 2, 3)
hist(vis, col = 'orange',ylim = c(0, 30), main = 'Distribución de la viscosidad del aceite (Pascal/Seg)',
     xlab = 'Viscosidad de aceite', breaks = 10)
rug(vis)

# grafico dispersión
plot(acc, vis, pch = 19, cex =0.8, main ='Contenido de aceite vs viscosidad', ylab = 'Viscosidad (Pascal/Seg)',
     xlab = 'Contenido de aceite (CC)')

# funcion para estandarizar
estand = function(x){
  media = mean(x)
  desv = sd(x)
  z = (x - media)/desv
  return(z)
}
# estandarizando acc
acc_z = estand(acc)

# estandarizando vis
vis_z = estand(vis)
par(mfrow = c(2, 2))
hist(acc, main = 'Acc no estandarizada')
hist(acc_z, main = 'Acc estandarizada')
hist(vis, main = 'vis no estandarizada')
hist(vis_z, main = 'vis estandarizada')

# Estandarizar > hace que la media de la variable sea 0

(med_acc = mean(acc)) # media sin estandarizar

## [1] 5.00386

(desv_acc = sd(acc)) # desviación sin estandarizar

## [1] 0.223607

(med_acc_z = mean(acc_z)) # media estandarizada = 0

## [1] -4.953991e-16

(desv_acc_z = sd(acc_z)) # desviación estandarizada = 1

## [1] 1

(med_vis = mean(vis)) # media sin estandarizar

## [1] 2.494534

(desv_vis = sd(vis)) # desviación sin estandarizar

## [1] 0.298678

(med_vis_z = mean(vis_z)) # media estandarizada = 0

## [1] 6.907055e-16

(desv_vis_z = sd(vis_z)) # desviación estandarizada = 1

## [1] 1

par(mfrow = c(1, 2))
plot(acc_z, vis_z, pch = 19, cex = 0.8, main = 'Estandarizado')
points(x = mean(acc_z), y = mean(vis_z), col = 'red', pch = 19)
plot(acc, vis, pch = 19, cex = 0.8, main = 'No Estandarizado')
points(x = mean(acc), y = mean(vis), col = 'blue', pch = 19)

#Coorrelación datos

cr = cor(acc, vis, method = 'pearson')
cr

## [1] -0.01905532

#Coorrelación datos estandarizados

cr_z = cor(acc_z, vis_z, method = 'pearson')
cr_z

## [1] -0.01905532

#______________________________________________________

# biomasa de tuberculos
set.seed(1234)
biom = sort(rnorm(48, 3, 0.25))
# tiempo de pesado de tuberculos (segundos)

tiempo = sort(rnorm(48, 30, 2))
plot(y = biom, x =tiempo)

corr = cor(biom, tiempo)
corr

## [1] 0.9806255

#_____________________________________________________-

# biomasa de niños al nacer
set.seed(1234)
peso = sort(rnorm(48, 3, 0.25))

# Numero de Cigüeñas contadas
num = sort(floor(rnorm(48, 30, 2)))
plot(x = peso, y = num, ylim = c(0, 36), xlim = c(0,36))

corr = cor(peso, num)
corr

## [1] 0.9681666

#Así se observa la verdadera forma del gráfico

#________________________________________________________-

set.seed(1243)
# N en el tejdio en ppm
N = sort(rnorm(120, 10, 0.8))
# P en el tejido en ppm
P = sort(rnorm(120, 0.1, 0.02))
plot(N, P, pch = 19, cex = 0.6)

N_z = estand(N)
P_z = estand(P)

par(mfrow = c(1, 2))

plot(N, P, pch = 19, cex = 0.6, main = 'Sin estandarizar')
plot(N_z, P_z, pch = 19, cex = 0.6, xlim = c(-3, 3),
     ylim = c(-3, 3), main = 'Estandarizado')

plot(N, P, pch = 19, cex = 0.6, main = 'Sin estandarizar',
     xlim = c(0, 12), ylim = c(0, 12))

#_________________________________________________________________

mod = lm (P~N) # regresión lineal
plot(N, P, pch = 19, cex = 0.6)
abline(mod) # recta que mejor se ajusta a los datos

# coeficientes de la recta
b = -0.1638
m = 0.0265
# m es igual a la tangente teta
# tang 0 = 0.0265
# 0 = arctang(0.0265)

ang_r = atan(m) # angulo de la recta en radianes 
ang_r

## [1] 0.0264938

ang_g = ang_r*180/pi # angulo en grados
ang_g

## [1] 1.517983

library(growthmodels)
growth <- blumberg(0:100, 10, 2, 0.5)
par(bg = 'white', fg = 'darkred')
plot(growth, pch = 19, cex = 0.5, main = 'Modelo de crecimiento Blumberg', xlab = 'Time', col = 'darkblue',type="l")
grid(nx = 10, ny = 10, lwd = 1,col = 'black')

cor_p = cor(growth, 0:100, method = 'pearson')
cor_p

## [1] 0.7666426

cor_s = cor(growth, 0:100, method = 'spearman')
cor_s

## [1] 1

#______________________________________________________

library(growthmodels)
growth <- blumberg(0:100, 10, 2, 0.5)
growth[50]<- 4
par(bg = 'white', fg = 'darkred')
plot(growth, pch = 19, cex = 0.5, main = 'Modelo de crecimiento Blumberg', xlab = 'Time', col = 'darkblue',type="l")
grid(nx = 10, ny = 10, lwd = 1,col = 'black')

#CLASE 03/09/2020

cor_sp= cor(growth,0:100,method = "spearman"); cor_sp

## [1] 0.9868608

curve(2*x+3,from=-10,to=10, xlab = "x", ylab = "f(x)",col="blue")
grid(10,10)

x<-c(-10:10)
y= 2*x+3
cor(x,y,method = "pearson")

## [1] 1

cor(x,y,method = "spearman")

## [1] 1

#cAMBIAMOS (2) VALORES y(11) Y y(15) PARA VER SI SE AFECTA LA COORELACIÓN

x<-c(-10:10)
y= 2*x+3
y[11]=-5
y[15]=20
plot(y~x, type="l")

cor(y,x,method="pearson")

## [1] 0.9785058

cor(y,x,method="spearman") 

## [1] 0.9769406

#Las coorrelaciones se vieron muy poco afectadas
#__________________________________________________

set.seed(2020)
PCP<-runif(30,0,60)
dias<-seq(1,30,1)
plot(dias,PCP,type="l")
abline(h=mean(PCP),col="red")

cor(PCP,dias,method = "pearson")

## [1] 0.1905849

cor(PCP,dias,method = "spearman")

## [1] 0.1955506

#Son muy similares y cercanas a (0)

#Prueba de coorrelaciones

pr1<-cor.test(PCP,dias,method = "pearson")
ifelse(pr1$p.value<0.05, "Rechazo Ho (rho = 0)", "No rechazo Ho (rho = 0)")

## [1] "No rechazo Ho (rho = 0)"

pr2<-cor.test(PCP,dias,method = "spearman")
ifelse(pr2$p.value<0.05, "Rechazo Ho (rho = 0)", "No rechazo Ho (rho = 0)")

## [1] "No rechazo Ho (rho = 0)"

#____________________________________

x=dias
y=sin(x)+30
plot(x,y,type="l",main="Patron estacionario")
abline(h=mean(y),col="red")

#Función de coorrelación 

acf(y)

#____________________________________________________________

#Creación de funciones

fun.cuadra<-function(a,b,c){
  x1=(-b+sqrt(b^2-4*a*c))/(2*a)
  x2=(-b-sqrt(b^2-4*a*c))/(2*a)
  return(list(x1=x1,x2=x2))
}
fun.cuadra(a=2,b=-1,c=-3)

## $x1
## [1] 1.5
## 
## $x2
## [1] -1

fun.cuadra(a=2,b=-1,c=3)

## Warning in sqrt(b^2 - 4 * a * c): NaNs produced

## Warning in sqrt(b^2 - 4 * a * c): NaNs produced

## $x1
## [1] NaN
## 
## $x2
## [1] NaN

#_____________________________________________________

fun.cuadra<-function(a,b,c){
  d= b^2-4*a*c
  if (d>=0){
    x1=(-b+sqrt(d))/(2*a)
    x2=(-b-sqrt(d))/(2*a)
    return(list(x1=x1,x2=x2))
  }
  else ( print("La solucion no es real"))
}
fun.cuadra(a=2,b=-1,c=3)

## [1] "La solucion no es real"

## [1] "La solucion no es real"

fun.cuadra(a=0,b=2,c=3)

## $x1
## [1] NaN
## 
## $x2
## [1] -Inf

#__________________________________________________

fun.cuadra<-function(a,b,c){
  if(a!=0){
    d= b^2-4*a*c
    if (d>=0){
      x1=(-b+sqrt(d))/(2*a)
      x2=(-b-sqrt(d))/(2*a)
      return(list(x1=x1,x2=x2))
    }
    else ( print("La solucion no es real"))
  }
  else{
    x=(-c/b)
    return(x=x)
  }
}
fun.cuadra(a=100,b=2,c=-3)

## $x1
## [1] 0.1634935
## 
## $x2
## [1] -0.1834935

#_____________________________________________________

fT2<-function(v1,p1,v2,p2,T1){
  T2= v2*p2*T1/v1*p1
  return(T2)
}
fT2(v1 =1 ,p1 =1 ,v2 =2 ,p2 =2 ,T1 =273 )

## [1] 1092

# :P

fT2<-function(v1,p1,v2,p2,T1){
  if(v1>0 & p1>0){
    T2= v2*p2*T1/v1*p1
    return(T2)
  }
  else{
    print("Valores nulos para volumen o presion")
  }
}
fT2(v1 =0 ,p1 =1 ,v2 =2 ,p2 =2 ,T1 =273 )

## [1] "Valores nulos para volumen o presion"

#______________________________________________________

#ACTIVIDAD BASE CLIMATOLÓGICA