Creación de funciones

cubos <- function(x) x**3
#Y la usamos o llamamos como 
cubos (1:5)
## [1]   1   8  27  64 125
## vector 
v1 <- seq(from = 0, to= 20,by= 2); v1
##  [1]  0  2  4  6  8 10 12 14 16 18 20
# Funcion en el vector 
cubos(v1)
##  [1]    0    8   64  216  512 1000 1728 2744 4096 5832 8000

Estandarización de datos

estandarizar <- function(x) {
  med= mean(x)
  dv= x-med # desvios
  z= dv/sd(x)
  par(mfrow=c(2,2))
  hist(x)
  hist(dv)
  hist(z)
  return(list(med.data=med,m.dv=mean(dv),var.x=var(x),var.dv=var(dv),
              m.z=mean(z), var.z=var(z),z=z))
}
set.seed(123)
estandarizar(rnorm(100,2,6))
## $med.data
## [1] 2.542435
## 
## $m.dv
## [1] -2.352025e-16
## 
## $var.x
## [1] 29.99638
## 
## $var.dv
## [1] 29.99638
## 
## $m.z
## [1] -4.44718e-17
## 
## $var.z
## [1] 1
## 
## $z
##   [1] -0.71304802 -0.35120270  1.60854170 -0.02179795  0.04259548
##   [6]  1.77983218  0.40589817 -1.48492941 -0.85149566 -0.58726835
##  [11]  1.24195461  0.29513939  0.34000892  0.02221347 -0.70797086
##  [16]  1.85854263  0.44636008 -2.25349176  0.66930255 -0.61698896
##  [21] -1.26885349 -0.33783464 -1.22304003 -0.89754917 -0.78377819
##  [26] -1.94683206  0.81876439  0.06898128 -1.34588242  1.27452758
##  [31]  0.36815564 -0.42229479  0.88157948  0.86296437  0.80101058
##  [36]  0.65537241  0.50778230 -0.16686565 -0.43422620 -0.51585092
##  [41] -0.86009994 -0.32681639 -1.48529653  2.27707482  1.22429519
##  [46] -1.32941869 -0.54040552 -0.61026684  0.75541982 -0.19037243
##  [51]  0.17847258 -0.13031397 -0.14600575  1.40027842 -0.34637532
##  [56]  1.56226982 -1.79571669  0.54141021  0.03664303  0.13752572
##  [61]  0.31685861 -0.64934164 -0.46407310 -1.21490140 -1.27319995
##  [66]  0.23347834  0.39197814 -0.04097396  0.91131364  2.14685001
##  [71] -0.63697081 -2.62876100  1.00275711 -0.87597805 -0.85276181
##  [76]  1.02448422 -0.41101270 -1.43635058  0.09957931 -0.25119772
##  [81] -0.09272595  0.32303830 -0.50510289  0.60688103 -0.34058618
##  [86]  0.26443017  1.10255872  0.37770550 -0.45610238  1.15949090
##  [91]  0.98935390  0.50173432  0.16249260 -0.78691881  1.39156928
##  [96] -0.75663177  2.29720706  1.57995139 -0.35725306 -1.22349625
### Notese que la desviacion de los datos es igual en los datos
## y en los datos trasladados 

N= sort(rnorm(50,4,0.5))
P= sort(rnorm(50,0.5,0.01))
plot(N,P,pch=19, col=2, cex=1.5,ylim=c(0.40,0.6), xlim=c(0,5))         
grid(10)
#regracion lineal simple 
mod1=lm(P~N)
summary(mod1)
## 
## Call:
## lm(formula = P ~ N)
## 
## Residuals:
##        Min         1Q     Median         3Q        Max 
## -0.0034420 -0.0006918 -0.0001520  0.0002590  0.0102823 
## 
## Coefficients:
##              Estimate Std. Error t value Pr(>|t|)    
## (Intercept) 0.4288504  0.0020345  210.79   <2e-16 ***
## N           0.0184706  0.0005212   35.44   <2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.001805 on 48 degrees of freedom
## Multiple R-squared:  0.9632, Adjusted R-squared:  0.9624 
## F-statistic:  1256 on 1 and 48 DF,  p-value: < 2.2e-16
abline(a=0.4324012, b=0.01777384, col="black")
abline(h=0.4324012, lty=2, col= "blue")
text(1,0.432, expression(theta), pos=3)
angulo=atan(0.01777384)*180/pi
angulo
## [1] 1.018259
text(1.6,0.432, paste('=',round(angulo,2)),pos=3)

N2= estandarizar(N)$z;N2
##  [1] -1.818745675 -1.429286386 -1.378687466 -1.362164698 -1.332455806
##  [6] -1.274359642 -1.220877125 -1.219749584 -1.202822125 -1.044268292
## [11] -0.778532245 -0.715588727 -0.705240283 -0.701051654 -0.602227318
## [16] -0.536728829 -0.461427756 -0.402340868 -0.390975754 -0.324912068
## [21] -0.279992511 -0.239208427 -0.170414049 -0.127688018 -0.094651729
## [26] -0.008386507 -0.002215389  0.007286271  0.184560888  0.200476769
## [31]  0.211124580  0.298315209  0.335439103  0.363453249  0.375552705
## [36]  0.494562044  0.516290943  0.561037870  0.713009503  0.781644722
## [41]  0.871156581  0.951971005  0.965988074  1.004562690  1.185542129
## [46]  1.400171993  1.716762417  2.120378565  2.186323503  2.379388117
P2= estandarizar(P)$z;P2

##  [1] -1.449671957 -1.395270617 -1.385728059 -1.315058840 -1.218940452
##  [6] -1.183848068 -1.168649886 -1.124824437 -1.003432081 -0.971368389
## [11] -0.837984824 -0.698163478 -0.577994948 -0.561333500 -0.534033849
## [16] -0.489448609 -0.444037368 -0.441736445 -0.417258486 -0.390443077
## [21] -0.342868678 -0.295482051 -0.273033477 -0.253479125 -0.169993224
## [26] -0.078277172 -0.001093948  0.028449954  0.049335862  0.059912125
## [31]  0.188660780  0.278654905  0.291816545  0.315148890  0.354636468
## [36]  0.427204421  0.513499503  0.563047008  0.603562908  0.642082578
## [41]  0.768277276  0.784377017  0.804459840  1.007724735  1.089078239
## [46]  1.150528679  1.315157035  2.103608065  2.244576955  3.439655254
plot(N2~P2,pch=19, col=2, cex=1.5)         
grid(10)

mod12=lm(P2~N2)
summary(mod12)
## 
## Call:
## lm(formula = P2 ~ N2)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -0.36972 -0.07431 -0.01633  0.02782  1.10447 
## 
## Coefficients:
##              Estimate Std. Error t value Pr(>|t|)    
## (Intercept) 4.871e-15  2.741e-02    0.00        1    
## N2          9.814e-01  2.769e-02   35.44   <2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.1938 on 48 degrees of freedom
## Multiple R-squared:  0.9632, Adjusted R-squared:  0.9624 
## F-statistic:  1256 on 1 and 48 DF,  p-value: < 2.2e-16
#Calculo de las correlaciones 
cor(P,N)
## [1] 0.9814242
cor(P2,N2)
## [1] 0.9814242

Ejercicio sobre fertilización

#Fertilizacion 
fert=gl(2,25,50, labels=c("control","quimico"))
datos= data.frame(P,N,P2,N2,fert)
#View(datos)
##prueba T
#h0= Mc=Mq #N
#h0 es falso
#datos originales y estandarizados 

#creacion de una funcion para la prueba t 
mi.t<- function(x1,x2,conf.lev){
  n1=length(x1)
  n2=length(x2)
  s1=sd(x1)
  s2=sd(x2)
  tc=(abs((mean(x1)-mean(x2)))/sqrt((((n1-1)*(s1**2)+
                                        (n2-1)*(s2**2))/(n1+n2-2))*((1/n1)+(1+n2))))
  p_v=pt(q=tc, df=n1+n2-2, lower.tail = F)
  
  desi= ifelse(p_v < (1-conf.lev)/2,"rechazo Ho"," No rechazo Ho")
  return(desi)
}
mi.t(datos$P[1:25],datos$P[26:50],0.95)
## [1] " No rechazo Ho"
mi.t(datos$P2[1:25],datos$P2[26:50],0.95)
## [1] " No rechazo Ho"
#############################################################
(x<-1:5)
## [1] 1 2 3 4 5
x<- 1:5

Ejercicio Ley de gases

ley.gases<- function(v,n,R=0.082,Tp,gra=F){
  p=n*R*Tp/v
  if(gra) plot3d(Tp, v, p, col=rainbow(100))
  return(p)
}
library(rgl)
ley.gases(n=1, Tp=273, v=seq(1,20), gra=T) 
##  [1] 22.386000 11.193000  7.462000  5.596500  4.477200  3.731000  3.198000
##  [8]  2.798250  2.487333  2.238600  2.035091  1.865500  1.722000  1.599000
## [15]  1.492400  1.399125  1.316824  1.243667  1.178211  1.119300
ley.gases(n=1, Tp=rep(seq(273,303,5)), v=rep(seq(1,20),7),gra=T) ## argumentos fijos
##   [1] 22.386000 11.398000  7.735333  5.904000  4.805200  4.072667  3.549429
##   [8]  2.798250  2.532889  2.320600  2.146909  2.002167  1.879692  1.774714
##  [15]  1.492400  1.424750  1.365059  1.312000  1.264526  1.221800 24.846000
##  [22] 11.193000  7.598667  5.801500  4.723200  4.004333  3.490857  3.105750
##  [29]  2.487333  2.279600  2.109636  1.968000  1.848154  1.745429  1.656400
##  [36]  1.399125  1.340941  1.289222  1.242947  1.201300 24.436000 12.423000
##  [43]  7.462000  5.699000  4.641200  3.936000  3.432286  3.054500  2.760667
##  [50]  2.238600  2.072364  1.933833  1.816615  1.716143  1.629067  1.552875
##  [57]  1.316824  1.266444  1.221368  1.180800 24.026000 12.218000  8.282000
##  [64]  5.596500  4.559200  3.867667  3.373714  3.003250  2.715111  2.484600
##  [71]  2.035091  1.899667  1.785077  1.686857  1.601733  1.527250  1.461529
##  [78]  1.243667  1.199789  1.160300 23.616000 12.013000  8.145333  6.211500
##  [85]  4.477200  3.799333  3.315143  2.952000  2.669556  2.443600  2.258727
##  [92]  1.865500  1.753538  1.657571  1.574400  1.501625  1.437412  1.380333
##  [99]  1.178211  1.139800 23.206000 11.808000  8.008667  6.109000  4.969200
## [106]  3.731000  3.256571  2.900750  2.624000  2.402600  2.221455  2.070500
## [113]  1.722000  1.628286  1.547067  1.476000  1.413294  1.357556  1.307684
## [120]  1.119300 22.796000 11.603000  7.872000  6.006500  4.887200  4.141000
## [127]  3.198000  2.849500  2.578444  2.361600  2.184182  2.036333  1.911231
## [134]  1.599000  1.519733  1.450375  1.389176  1.334778  1.286105  1.242300
library(rgl)

##########################
germi= sample(c(0,1), size=100, replace=T);germi
##   [1] 1 0 1 1 0 0 1 0 0 1 0 1 0 0 0 0 1 0 0 0 1 1 1 0 1 1 0 0 0 1 1 1 0 1 0
##  [36] 1 0 0 0 0 0 1 1 0 1 1 1 0 0 1 1 0 0 0 0 1 1 1 0 0 1 0 0 0 1 0 0 1 0 1
##  [71] 0 1 0 1 1 0 1 0 0 1 0 1 0 1 1 0 0 1 0 1 1 0 0 1 0 1 0 0 1 1
pg=(sum(germi)/100)*100       
var= replicate(20,sample(c(0,1), size=100, replace=T,prob=c(0.2,0.8)))
colSums(var)
##  [1] 73 78 79 87 79 85 82 78 84 75 85 78 72 77 87 81 79 77 82 84
hist(colSums(var))

round(runif(200,0,1)) %>% hist() ###pipes

var2= replicate(200,round(runif(200,0,1)))
pg2=colSums(var2/200)*100
hist(pg2)

Tamaño de muestra

n.muestra.p <- function(N, p, e=0.05, z=1.96){
  n=ceiling(N*p*(1-p)/((N-1)*(e/z)^2+p*(1-p)))
  
}
n=n.muestra.p(N=500, p=0.5);n
## [1] 218