Set Up

Library loading

library(ade4)
library(adegraphics)
## 
## Attaching package: 'adegraphics'
## 
## The following objects are masked from 'package:ade4':
## 
##     kplotsepan.coa, s.arrow, s.class, s.corcircle, s.distri,
##     s.image, s.label, s.logo, s.match, s.traject, s.value,
##     table.value, triangle.class
library(dplyr)
## 
## Attaching package: 'dplyr'
## 
## The following object is masked from 'package:stats':
## 
##     filter
## 
## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, setequal, union
library(ggplot2)
library(grid)

Data input

dip <- read.csv("~/Desktop/dip.csv")
cs <- read.csv("~/Desktop/cs.csv")

Data management with dplyr

cs68 <- filter(cs, wave=="1968")
cs75 <- filter(cs, wave=="1975")
cs82 <- filter(cs, wave=="1982")
cs90 <- filter(cs, wave=="1990")
cs99 <- filter(cs, wave=="1999")
cs06 <- filter(cs, wave=="2006")
cs11 <- filter(cs, wave=="2011")
cs68 <- select(cs68, p_cs1:p_cs6)
cs75 <- select(cs75, p_cs1:p_cs6)
cs82 <- select(cs82, p_cs1:p_cs6)
cs90 <- select(cs90, p_cs1:p_cs6)
cs99 <- select(cs99, p_cs1:p_cs6)
cs06 <- select(cs06, p_cs1:p_cs6)
cs11 <- select(cs11, p_cs1:p_cs6)
dip68 <- filter(dip, wave=="1968")
dip75 <- filter(dip, wave=="1975")
dip82 <- filter(dip, wave=="1982")
dip90 <- filter(dip, wave=="1990")
dip99 <- filter(dip, wave=="1999")
dip06 <- filter(dip, wave=="2006")
dip11 <- filter(dip, wave=="2011")
dip68 <- select(dip68, p_dip0:p_dip7)
dip75 <- select(dip75, p_dip0:p_dip7)
dip82 <- select(dip82, p_dip0:p_dip7)
dip90 <- select(dip90, p_dip0:p_dip7)
dip99 <- select(dip99, p_dip0:p_dip7)
dip06 <- select(dip06, p_dip0:p_dip7)
dip11 <- select(dip11, p_dip0:p_dip7)

K-Tables analysis

Centering data frames

wcs68 <- data.frame(scalewt(cs68))
wcs75 <- data.frame(scalewt(cs75))
wcs82 <- data.frame(scalewt(cs82))
wcs90 <- data.frame(scalewt(cs90))
wcs99 <- data.frame(scalewt(cs99))
wcs06 <- data.frame(scalewt(cs06))
wcs11 <- data.frame(scalewt(cs11))

Listing dataframes to produce a K-tables object

lwcs <- list(wcs68, wcs75, wcs82, wcs90, wcs99, wcs06, wcs11)
kwcs <- ktab.list.df(lwcs)

Partial Triadic Analysis

ptawcs <- pta(kwcs, scannf = FALSE, nf=2)
plot(ptawcs)

Multiple Co-Inertia Analysis

mcoawcs <- mcoa(kwcs, scannf = FALSE, nf = 2)
plot(mcoawcs)

Multiple Factorial Analysis

mcoawcs <- mcoa(kwcs, scannf=FALSE, nf=2)
plot(mcoawcs)

Centering the second dataframe

wdip68 <- data.frame(scalewt(dip68))
wdip75 <- data.frame(scalewt(dip75))
wdip82 <- data.frame(scalewt(dip82))
wdip90 <- data.frame(scalewt(dip90))
wdip99 <- data.frame(scalewt(dip99))
wdip06 <- data.frame(scalewt(dip06))
wdip11 <- data.frame(scalewt(dip11))

Assembling the second K-tables object

lwdip <- list(wdip68, wdip75, wdip82, wdip90, wdip99, wdip06, wdip11)
kwdip <- ktab.list.df(lwdip)

Partial Triadic Analysis n?2

ptawdip <- pta(kwdip, scannf = FALSE, nf = 2) 
plot(ptawdip)

Multiple Co-Inertia Analysis

mcoawdip <- mcoa(kwdip, scannf = FALSE, nf = 2)
plot(mcoawdip)

Multiple Factorial Analysis

mfawdip <- mfa(kwdip,  scannf = FALSE, nf = 2)
plot(mfawdip)

Paired K-tables analysis

STATICO : STATIS then PTA

statico1 <- statico(kwdip, kwcs, scan = FALSE)
plot(statico1)

COSTATIS : PTA then STATIS

costatis1 <- costatis(kwdip, kwcs, scan = FALSE)
plot(costatis1)

kmult <- ktab.match2ktabs(kwdip, kwcs)
ptamult <- pta(kmult, scan=FALSE, nf=2)
plot(ptamult)

kplot(ptamult)

Description

df <- cbind(cs, dip)

head(df)
##   region dep                  libdep wave   ids        idt    pop
## 1     82  01                     Ain 1968 82_01 82_01_1968  89180
## 2     22  02                   Aisne 1968 22_02 22_02_1968 115968
## 3     83  03                  Allier 1968 83_03 83_03_1968  90240
## 4     93  04 Alpes-de-Haute-Provence 1968 93_04 93_04_1968  24600
## 5     93  05            Hautes-Alpes 1968 93_05 93_05_1968  22808
## 6     93  06         Alpes-Maritimes 1968 93_06 93_06_1968 178236
##       p_cs1     p_cs2    p_cs3    p_cs4    p_cs5    p_cs6 region dep
## 1 19.533530 11.751510 3.758690 11.28056 16.48800 37.18771     82  01
## 2  9.078366  9.716474 3.959713 13.10706 17.44274 46.69564     22  02
## 3 15.806740 11.728720 4.312943 12.07890 18.86082 37.21188     83  03
## 4 13.528460 14.000000 5.756098 13.86992 17.07317 35.77236     93  04
## 5 19.729920 13.170820 5.559453 12.92529 19.69484 28.91968     93  05
## 6  3.456092 16.214460 7.199443 12.74041 26.68148 33.70812     93  06
##                    libdep wave   ids        idt    pop   p_dip0   p_dip1
## 1                     Ain 1968 82_01 82_01_1968  89180 36.33102 37.26844
## 2                   Aisne 1968 22_02 22_02_1968 115968 40.22834 33.73344
## 3                  Allier 1968 83_03 83_03_1968  90240 33.03635 37.79255
## 4 Alpes-de-Haute-Provence 1968 93_04 93_04_1968  24600 36.86179 32.16260
## 5            Hautes-Alpes 1968 93_05 93_05_1968  22808 32.88320 37.82883
## 6         Alpes-Maritimes 1968 93_06 93_06_1968 178236 35.44738 29.71566
##     p_dip2   p_dip3   p_dip4   p_dip7
## 1 3.740749 12.93115 6.310832 3.417807
## 2 3.338852 12.43791 6.857064 3.404387
## 3 4.485816 12.55762 8.280142 3.847518
## 4 5.739837 11.02439 7.804878 6.406504
## 5 5.243774 11.60996 7.821817 4.612417
## 6 6.712449 12.28932 9.461613 6.373572
p <- ggplot(df, aes(p_dip7, p_cs4))

p + geom_path(aes( colour=factor(dep)))

p + geom_path(aes( colour=wave) ) + facet_wrap(~dep)

p <- ggplot(df, aes(p_cs3, p_dip7))
p + geom_path(aes( colour=wave) ) + facet_wrap(~dep)

dx <- cbind(df, ptamult$Tli)

head(dx)
##        region dep                  libdep wave   ids        idt    pop
## 1.Ana1     82  01                     Ain 1968 82_01 82_01_1968  89180
## 2.Ana1     22  02                   Aisne 1968 22_02 22_02_1968 115968
## 3.Ana1     83  03                  Allier 1968 83_03 83_03_1968  90240
## 4.Ana1     93  04 Alpes-de-Haute-Provence 1968 93_04 93_04_1968  24600
## 5.Ana1     93  05            Hautes-Alpes 1968 93_05 93_05_1968  22808
## 6.Ana1     93  06         Alpes-Maritimes 1968 93_06 93_06_1968 178236
##            p_cs1     p_cs2    p_cs3    p_cs4    p_cs5    p_cs6 region dep
## 1.Ana1 19.533530 11.751510 3.758690 11.28056 16.48800 37.18771     82  01
## 2.Ana1  9.078366  9.716474 3.959713 13.10706 17.44274 46.69564     22  02
## 3.Ana1 15.806740 11.728720 4.312943 12.07890 18.86082 37.21188     83  03
## 4.Ana1 13.528460 14.000000 5.756098 13.86992 17.07317 35.77236     93  04
## 5.Ana1 19.729920 13.170820 5.559453 12.92529 19.69484 28.91968     93  05
## 6.Ana1  3.456092 16.214460 7.199443 12.74041 26.68148 33.70812     93  06
##                         libdep wave   ids        idt    pop   p_dip0
## 1.Ana1                     Ain 1968 82_01 82_01_1968  89180 36.33102
## 2.Ana1                   Aisne 1968 22_02 22_02_1968 115968 40.22834
## 3.Ana1                  Allier 1968 83_03 83_03_1968  90240 33.03635
## 4.Ana1 Alpes-de-Haute-Provence 1968 93_04 93_04_1968  24600 36.86179
## 5.Ana1            Hautes-Alpes 1968 93_05 93_05_1968  22808 32.88320
## 6.Ana1         Alpes-Maritimes 1968 93_06 93_06_1968 178236 35.44738
##          p_dip1   p_dip2   p_dip3   p_dip4   p_dip7        CS1        CS2
## 1.Ana1 37.26844 3.740749 12.93115 6.310832 3.417807 -0.4915543 -1.9701348
## 2.Ana1 33.73344 3.338852 12.43791 6.857064 3.404387 -1.1271310 -2.2096100
## 3.Ana1 37.79255 4.485816 12.55762 8.280142 3.847518  1.8217249  0.8739154
## 4.Ana1 32.16260 5.739837 11.02439 7.804878 6.406504  0.8474948  2.4853602
## 5.Ana1 37.82883 5.243774 11.60996 7.821817 4.612417  1.7468425  1.1674771
## 6.Ana1 29.71566 6.712449 12.28932 9.461613 6.373572  3.3472343  5.6006847
p <- ggplot(dx, aes(CS1, CS2))
p + geom_path(aes( colour=dep) ) 

p + geom_path(aes( colour=dep) ) + facet_wrap(~dep)

dx1 <- cbind(df, ptawdip$Tli)

p <- ggplot(dx1, aes(CS1, CS2))
p + geom_path(aes( colour=dep) ) 

p + geom_path(aes( colour=dep) ) + facet_wrap(~dep)

dx2 <- cbind(df, ptawcs$Tli)

p <- ggplot(dx1, aes(CS1, CS2))
p + geom_path(aes( colour=dep) ) 

p + geom_path(aes( colour=dep) ) + facet_wrap(~dep)

a <- ptawcs$Tli
b <- ptawdip$Tli

a$CSA <- a$CS1
a$CSB <- a$CS2
head(a)
##                CS1         CS2         CSA         CSB
## 1.Ana1 -0.40098469 -0.02385029 -0.40098469 -0.02385029
## 2.Ana1  0.01648166  0.72266447  0.01648166  0.72266447
## 3.Ana1 -0.16129948 -0.08463197 -0.16129948 -0.08463197
## 4.Ana1 -0.01651174 -0.43113204 -0.01651174 -0.43113204
## 5.Ana1 -0.03646098 -0.75798454 -0.03646098 -0.75798454
## 6.Ana1  0.30454036 -1.08101069  0.30454036 -1.08101069
a <- select(a, CSA, CSB)
head(a)
##                CSA         CSB
## 1.Ana1 -0.40098469 -0.02385029
## 2.Ana1  0.01648166  0.72266447
## 3.Ana1 -0.16129948 -0.08463197
## 4.Ana1 -0.01651174 -0.43113204
## 5.Ana1 -0.03646098 -0.75798454
## 6.Ana1  0.30454036 -1.08101069
c <- cbind(a, b)
head(c)
##                CSA         CSB         CS1         CS2
## 1.Ana1 -0.40098469 -0.02385029 -0.49736101  0.19337406
## 2.Ana1  0.01648166  0.72266447 -0.33018361  0.07554173
## 3.Ana1 -0.16129948 -0.08463197 -0.08635054  0.08141458
## 4.Ana1 -0.01651174 -0.43113204  0.52178265 -0.18401691
## 5.Ana1 -0.03646098 -0.75798454  0.04208958 -0.03415939
## 6.Ana1  0.30454036 -1.08101069  0.89155132 -0.37386548
pca <- dudi.pca(c, scannf=FALSE, nf=2)

x <- ggplot(pca$li, aes(x=Axis1, y=Axis2))
x + geom_point()

dfx <- cbind(pca$li, df )
colnames(dfx)
##  [1] "Axis1"  "Axis2"  "region" "dep"    "libdep" "wave"   "ids"   
##  [8] "idt"    "pop"    "p_cs1"  "p_cs2"  "p_cs3"  "p_cs4"  "p_cs5" 
## [15] "p_cs6"  "region" "dep"    "libdep" "wave"   "ids"    "idt"   
## [22] "pop"    "p_dip0" "p_dip1" "p_dip2" "p_dip3" "p_dip4" "p_dip7"
dfx$wave <- as.factor(dfx$wave)

s.traject(pca$li, dfx$wave)

s.traject(pca$li, dfx$dep)

s.traject(pca$li, dfx$dep, col=rainbow(100))

xx <- ggplot(dfx, aes(x=Axis1, y=Axis2))
xx + geom_path(aes(colour=dep))

Analyse croisée : K-tableaux mixtes

df68 <- cbind(cs68, dip68)
df75 <- cbind(cs75, dip75)
df82 <- cbind(cs82, dip82)
df90 <- cbind(cs90, dip90)
df99 <- cbind(cs99, dip99)
df06 <- cbind(cs06, dip06)
df11 <- cbind(cs11, dip11)

dfz <- rbind(df68, df75, df82, df90, df99, df06, df11)
head(dfz)
##       p_cs1     p_cs2    p_cs3    p_cs4    p_cs5    p_cs6   p_dip0
## 1 19.533530 11.751510 3.758690 11.28056 16.48800 37.18771 36.33102
## 2  9.078366  9.716474 3.959713 13.10706 17.44274 46.69564 40.22834
## 3 15.806740 11.728720 4.312943 12.07890 18.86082 37.21188 33.03635
## 4 13.528460 14.000000 5.756098 13.86992 17.07317 35.77236 36.86179
## 5 19.729920 13.170820 5.559453 12.92529 19.69484 28.91968 32.88320
## 6  3.456092 16.214460 7.199443 12.74041 26.68148 33.70812 35.44738
##     p_dip1   p_dip2   p_dip3   p_dip4   p_dip7
## 1 37.26844 3.740749 12.93115 6.310832 3.417807
## 2 33.73344 3.338852 12.43791 6.857064 3.404387
## 3 37.79255 4.485816 12.55762 8.280142 3.847518
## 4 32.16260 5.739837 11.02439 7.804878 6.406504
## 5 37.82883 5.243774 11.60996 7.821817 4.612417
## 6 29.71566 6.712449 12.28932 9.461613 6.373572
wdf68 <- data.frame(scalewt(df68))
wdf75 <- data.frame(scalewt(df75))
wdf82 <- data.frame(scalewt(df82))
wdf90 <- data.frame(scalewt(df90))
wdf99 <- data.frame(scalewt(df99))
wdf06 <- data.frame(scalewt(df06))
wdf11 <- data.frame(scalewt(df11))
lwdf <- list(wdf68, wdf75, wdf82, wdf90, wdf99, wdf06, wdf11)
kwdf <- ktab.list.df(lwdf)

Partial Triadic Analysis

ptawdf <- pta(kwdf, scannf = FALSE, nf = 2) 
plot(ptawdf)

kplot(ptawdf)

Multiple Co-Inertia Analysis

mcoawdf <- mcoa(kwdf, scannf = FALSE, nf = 2)
plot(mcoawdf)

kplot(mcoawdf)

Multiple Factorial Analysis

mfawdf <- mfa(kwdf,  scannf = FALSE, nf = 2)
plot(mfawdf)

kplot(mfawdf)