# Linear Discriminant Analysis with Jacknifed Prediction > library(mass)



Descargar 31.75 Kb.
Fecha de conversión01.03.2017
Tamaño31.75 Kb.
> # Linear Discriminant Analysis with Jacknifed Prediction

> library(MASS)

> mydata<-mtcars

> mydata


mpg cyl disp hp drat wt qsec vs am gear carb

Mazda RX4 21.0 6 160.0 110 3.90 2.620 16.46 0 1 4 4

Mazda RX4 Wag 21.0 6 160.0 110 3.90 2.875 17.02 0 1 4 4

Datsun 710 22.8 4 108.0 93 3.85 2.320 18.61 1 1 4 1

Hornet 4 Drive 21.4 6 258.0 110 3.08 3.215 19.44 1 0 3 1

Hornet Sportabout 18.7 8 360.0 175 3.15 3.440 17.02 0 0 3 2

Valiant 18.1 6 225.0 105 2.76 3.460 20.22 1 0 3 1

Duster 360 14.3 8 360.0 245 3.21 3.570 15.84 0 0 3 4

Merc 240D 24.4 4 146.7 62 3.69 3.190 20.00 1 0 4 2

Merc 230 22.8 4 140.8 95 3.92 3.150 22.90 1 0 4 2

Merc 280 19.2 6 167.6 123 3.92 3.440 18.30 1 0 4 4

Merc 280C 17.8 6 167.6 123 3.92 3.440 18.90 1 0 4 4

Merc 450SE 16.4 8 275.8 180 3.07 4.070 17.40 0 0 3 3

Merc 450SL 17.3 8 275.8 180 3.07 3.730 17.60 0 0 3 3

Merc 450SLC 15.2 8 275.8 180 3.07 3.780 18.00 0 0 3 3

Cadillac Fleetwood 10.4 8 472.0 205 2.93 5.250 17.98 0 0 3 4

Lincoln Continental 10.4 8 460.0 215 3.00 5.424 17.82 0 0 3 4

Chrysler Imperial 14.7 8 440.0 230 3.23 5.345 17.42 0 0 3 4

Fiat 128 32.4 4 78.7 66 4.08 2.200 19.47 1 1 4 1

Honda Civic 30.4 4 75.7 52 4.93 1.615 18.52 1 1 4 2

Toyota Corolla 33.9 4 71.1 65 4.22 1.835 19.90 1 1 4 1

Toyota Corona 21.5 4 120.1 97 3.70 2.465 20.01 1 0 3 1

Dodge Challenger 15.5 8 318.0 150 2.76 3.520 16.87 0 0 3 2

AMC Javelin 15.2 8 304.0 150 3.15 3.435 17.30 0 0 3 2

Camaro Z28 13.3 8 350.0 245 3.73 3.840 15.41 0 0 3 4

Pontiac Firebird 19.2 8 400.0 175 3.08 3.845 17.05 0 0 3 2

Fiat X1-9 27.3 4 79.0 66 4.08 1.935 18.90 1 1 4 1

Porsche 914-2 26.0 4 120.3 91 4.43 2.140 16.70 0 1 5 2

Lotus Europa 30.4 4 95.1 113 3.77 1.513 16.90 1 1 5 2

Ford Pantera L 15.8 8 351.0 264 4.22 3.170 14.50 0 1 5 4

Ferrari Dino 19.7 6 145.0 175 3.62 2.770 15.50 0 1 5 6

Maserati Bora 15.0 8 301.0 335 3.54 3.570 14.60 0 1 5 8

Volvo 142E 21.4 4 121.0 109 4.11 2.780 18.60 1 1 4 2

> fit <- lda(as.factor(cyl)~mpg+disp+hp+wt+drat, data=mydata,

+ na.action="na.omit", CV=TRUE)

> fit2 <- lda(as.factor(cyl)~mpg+disp+hp+wt+drat, data=mydata,

+ na.action="na.omit" )

> fit # show results

$class

[1] 6 6 4 8 8 6 8 4 4 6 6 8 8 8 8 8 8 4 4 4 6 8 8 8 8 4 4 4 8 6 8 4



Levels: 4 6 8

$posterior

4 6 8

Mazda RX4 3.013780e-01 6.985767e-01 4.522390e-05



Mazda RX4 Wag 3.652186e-01 6.347665e-01 1.491405e-05

Datsun 710 5.402837e-01 4.597159e-01 4.484405e-07

Hornet 4 Drive 9.903633e-03 3.165123e-01 6.735841e-01

Hornet Sportabout 1.612812e-08 6.683709e-05 9.999331e-01

Valiant 2.659551e-03 9.316142e-01 6.572625e-02

Duster 360 2.203398e-12 7.941337e-07 9.999992e-01

Merc 240D 8.716717e-01 1.283283e-01 4.130740e-08

Merc 230 7.437263e-01 2.562735e-01 2.101050e-07

Merc 280 3.462527e-01 6.537388e-01 8.464385e-06

Merc 280C 1.972490e-01 8.027406e-01 1.037515e-05

Merc 450SE 1.599861e-04 4.525907e-01 5.472493e-01

Merc 450SL 3.598821e-05 1.097349e-01 8.902291e-01

Merc 450SLC 1.827432e-05 1.312697e-01 8.687121e-01

Cadillac Fleetwood 3.490950e-15 3.474633e-08 1.000000e+00

Lincoln Continental 6.202829e-14 2.114787e-07 9.999998e-01

Chrysler Imperial 2.248539e-11 7.208622e-07 9.999993e-01

Fiat 128 9.997275e-01 2.725363e-04 9.456279e-13

Honda Civic 9.999449e-01 5.513641e-05 4.058485e-15

Toyota Corolla 9.999276e-01 7.240697e-05 2.427122e-13

Toyota Corona 1.702390e-01 8.297587e-01 2.383044e-06

Dodge Challenger 3.934163e-07 8.246725e-03 9.917529e-01

AMC Javelin 7.766700e-06 5.813710e-02 9.418551e-01

Camaro Z28 1.061118e-09 4.252057e-05 9.999575e-01

Pontiac Firebird 1.514821e-09 5.125879e-06 9.999949e-01

Fiat X1-9 9.857341e-01 1.426585e-02 4.377196e-10

Porsche 914-2 9.671581e-01 3.284187e-02 2.841788e-08

Lotus Europa 8.816310e-01 1.183618e-01 7.161838e-06

Ford Pantera L 4.308602e-10 2.456631e-06 9.999975e-01

Ferrari Dino 4.436020e-02 9.528767e-01 2.763127e-03

Maserati Bora 1.252567e-13 1.327080e-07 9.999999e-01

Volvo 142E 5.407947e-01 4.592050e-01 3.479128e-07
$call

lda(formula = as.factor(cyl) ~ mpg + disp + hp + wt + drat, data = mydata,

CV = TRUE, na.action = "na.omit")
$xlevels

list()
> fit2## ojo leer la proporcion de la traza

Call:

lda(as.factor(cyl) ~ mpg + disp + hp + wt + drat, data = mydata,



na.action = "na.omit")
Prior probabilities of groups:

4 6 8


0.34375 0.21875 0.43750
Group means:

mpg disp hp wt drat

4 26.66364 105.1364 82.63636 2.285727 4.070909

6 19.74286 183.3143 122.28571 3.117143 3.585714

8 15.10000 353.1000 209.21429 3.999214 3.229286
Coefficients of linear discriminants:

LD1 LD2


mpg -0.07964862 0.309141863

disp 0.01689792 0.013743460

hp 0.01385196 0.006267961

wt -0.81439975 -0.136955599

drat -0.94799405 0.720295510
Proportion of trace:

LD1 LD2


0.9705 0.0295

> # Assess the accuracy of the prediction

> # percent correct for each category of G

> ct <- table(mydata$cyl, fit$class)

> diag(prop.table(ct, 1))

4 6 8


0.9090909 0.8571429 1.0000000

> # total percent correct

> sum(diag(prop.table(ct)))

[1] 0.9375

> #datos centrados por coeficientes de las funciones discriminantes

> scores<-scale(as.matrix(mydata[,c("mpg","disp","hp","wt","drat")]),scale=FALSE)%*%(fit2$scaling[,1:2])

> #centroides centrados por coeficientes de las funciones discriminantes

> centroscores<-scale(as.matrix(fit2$means[,]),scale=FALSE)%*%(fit2$scaling[,1:2])

> ##grafica funciones discriminantes

> plot(scores[,1],scores[,2],type="n",main="evaluaciones de las fun. discr.",xlab="fun.discr.1",ylab="fun.discr.2")

> text(scores[,1],scores[,2],cex=.5,labels=fit$class,col=c(fit$class))

> points(centroscores[1:3,1], centroscores[1:3,2], pch=13,col=c(1,2,3),cex=1.5)

>

> # Lo que ya existe para graficar, caso lineal y cuadratico



> # Exploratory Graph for LDA or QDA

> # Quadratic Discriminant Analysis with 3 groups applying

> # resubstitution prediction and equal prior probabilities.

>

> fit3 <- qda(as.factor(cyl)~mpg+disp+hp+wt+drat, data=na.omit(mydata),prior=c(1,1,1)/3)



>

> fit3


Call:

qda(as.factor(cyl) ~ mpg + disp + hp + wt + drat, data = na.omit(mydata),

prior = c(1, 1, 1)/3)
Prior probabilities of groups:

4 6 8


0.3333333 0.3333333 0.3333333
Group means:

mpg disp hp wt drat

4 26.66364 105.1364 82.63636 2.285727 4.070909

6 19.74286 183.3143 122.28571 3.117143 3.585714

8 15.10000 353.1000 209.21429 3.999214 3.229286

> library(klaR)

> partimat(as.factor(cyl)~mpg+disp+hp+wt+drat ,data=mydata,method="lda")

> partimat(as.factor(cyl)~mpg+disp+hp+wt+drat ,data=mydata,method="qda")

> # Scatterplot for 3 Group Problem

> pairs(mydata[c("mpg","disp","hp","wt","drat")], main="mtcars ", pch=22,

+ col= (mydata$cyl))

> #misma grafica otros colores

> pairs(mydata[c("mpg","disp","hp","wt","drat")], main="mtcars ", pch=22,

+ bg=c("red", "yellow", "blue")[unclass(as.factor(mydata$cyl))])

> #misma grafica otra presentacion

> pairs(mydata[c("mpg","disp","hp","wt","drat")], main="mtcars ", pch=unclass(as.factor(mydata$cyl)),col=unclass(as.factor(mydata$cyl)))











La base de datos está protegida por derechos de autor ©bazica.org 2016
enviar mensaje

    Página principal