seq_len
install.packages("data.table")
install.packages("rbenchmark")
library(rbenchmark)
library(data.table)
cc<-vector(length=2)
mm<-list(length=2)
ii<-list(length=2)
temp1<-matrix(nrow=16,ncol=6)
temp1<-as.data.frame(temp1)
temp1[]<-c(256,235,194,235,215,173,215,215,194,215,215,215,194,173,152,215,
430,388,388,388,388,430,430,430,388,346,346,388,388,388,346,388,
283,317,283,283,248,283,283,283,214,214,248,283,214,283,214,248,
3701,3450,3576,3826,3534,3450,3868,4035,3450,3493,3450,3701,3534,3242,3032,3116,
1646,1589,1589,1646,1646,1589,1646,1732,1560,1475,1589,1589,1675,1532,1503,1418,
474,556,556,515,556,556,597,637,556,515,515,515,515,515,434,434)
temp2<- matrix(nrow=11,ncol=6)
temp2<-as.data.frame(temp2)
temp2[]<-c(422,463,462,483,546,525,483,566,546,483,546,
770,812,770,812,854,854,812,939,939,854,981,
1038,1175,1004,1141,1209,1209,1038,1311,1311,1175,1311,
2359,2359,2275,2359,2359,2359,2359,2401,2359,2401,2401,
2445,2531,2417,2588,2759,2617,2388,2674,2730,2645,2731,
1413,1413,1373,1495,1618,1535,1413,1535,1659,1535,1618)
cc[1]<-det(cov(temp1))
cc[2]<-det(cov(temp2))
mm[[1]]<-as.numeric(sapply(temp1,"mean"))
mm[[2]]<-as.numeric(sapply(temp2,"mean"))
ii[[1]]<-solve(cov(temp1))
ii[[2]]<-solve(cov(temp2))
data<-matrix(nrow=10,ncol=6)
data<-as.data.frame(data)
data[]<-c(181,203,224,203,203,224,181,181,161,161,
338,338,338,338,296,296,338,381,338,296,
208,242,208,208,208,208,208,242,208,173,
3164,2954,2660,2787,2744,2787,2534,3457,2870,2912,
1476,1505,1391,1332,1304,1391,1132,1591,1448,1304,
474,474,474,515,392,432,432,556,515,474)
set.seed(101)
benchmark(
rule <- lapply(
seq_len(length(cc)),
function(k){
apply(data,1,function(x)1/(2*pi^(6/2)*cc[k]^(1/2))*exp(-1/2*t(as.numeric(x-mm[[k]]))%*%ii[[k]]%*%(as.numeric(x-mm[[k]]))))
}
)
rule2<-do.call(cbind, rule)
)
library(rbenchmark)
library(data.table)
cc<-vector(length=2)
mm<-list(length=2)
ii<-list(length=2)
temp1<-matrix(nrow=16,ncol=6)
temp1<-as.data.frame(temp1)
temp1[]<-c(256,235,194,235,215,173,215,215,194,215,215,215,194,173,152,215,
430,388,388,388,388,430,430,430,388,346,346,388,388,388,346,388,
283,317,283,283,248,283,283,283,214,214,248,283,214,283,214,248,
3701,3450,3576,3826,3534,3450,3868,4035,3450,3493,3450,3701,3534,3242,3032,3116,
1646,1589,1589,1646,1646,1589,1646,1732,1560,1475,1589,1589,1675,1532,1503,1418,
474,556,556,515,556,556,597,637,556,515,515,515,515,515,434,434)
temp2<- matrix(nrow=11,ncol=6)
temp2<-as.data.frame(temp2)
temp2[]<-c(422,463,462,483,546,525,483,566,546,483,546,
770,812,770,812,854,854,812,939,939,854,981,
1038,1175,1004,1141,1209,1209,1038,1311,1311,1175,1311,
2359,2359,2275,2359,2359,2359,2359,2401,2359,2401,2401,
2445,2531,2417,2588,2759,2617,2388,2674,2730,2645,2731,
1413,1413,1373,1495,1618,1535,1413,1535,1659,1535,1618)
cc[1]<-det(cov(temp1))
cc[2]<-det(cov(temp2))
mm[[1]]<-as.numeric(sapply(temp1,"mean"))
mm[[2]]<-as.numeric(sapply(temp2,"mean"))
ii[[1]]<-solve(cov(temp1))
ii[[2]]<-solve(cov(temp2))
data<-matrix(nrow=10,ncol=6)
data<-as.data.frame(data)
data[]<-c(181,203,224,203,203,224,181,181,161,161,
338,338,338,338,296,296,338,381,338,296,
208,242,208,208,208,208,208,242,208,173,
3164,2954,2660,2787,2744,2787,2534,3457,2870,2912,
1476,1505,1391,1332,1304,1391,1132,1591,1448,1304,
474,474,474,515,392,432,432,556,515,474)
set.seed(101)
benchmark(
rule <- lapply(
seq_len(length(cc)),
function(k){
apply(data,1,function(x)1/(2*pi^(6/2)*cc[k]^(1/2))*exp(-1/2*t(as.numeric(x-mm[[k]]))%*%ii[[k]]%*%(as.numeric(x-mm[[k]]))))
}
)
rule2<-do.call(cbind, rule)
)
library(rbenchmark)
library(data.table)
cc<-vector(length=2)
mm<-list(length=2)
ii<-list(length=2)
temp1<-matrix(nrow=16,ncol=6)
temp1<-as.data.frame(temp1)
temp1[]<-c(256,235,194,235,215,173,215,215,194,215,215,215,194,173,152,215,
430,388,388,388,388,430,430,430,388,346,346,388,388,388,346,388,
283,317,283,283,248,283,283,283,214,214,248,283,214,283,214,248,
3701,3450,3576,3826,3534,3450,3868,4035,3450,3493,3450,3701,3534,3242,3032,3116,
1646,1589,1589,1646,1646,1589,1646,1732,1560,1475,1589,1589,1675,1532,1503,1418,
474,556,556,515,556,556,597,637,556,515,515,515,515,515,434,434)
temp2<- matrix(nrow=11,ncol=6)
temp2<-as.data.frame(temp2)
temp2[]<-c(422,463,462,483,546,525,483,566,546,483,546,
770,812,770,812,854,854,812,939,939,854,981,
1038,1175,1004,1141,1209,1209,1038,1311,1311,1175,1311,
2359,2359,2275,2359,2359,2359,2359,2401,2359,2401,2401,
2445,2531,2417,2588,2759,2617,2388,2674,2730,2645,2731,
1413,1413,1373,1495,1618,1535,1413,1535,1659,1535,1618)
cc[1]<-det(cov(temp1))
cc[2]<-det(cov(temp2))
mm[[1]]<-as.numeric(sapply(temp1,"mean"))
mm[[2]]<-as.numeric(sapply(temp2,"mean"))
ii[[1]]<-solve(cov(temp1))
ii[[2]]<-solve(cov(temp2))
data<-matrix(nrow=10,ncol=6)
data<-as.data.frame(data)
data[]<-c(181,203,224,203,203,224,181,181,161,161,
338,338,338,338,296,296,338,381,338,296,
208,242,208,208,208,208,208,242,208,173,
3164,2954,2660,2787,2744,2787,2534,3457,2870,2912,
1476,1505,1391,1332,1304,1391,1132,1591,1448,1304,
474,474,474,515,392,432,432,556,515,474)
set.seed(101)
benchmark(rule <- lapply(seq_len(length(cc)),function(k){apply(data,1,function(x)1/(2*pi^(6/2)*cc[k]^(1/2))*exp(-1/2*t(as.numeric(x-mm[[k]]))%*%ii[[k]]%*%(as.numeric(x-mm[[k]]))))})
)
rule2<-do.call(cbind, rule)
DT<-data.table(data)
DT[,2:(k+1):=1/(2*pi^(6/2)*cc[k]^(1/2))*exp(-1/2*t(as.numeric(x-mm[[k]]))%*%ii[[k]]%*%(as.numeric(x-mm[[k]])))]
k=c(1:2)
DT<-data.table(data)
DT[,2:(k+1):=1/(2*pi^(6/2)*cc[k]^(1/2))*exp(-1/2*t(as.numeric(x-mm[[k]]))%*%ii[[k]]%*%(as.numeric(x-mm[[k]])))]
k=c(1:2)
DT<-data.table(data)
DT[,2:(k+1):=function(x)1/(2*pi^(6/2)*cc[k]^(1/2))*exp(-1/2*t(as.numeric(x-mm[[k]]))%*%ii[[k]]%*%(as.numeric(x-mm[[k]])))]
k=c(1:2)
DT<-data.table(data)
DT[,2:(k+1):=function(x,k)1/(2*pi^(6/2)*cc[k]^(1/2))*exp(-1/2*t(as.numeric(x-mm[[k]]))%*%ii[[k]]%*%(as.numeric(x-mm[[k]])))]
for (k in 1:2){
DT[,(2:(k+1)):= function(x)1/(2*pi^(6/2)*cc[k]^(1/2))*exp(-1/2*t(as.numeric(x-mm[[k]]))%*%ii[[k]]%*%(as.numeric(x-mm[[k]])))]
}
for (k in 1:2){
DT[,(k+1):= function(x)1/(2*pi^(6/2)*cc[k]^(1/2))*exp(-1/2*t(as.numeric(x-mm[[k]]))%*%ii[[k]]%*%(as.numeric(x-mm[[k]])))]
}
for (k in 1:2){
DT[,(k+1):= function(x) 1/(2*pi^(6/2)*cc[k]^(1/2))*exp(-1/2*t(as.numeric(x-mm[[k]]))%*%ii[[k]]%*%(as.numeric(x-mm[[k]])))]
}
for (k in 1:2){
DT[,y:= function(x) 1/(2*pi^(6/2)*cc[k]^(1/2))*exp(-1/2*t(as.numeric(x-mm[[k]]))%*%ii[[k]]%*%(as.numeric(x-mm[[k]])))]
}
for (k in 1:2){
DT[,(k+1):= function(x) 1/(2*pi^(6/2)*cc[k]^(1/2))*exp(-1/2*t(as.numeric(x-mm[[k]]))%*%ii[[k]]%*%(as.numeric(x-mm[[k]])))]
}
DT
DT<-data.table(data)
DT
install.packages("compiler")
install.packages("compiler")
install.packages("compiler")
install.packages("compiler")
library(compiler)
fun1<-function(x){1/(2*pi^(6/2)*cc[k]^(1/2))*exp(-1/2*t(as.numeric(x-mm[[k]]))%*%ii[[k]]%*%(as.numeric(x-mm[[k]])))}
cfun1<-cmpfun(fun1)
benchmark(lapply(seq_len(length(cc)),function(k){apply(data,1,fun1)))
benchmark(lapply(seq_len(length(cc)),function(k){apply(data,1,fun1)}))
library(rbenchmark)
library(data.table)
library(compiler)
library(rbenchmark)
library(compiler)
cc<-vector(length=2)
mm<-list(length=2)
ii<-list(length=2)
temp1<-matrix(nrow=16,ncol=6)
temp1<-as.data.frame(temp1)
temp1[]<-c(256,235,194,235,215,173,215,215,194,215,215,215,194,173,152,215,
430,388,388,388,388,430,430,430,388,346,346,388,388,388,346,388,
283,317,283,283,248,283,283,283,214,214,248,283,214,283,214,248,
3701,3450,3576,3826,3534,3450,3868,4035,3450,3493,3450,3701,3534,3242,3032,3116,
1646,1589,1589,1646,1646,1589,1646,1732,1560,1475,1589,1589,1675,1532,1503,1418,
474,556,556,515,556,556,597,637,556,515,515,515,515,515,434,434)
temp2<- matrix(nrow=11,ncol=6)
temp2<-as.data.frame(temp2)
temp2[]<-c(422,463,462,483,546,525,483,566,546,483,546,
770,812,770,812,854,854,812,939,939,854,981,
1038,1175,1004,1141,1209,1209,1038,1311,1311,1175,1311,
2359,2359,2275,2359,2359,2359,2359,2401,2359,2401,2401,
2445,2531,2417,2588,2759,2617,2388,2674,2730,2645,2731,
1413,1413,1373,1495,1618,1535,1413,1535,1659,1535,1618)
cc[1]<-det(cov(temp1))
cc[2]<-det(cov(temp2))
mm[[1]]<-as.numeric(sapply(temp1,"mean"))
mm[[2]]<-as.numeric(sapply(temp2,"mean"))
ii[[1]]<-solve(cov(temp1))
ii[[2]]<-solve(cov(temp2))
data<-matrix(nrow=10,ncol=6)
data<-as.data.frame(data)
data[]<-c(181,203,224,203,203,224,181,181,161,161,
338,338,338,338,296,296,338,381,338,296,
208,242,208,208,208,208,208,242,208,173,
3164,2954,2660,2787,2744,2787,2534,3457,2870,2912,
1476,1505,1391,1332,1304,1391,1132,1591,1448,1304,
474,474,474,515,392,432,432,556,515,474)
fun1<-function(x){1/(2*pi^(6/2)*cc[k]^(1/2))*exp(-1/2*t(as.numeric(x-mm[[k]]))%*%ii[[k]]%*%(as.numeric(x-mm[[k]])))}
cfun1<-cmpfun(fun1)
set.seed(101)
benchmark(lapply(seq_len(length(cc)),function(k){apply(data,1,fun1)}))
library(rbenchmark)
library(compiler)
cc<-vector(length=2)
mm<-list(length=2)
ii<-list(length=2)
temp1<-matrix(nrow=16,ncol=6)
temp1<-as.data.frame(temp1)
temp1[]<-c(256,235,194,235,215,173,215,215,194,215,215,215,194,173,152,215,
430,388,388,388,388,430,430,430,388,346,346,388,388,388,346,388,
283,317,283,283,248,283,283,283,214,214,248,283,214,283,214,248,
3701,3450,3576,3826,3534,3450,3868,4035,3450,3493,3450,3701,3534,3242,3032,3116,
1646,1589,1589,1646,1646,1589,1646,1732,1560,1475,1589,1589,1675,1532,1503,1418,
474,556,556,515,556,556,597,637,556,515,515,515,515,515,434,434)
temp2<- matrix(nrow=11,ncol=6)
temp2<-as.data.frame(temp2)
temp2[]<-c(422,463,462,483,546,525,483,566,546,483,546,
770,812,770,812,854,854,812,939,939,854,981,
1038,1175,1004,1141,1209,1209,1038,1311,1311,1175,1311,
2359,2359,2275,2359,2359,2359,2359,2401,2359,2401,2401,
2445,2531,2417,2588,2759,2617,2388,2674,2730,2645,2731,
1413,1413,1373,1495,1618,1535,1413,1535,1659,1535,1618)
cc[1]<-det(cov(temp1))
cc[2]<-det(cov(temp2))
mm[[1]]<-as.numeric(sapply(temp1,"mean"))
mm[[2]]<-as.numeric(sapply(temp2,"mean"))
ii[[1]]<-solve(cov(temp1))
ii[[2]]<-solve(cov(temp2))
data<-matrix(nrow=10,ncol=6)
data<-as.data.frame(data)
data[]<-c(181,203,224,203,203,224,181,181,161,161,
338,338,338,338,296,296,338,381,338,296,
208,242,208,208,208,208,208,242,208,173,
3164,2954,2660,2787,2744,2787,2534,3457,2870,2912,
1476,1505,1391,1332,1304,1391,1132,1591,1448,1304,
474,474,474,515,392,432,432,556,515,474)
fun1<-function(x,k){1/(2*pi^(6/2)*cc[k]^(1/2))*exp(-1/2*t(as.numeric(x-mm[[k]]))%*%ii[[k]]%*%(as.numeric(x-mm[[k]])))}
cfun1<-cmpfun(fun1)
set.seed(101)
benchmark(lapply(seq_len(length(cc)),function(k){apply(data,1,fun1)}))
set.seed(101)
fun2<-function(k){apply(data,1,function(x)1/(2*pi^(6/2)*cc[k]^(1/2))*exp(-1/2*t(as.numeric(x-mm[[k]]))%*%ii[[k]]%*%(as.numeric(x-mm[[k]]))))}
rule2<-lapply(seq_len(length(cc)),fun2)
rule2
set.seed(101)
fun2<-function(k){apply(data,1,function(x)1/(2*pi^(6/2)*cc[k]^(1/2))*exp(-1/2*t(as.numeric(x-mm[[k]]))%*%ii[[k]]%*%(as.numeric(x-mm[[k]]))))}
cfun2<-cmpfun(fun2)
benchmark(lapply(seq_len(length(cc)),fun2),
lapply(seq_len(length(cc)),cfun2))
benchmark(rule2<-lapply(seq_len(length(cc)),fun2),
rule2<-lapply(seq_len(length(cc)),cfun2))
set.seed(101)
fun2<-function(k){apply(data,1,function(x)1/(2*pi^(6/2)*cc[k]^(1/2))*exp(-1/2*t(as.numeric(x-mm[[k]]))%*%ii[[k]]%*%(as.numeric(x-mm[[k]]))))}
cfun2<-cmpfun(fun2)
benchmark(rule2<-lapply(seq_len(length(cc)),fun2),
rule2<-lapply(seq_len(length(cc)),cfun2))
data<-matrix(nrow=10000,ncol=6)
data<-as.data.frame(data)
data[]<-c(181,203,224,203,203,224,181,181,161,161,
338,338,338,338,296,296,338,381,338,296,
208,242,208,208,208,208,208,242,208,173,
3164,2954,2660,2787,2744,2787,2534,3457,2870,2912,
1476,1505,1391,1332,1304,1391,1132,1591,1448,1304,
474,474,474,515,392,432,432,556,515,474)
benchmark(rule2<-lapply(seq_len(length(cc)),fun2),
rule2<-lapply(seq_len(length(cc)),cfun2))
data<-matrix(nrow=1000,ncol=6)
data<-as.data.frame(data)
data[]<-c(181,203,224,203,203,224,181,181,161,161,
338,338,338,338,296,296,338,381,338,296,
208,242,208,208,208,208,208,242,208,173,
3164,2954,2660,2787,2744,2787,2534,3457,2870,2912,
1476,1505,1391,1332,1304,1391,1132,1591,1448,1304,
474,474,474,515,392,432,432,556,515,474)
set.seed(101)
fun2<-function(k){apply(data,1,function(x)1/(2*pi^(6/2)*cc[k]^(1/2))*exp(-1/2*t(as.numeric(x-mm[[k]]))%*%ii[[k]]%*%(as.numeric(x-mm[[k]]))))}
cfun2<-cmpfun(fun2)
benchmark(rule2<-lapply(seq_len(length(cc)),fun2),
rule2<-lapply(seq_len(length(cc)),cfun2))
library(rbenchmark)
library(compiler)
cc<-vector(length=2)
mm<-list(length=2)
ii<-list(length=2)
temp1<-matrix(nrow=16,ncol=6)
temp1<-as.data.frame(temp1)
temp1[]<-c(256,235,194,235,215,173,215,215,194,215,215,215,194,173,152,215,
430,388,388,388,388,430,430,430,388,346,346,388,388,388,346,388,
283,317,283,283,248,283,283,283,214,214,248,283,214,283,214,248,
3701,3450,3576,3826,3534,3450,3868,4035,3450,3493,3450,3701,3534,3242,3032,3116,
1646,1589,1589,1646,1646,1589,1646,1732,1560,1475,1589,1589,1675,1532,1503,1418,
474,556,556,515,556,556,597,637,556,515,515,515,515,515,434,434)
temp2<- matrix(nrow=11,ncol=6)
temp2<-as.data.frame(temp2)
temp2[]<-c(422,463,462,483,546,525,483,566,546,483,546,
770,812,770,812,854,854,812,939,939,854,981,
1038,1175,1004,1141,1209,1209,1038,1311,1311,1175,1311,
2359,2359,2275,2359,2359,2359,2359,2401,2359,2401,2401,
2445,2531,2417,2588,2759,2617,2388,2674,2730,2645,2731,
1413,1413,1373,1495,1618,1535,1413,1535,1659,1535,1618)
cc[1]<-det(cov(temp1))
cc[2]<-det(cov(temp2))
mm[[1]]<-as.numeric(sapply(temp1,"mean"))
mm[[2]]<-as.numeric(sapply(temp2,"mean"))
ii[[1]]<-solve(cov(temp1))
ii[[2]]<-solve(cov(temp2))
data<-matrix(nrow=1000,ncol=6)
data<-as.data.frame(data)
data[]<-c(181,203,224,203,203,224,181,181,161,161,
338,338,338,338,296,296,338,381,338,296,
208,242,208,208,208,208,208,242,208,173,
3164,2954,2660,2787,2744,2787,2534,3457,2870,2912,
1476,1505,1391,1332,1304,1391,1132,1591,1448,1304,
474,474,474,515,392,432,432,556,515,474)
set.seed(101)
fun2<-function(k){apply(data,1,function(x)1/(2*pi^(6/2)*cc[k]^(1/2))*exp(-1/2*t(as.numeric(x-mm[[k]]))%*%ii[[k]]%*%(as.numeric(x-mm[[k]]))))}
cfun2<-cmpfun(fun2)
benchmark(lapply(seq_len(length(cc)),fun2),
lapply(seq_len(length(cc)),cfun2))
#rule2<-do.call(cbind, rule)
library(rbenchmark)
library(compiler)
cc<-vector(length=2)
mm<-list(length=2)
ii<-list(length=2)
temp1<-matrix(nrow=16,ncol=6)
temp1<-as.data.frame(temp1)
temp1[]<-c(256,235,194,235,215,173,215,215,194,215,215,215,194,173,152,215,
430,388,388,388,388,430,430,430,388,346,346,388,388,388,346,388,
283,317,283,283,248,283,283,283,214,214,248,283,214,283,214,248,
3701,3450,3576,3826,3534,3450,3868,4035,3450,3493,3450,3701,3534,3242,3032,3116,
1646,1589,1589,1646,1646,1589,1646,1732,1560,1475,1589,1589,1675,1532,1503,1418,
474,556,556,515,556,556,597,637,556,515,515,515,515,515,434,434)
temp2<- matrix(nrow=11,ncol=6)
temp2<-as.data.frame(temp2)
temp2[]<-c(422,463,462,483,546,525,483,566,546,483,546,
770,812,770,812,854,854,812,939,939,854,981,
1038,1175,1004,1141,1209,1209,1038,1311,1311,1175,1311,
2359,2359,2275,2359,2359,2359,2359,2401,2359,2401,2401,
2445,2531,2417,2588,2759,2617,2388,2674,2730,2645,2731,
1413,1413,1373,1495,1618,1535,1413,1535,1659,1535,1618)
cc[1]<-det(cov(temp1))
cc[2]<-det(cov(temp2))
mm[[1]]<-as.numeric(sapply(temp1,"mean"))
mm[[2]]<-as.numeric(sapply(temp2,"mean"))
ii[[1]]<-solve(cov(temp1))
ii[[2]]<-solve(cov(temp2))
data<-matrix(nrow=1000,ncol=6)
data<-as.data.frame(data)
data[]<-c(181,203,224,203,203,224,181,181,161,161,
338,338,338,338,296,296,338,381,338,296,
208,242,208,208,208,208,208,242,208,173,
3164,2954,2660,2787,2744,2787,2534,3457,2870,2912,
1476,1505,1391,1332,1304,1391,1132,1591,1448,1304,
474,474,474,515,392,432,432,556,515,474)
set.seed(101)
fun2<-function(k){apply(data,1,function(x)1/(2*pi^(6/2)*cc[k]^(1/2))*exp(-1/2*t(as.numeric(x-mm[[k]]))%*%ii[[k]]%*%(as.numeric(x-mm[[k]]))))}
fun3<-function(k){with(data,function(x)1/(2*pi^(6/2)*cc[k]^(1/2))*exp(-1/2*t(as.numeric(x-mm[[k]]))%*%ii[[k]]%*%(as.numeric(x-mm[[k]]))))}
cfun2<-cmpfun(fun2)
benchmark(lapply(seq_len(length(cc)),fun2),
lapply(seq_len(length(cc)),cfun2),
lapply(seq_len(length(cc)),fun3))
#rule2<-do.call(cbind, rule)
data<-matrix(nrow=10,ncol=6)
data<-as.data.frame(data)
data[]<-c(181,203,224,203,203,224,181,181,161,161,
338,338,338,338,296,296,338,381,338,296,
208,242,208,208,208,208,208,242,208,173,
3164,2954,2660,2787,2744,2787,2534,3457,2870,2912,
1476,1505,1391,1332,1304,1391,1132,1591,1448,1304,
474,474,474,515,392,432,432,556,515,474)
set.seed(101)
fun2<-function(k){apply(data,1,function(x)1/(2*pi^(6/2)*cc[k]^(1/2))*exp(-1/2*t(as.numeric(x-mm[[k]]))%*%ii[[k]]%*%(as.numeric(x-mm[[k]]))))}
fun3<-function(k){with(data,function(x)1/(2*pi^(6/2)*cc[k]^(1/2))*exp(-1/2*t(as.numeric(x-mm[[k]]))%*%ii[[k]]%*%(as.numeric(x-mm[[k]]))))}
rules2<-lapply(seq_len(length(cc)),fun3)
rules2
fun3(1)
lapply(seq_len(length(cc)),fun3)
k=1
pp<-with(data,function(x)1/(2*pi^(6/2)*cc[k]^(1/2))*exp(-1/2*t(as.numeric(x-mm[[k]]))%*%ii[[k]]%*%(as.numeric(x-mm[[k]]))))
pp
rule2
#Carrega os pacotes
library(raster)
library(rgdal)
library(klaR)
#Carrega os pacotes
library(raster)
library(rgdal)
library(klaR)
#Determina diretório de dados
setwd("C:/Users/Mariane/Dropbox/dados_R/Aula_POPEA/dados")
dir()
dir()[1]
#Atribui ao objeto 'classificacao' a classificação de interesse
classificacao<-raster("classificacao.tif")
plot(classificacao)
x11()
plot(classificacao)
classes<-c("PL",  "PS", "SS1", "CL",  "SS3", "SE",  "AP", "SS2", "FP","FD")
#Atribui ao objeto 'amostras' o shapefile 'amostras_2010.shp"
amostras<-readOGR ("amostras_2010.shp", "amostras_2010")
plot(amostras)
#Extrai os valores dos pixels da classificacao para cada polígono das amostras
val<-extract(classificacao,amostras, df=TRUE)
View(val)
which(val[,2]==k)
k=1
which(val[,2]==k)
View(val)
#Para cada classe...
for (k in 1:length(classes)){
#...troca os valores numéricos da classificação pelo nome da classe
val[which(val[,2]==k),2]<-classes[k]
}
View(val)
dim(val)
dim(val)[2]
#Atribui ap objeto 'coluna' o número de colunas contidos em 'val'+1 (número de coluna extra onde incluiremos o atributo de classe ao objeto 'val')
coluna<-dim(val)[2]+1
coluna
#Para cada polígono da amostra...
for (l in 1:length(classesid)){
#... atribui à coluna extra a classe do polígono.
val[which(val[,1]==l),coluna]<-classesid[l]
}
#Atribui ao objeto 'classesid' a coluna de classes do shape das amostras
classesid<-amostras$Classe
#Para cada polígono da amostra...
for (l in 1:length(classesid)){
#... atribui à coluna extra a classe do polígono.
val[which(val[,1]==l),coluna]<-classesid[l]
}
#Muda o nome da coluna
colnames(val)[coluna]<-"referencia"
#Calcula uma matrix de confusão
MC<-errormatrix(val[,3],val[,2])
MC
#Extrai apenas as primeiras 10 linhas e colunas da matrix
MC_r<-MC[1:10,1:10]
MC_r
table(val[,3],val[,2])
MC_r
#Extrai os valores dos pixels da classificacao para cada polígono das amostras
val<-extract(classificacao,amostras, df=TRUE)
View(val)
#Para cada classe...
for (k in 1:length(classes)){
#...troca os valores numéricos da classificação pelo nome da classe
val[which(val[,2]==k),2]<-classes[k]
}
#Atribui ap objeto 'coluna' o número de colunas contidos em 'val'+1 (número de coluna extra onde incluiremos o atributo de classe ao objeto 'val')
coluna<-dim(val)[2]+1
#Para cada polígono da amostra...
for (l in 1:length(classesid)){
#... atribui à coluna extra a classe do polígono.
val[which(val[,1]==l),coluna]<-classesid[l]
}
#Muda o nome da coluna
colnames(val)[coluna]<-"referencia"
#Calcula uma matrix de confusão
MC<-errormatrix(val[,3],val[,2])
#Extrai apenas as primeiras 10 linhas e colunas da matrix
MC_r<-MC[1:10,1:10]
MC_r
acertos=0
c=1
acertos<-acertos+MC_r[c,c]
acertos
c=2
acertos<-acertos+MC_r[c,c]
acertos
acertos=0
for (c in 1:dim(MC_r)[1]){
acertos<-acertos+MC_r[c,c]
}
acertos
#Calcula o total de pontos
total<-sum(MC_r)
#Calcula o índice de Exatidão Global
EG<-acertos/total
EG
