Avionic/fonctions.R at master · InseeFr/Avionic · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174


##############################################################
## Fonction qui retourne une matrice carrée donnée en entrée ##
##############################################################

## La fonction prend en entrée une matrice carrée sous format csv (il faut indiquer le chemin)
## La fonction crée la matrice sous R


matrice <- function(fichier)
{
  donnees<-read.table(fichier,sep=";")
  A <- as.matrix (donnees)
  return (A)
}


##############################################################
## Fonction qui inverse une matrice carrée donnée en entrée ##
##############################################################

## La fonction prend en entrée une matrice carrée
## La fonction crée la matrice inverse de cette matrice


inverse <- function(mat)
{
  return (solve(mat))
}


###################################################################################
## Fonction qui retourne I-A (I+A pour la 2) pour une matrice A carrée en entrée ##
###################################################################################

## La fonction prend en entrée une matrice carrée.
## La fonction crée la matrice identité moins la matrice en entrée.


identite <- function(A)
{
  rang <- nrow(A)
  I <- diag(nrow = rang)
  return (I-A)
}


####################################################
## Fonction de calcul des coefficients techniques ##
####################################################

## La fonction prend en entrée :
    ## - un TEI domestique ou importé (A) sous forme de matrice carrée
    ## - la production ou vecteur des importations totale de chaque branche (B) sous forme de vecteur
## La fonction crée la matrice des coefficients techniques domestiques ou importés.


  coef_techniques <- function (A,B)
  {
    tei <- A
    prod <- B
    ctec <- matrix(nrow = nrow(tei), ncol = ncol(tei))
    if (ncol(tei) == length(prod)) {
      for (i in 1:nrow(tei)) {
        for (j in 1:ncol(tei)) {
          if (prod[j]==0) {
            ctec[i,j] <- 0
          }else{
            ctec[i,j] <- tei[i,j]/prod[j]
          }
        }
      }
      return (ctec)
    }else {
      cat("Erreur : la taille du vecteur de production et du TEI ne sont pas cohérentes")
    }
  }

coef_debouches <- function (A,B)
{
  tei <- A
  prod <- B
  ctec <- matrix(nrow = nrow(tei), ncol = ncol(tei))
  if (ncol(tei) == length(prod)) {
    for (i in 1:nrow(tei)) {
      for (j in 1:ncol(tei)) {
        if (prod[i]==0) {
          ctec[i,j] <- 0
        }else{
          ctec[i,j] <- tei[i,j]/prod[i]
        }
      }
    }
    return (t(ctec))
  }else {
    cat("Erreur : la taille du vecteur de production et du TEI ne sont pas cohérentes")
  }
}

############################################
## Calcul des effets directs et indirects ##
############################################

## Les fonctions prennent en entrée la matrice des coefficients techniques et retournent les
## multiplicateurs directs et indirects

direct <- function(A)
{
  rang <- nrow(A)
  I <- diag(nrow = rang)
  return (I+A)
}

indirect <- function(A)
{
  rang <- nrow(A)
  I <- diag(nrow = rang)
  I_A <- identite(A=A)
  inv_I_A <- inverse(mat=I_A)
  return (inv_I_A-I-A)
}

indirect_imp <- function(A,B) {
  rang <- nrow(A)
  I <- diag(nrow = rang)
  I_A <- identite(A=A)
  inv_I_A <- inverse(mat=I_A)
  return (B %*% inv_I_A-B)
}

####################################################
## Création indices de prix et recalcul de valeur ##
####################################################

indice_prix <- function(valeur, volume)
{
  ind_prix <- matrix(nrow = nrow(valeur), ncol = ncol(valeur))
  if (ncol(valeur) == ncol(volume) & nrow(valeur) == nrow(volume)) {
    for (i in 1:nrow(valeur)) {
      for (j in 1:ncol(valeur)) {
        if (volume[i,j]==0) {
          ind_prix[i,j] <- 0
        } else {
          ind_prix[i,j] <- valeur[i,j]/volume[i,j]
        }
      }
    }
  } else {
    cat("Erreur : les tailles des matrices volume et valeur ne sont pas identiques")
  }
  return (ind_prix)
}


valeur <- function(prix, volume)
{
  valeur <- matrix(nrow = nrow(prix), ncol = ncol(prix))
  if (ncol(prix) == ncol(volume) & nrow(prix) == nrow(volume)) {
    for (i in 1:nrow(prix)) {
      for (j in 1:ncol(prix)) {
        valeur[i,j] <- prix[i,j]*volume[i,j]
      }
    }
  } else {
    cat("Erreur : les tailles des matrices volume et valeur ne sont pas identiques")
  }
  return (valeur)
}