Newer
Older
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
'' PL926 ", header = TRUE) %>%
as_tibble() %>% mutate (COUNTRY = "POL", version = "2013To2016",
change_nuts3 = case_when(NUTS3 == "PL129" ~"boundary shift",
NUTS3 == "PL12A" ~ "boundary shift lost new PL926, PL913=PL12A-new PL926",
is.na(NUTS3)~ "new region",
TRUE ~ "recoded"),
from_NUTS3 = if_else( NUTS3 == "PL12A", "boundary shift lost new PL926, PL913=PL12A-new PL926",""),
from_ex_NUTS3= "")
# final ----
pol_nuts3_tmp <- bind_rows(pol_nuts3_2006,pol_nuts3_2013, pol_nuts3_2016) %>% mutate(regional_surface = "")
changed <- pol_nuts3_tmp %>% mutate_if(is.factor, as.character) %>%
mutate_at(.vars = vars(NUTS3_new),
.funs = list("new" = ~ ifelse(NUTS3_new %in% NUTS3 & NUTS3_new != "", NUTS3,. ),
"change" = ~ ifelse(NUTS3_new %in% NUTS3 & NUTS3_new != "", "changed",. )))
tmp <- changed %>% filter (change=="changed") %>% select(NUTS3_new) %>%
left_join(pol_nuts3_tmp, by= c("NUTS3_new" = "NUTS3")) %>%
rename(NUTS3_new_new = NUTS3_new.y,
NUTS3_origin = NUTS3_new ) %>%select( NUTS3_origin, NUTS3_new_new)
pol_nuts3 <- changed %>% left_join(tmp, by = c("NUTS3_new"= "NUTS3_origin")) %>% mutate(new =as.factor(new)) %>%
mutate(new = case_when(change=="changed"~ NUTS3_new_new,TRUE~new)) %>% select(-NUTS3_new) %>%
rename(NUTS3_new=new)%>% select(-NUTS3_new_new, -change)
rm(pol_nuts3_tmp,changed,tmp)
(pol_nuts3 %>% filter(NUTS3_new!= ""))$NUTS3_new %in% (pol_nuts3 %>% filter(NUTS3_new!= ""))$NUTS3
# str_data$info %>% filter (COUNTRY == "POL") %>% left_join(pol_nuts3) %>%
# mutate(NUTS3_new= as.character(NUTS3_new)) %>%
# mutate(change_nuts3 = if_else(is.na(change_nuts3),"no change", change_nuts3),
# NUTS3_new = if_else(is.na(NUTS3_new), NUTS3, NUTS3_new )) %>%
# mutate(NUTS3=if_else(change_nuts3 == "no change", NUTS3, NUTS3_new)) %>%
# filter( change_nuts3 != "Terminated") %>%
# count(NUTS3,YEAR) %>%
# arrange(YEAR) %>%
# mutate(across(3:last_col(),function(x)ifelse(is.na(x),0,1))) %>% ggplot ( aes(YEAR,NUTS3, fill= n)) + geom_tile() +
# theme(legend.position="none")
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
# por ####
por_nuts3 <- read.table(text = "NUTS3 NUTS3_new change_nuts3 from_ex_NUTS3
# PT113 '' 'boundary shift' ''
# PT114 '' 'boundary shift' ''
# PT115 '' 'boundary shift' ''
# PT116 '' 'boundary shift' ''
# PT117 '' 'boundary shift' ''
# PT118 '' 'boundary shift' ''
PT113 PT119 'boundary shift, new region' 'PT119=parts of PT113+parts of PT115'
PT115 PT119 'boundary shift, new region' 'PT119=parts of PT113+parts of PT115'
PT114 PT11A 'boundary shift, new region' 'PT11A=PT116+parts of PT114+parts of PT115'
PT115 PT11A 'boundary shift, new region' 'PT11A=PT116+parts of PT114+parts of PT115'
PT115 PT11B 'boundary shift, new region' 'PT11B=parts of PT115+parts of PT118'
PT118 PT11B 'boundary shift, new region' 'PT11B=parts of PT115+parts of PT118'
PT115 PT11C 'boundary shift, new region' 'PT11C=parts of PT115'
PT117 PT11D 'boundary shift, new region' 'PT11D=parts of PT117'
PT117 PT11E 'boundary shift, new region' 'PT11E=parts of PT117+parts of PT118'
PT118 PT11E 'boundary shift, new region' 'PT11E=parts of PT117+parts of PT118'
# PT161 '' 'boundary shift' ''
# PT162 '' 'boundary shift' ''
# PT163 '' 'boundary shift' ''
# PT164 '' 'boundary shift' ''
# PT165 '' 'boundary shift' ''
# PT166 '' 'boundary shift' ''
# PT169 '' 'boundary shift' ''
# PT16C '' 'boundary shift' ''
PT161 PT16D 'boundary shift, new region' 'PT16D=parts of PT161'
PT161 PT16E 'boundary shift, new region' 'PT16E=parts of PT161+PT162+parts of PT164'
PT164 PT16E 'boundary shift, new region' 'PT16E=parts of PT161+PT162+parts of PT164'
PT163 PT16F 'boundary shift, new region' 'PT16F=PT163+parts of PT164'
PT164 PT16F 'boundary shift, new region' 'PT16F=PT163+parts of PT164'
PT165 PT16G 'boundary shift, new region' 'PT16G=parts of PT165'
PT166 PT16H 'boundary shift, new region' 'PT16H=parts of PT166+PT169'
PT169 PT16H 'boundary shift, new region' 'PT16H=parts of PT166+PT169'
PT16C PT16I 'boundary shift, new region' 'PT16I=PT16C+parts of PT166'
PT166 PT16I 'boundary shift, new region' 'PT16I=PT16C+parts of PT166'
PT167 PT16J merge 'PT16J = PT167 + PT168 + PT16A'
PT168 PT16J merge 'PT16J = PT167 + PT168 + PT16A'
PT16A PT16J merge 'PT16J = PT167 + PT168 + PT16A'
# PT17 PT17 Name change ''
PT171 PT170 merge 'PT170 = PT171 + PT172'
PT172 PT170 merge 'PT170 = PT171 + PT172'
# PT182 '' 'boundary shift' ''
# PT183 '' 'boundary shift' ''
PT182 PT186 'boundary shift, new region' 'PT186=parts of PT182+parts of PT183'
PT183 PT186 'boundary shift, new region' 'PT186=parts of PT182+parts of PT183'
PT182 PT187 'boundary shift, new region' 'PT187=parts of PT182+parts of PT183'
PT183 PT187 'boundary shift, new region' 'PT187=parts of PT182+parts of PT183'", header= TRUE) %>% as_tibble() %>%
mutate (COUNTRY = "POR") %>%
mutate (regional_surface = '',from_NUTS3 = "" )
# SUO ####
suo_nuts3 <- read.table(
text = "NUTS3 NUTS3_new regional_surface
FI19 FI196 ''
FI19 FI197 ''
FI131 FI1D1 1.05
FI132 FI1D2 1
FI133 FI1D3 1
FI134 FI1D8 1
FI183 FI1C1 1
FI184 FI1C2 1
FI185 FI1C3 1
FI186 FI1C4 1
FI187 FI1C5 0.95
FI1A1 FI1D5 0.95
FI1A2 FI1D9 1
FI1A3 FI1D7 1
#merge......
FI181 FI1B1 1
FI182 FI1B1 1
# version 2013- 2016
FI1D4 FI1D8 0.93
FI1D6 FI1D9 1.12", header = TRUE) %>%
as_tibble() %>% mutate (COUNTRY = "SUO") %>%
mutate (change_nuts3 = case_when(NUTS3_new == "FI1B1" ~'merge',
NUTS3 == "FI19" ~ 'boundary shift, new region',
TRUE~ 'recoded'),
from_ex_NUTS3 = '',from_NUTS3 = '')
# sve regional_surface can be not calculated, there is no nuts3 version 2003####
sve_nuts3 <- read.table(
text = "NUTS3 NUTS3_new
SE010 SE110
SE021 ''
SE022 SE122
SE023 SE123
SE024 SE124
SE025 ''
SE091 SE211
SE092 SE212
SE093 SE213
SE094 SE214
SE041 SE221
SE044 SE224
SE0A1 SE231
SE0A2 SE232
SE061 SE311
SE062 SE312
SE063 SE313
SE071 SE321
SE072 SE322
SE081 SE331
SE082 SE332", header = TRUE) %>%
as_tibble() %>% mutate (COUNTRY = "SVE") %>%
mutate (change_nuts3 = if_else(NUTS3_new == "" ,'boundary shift','reocded'),
regional_surface = '',
from_ex_NUTS3 = '', from_NUTS3='')
# SVN ####
# version 2003-2006 ----
svn_nuts3_2006 <- read.table(
text = "NUTS3 NUTS3_new
# version 2003-2006
# code change
SI001 SI011
SI002 SI012
SI003 SI013
SI004 SI014
SI005 SI015
SI006 SI016
SI00D SI017
SI00A SI018
SI00E SI021
SI009 SI022
SI00B SI023
SI00C SI024", header = TRUE) %>%
as_tibble() %>% mutate (COUNTRY = "SVN") %>%
mutate (change_nuts3 = 'reocded',
regional_surface = 1,
version = "2003To2006")
# version 2010-2013 ----
svn_nuts3_2013 <- read.table(
text = "NUTS3 NUTS3_new regional_surface
# version 2010-2013
SI011 SI031 1
SI012 SI032 1
SI013 SI033 1
SI014 SI034 0.97 #'boundary shift' SI034=parts of SI014+parts of SI016
SI015 SI035 1.09 #'boundary shift' SI035=SI015+parts of SI021
SI016 SI036 0.97 #boundary shift' SI036=parts of SI014+parts of SI016
SI017 SI037 1.06
SI018 SI038 1
SI021 SI041 0.91#'boundary shift' SI041=parts of SI021
SI022 SI042 1
SI023 SI043 1
SI024 SI044 1
", header = TRUE) %>%
as_tibble() %>% mutate (COUNTRY = "SVN") %>%
mutate (change_nuts3 = if_else(NUTS3_new %in% c("SI034","SI035","SI036","SI041") ,'boundary shift','reocded'),
version = '2010To2013')
# version 2003 - 2013 ####
svn_03_13 <- svn_nuts3_2006 %>%
select(-COUNTRY) %>%
left_join(svn_nuts3_2013 %>%
select(-COUNTRY), by = c("NUTS3_new" = "NUTS3") ) %>%
select(-change_nuts3.x,- regional_surface.x,-version.x, -version.y,-NUTS3_new) %>%
rename( NUTS3_new = NUTS3_new.y,
change_nuts3 = change_nuts3.y,
regional_surface = regional_surface.y)
# final ----
# svn_nuts3 <-
svn_nuts3 <- bind_rows(svn_03_13,svn_nuts3_2013) %>%
mutate(COUNTRY = "SVN",
version = if_else( is.na(version), "2003To2013", version),
from_ex_NUTS3 = '',from_NUTS3 = '')
svn_nuts3$NUTS3_new %in% svn_nuts3$NUTS3
# uki ####
# verison 2006 - 2010 ----
uki_nuts3_2006 <- read.table( text = "NUTS3 NUTS3_new change_nuts3 from_ex_NUTS3
# verison 2006 - 2010
#....................................
UKD52 UKD72 recoded 'UKD72 = UKD52'
UKD53 UKD73 recoded 'UKD73 = UKD53'
UKD54 UKD74 recoded 'UKD74 = UKD54'
UKD21 UKD61 'boundary shift' ''
UKD51 UKD71 'boundary shift' ''
# UKD22 Split
UKD22 UKD62 'split' 'UKD62 + UKD63 = UKD22'
UKD22 UKD63 'split' 'UKD62 + UKD63 = UKD22'
# UKE43 Split
UKE43 UKE44 'split' 'UKE44 + UKE45 = UKE43'
UKE43 UKE45 'split' 'UKE44 + UKE45 = UKE43'
# UKF23 Split
UKF23 UKF24 'split' 'UKF24 + UKF25 = UKF23'
UKF23 UKF25 'split' 'UKF24 + UKF25 = UKF23'
# UKG34 Split
UKG34 UKG36 'split' 'UKG36 + UKG37 = UKG34'
UKG34 UKG37 'split' 'UKG36 + UKG37 = UKG34'
# UKG35 Split
UKG35 UKG38 'split' 'UKG38 + UKG39 = UKG35'
UKG35 UKG39 'split' 'UKG38 + UKG39 = UKG35'
# UKH22 Split
UKH22 UKH24 'split' 'UKH24 + UKH25 = UKH22'
UKH22 UKH25 'split' 'UKH24 + UKH25 = UKH22'", header = TRUE) %>%
as_tibble() %>%
mutate(version = "2006To2010")
# version 2010-2013 ----
# ................
uki_nuts3_2013 <- read.table( text = "NUTS3 NUTS3_new change_nuts3 from_ex_NUTS3
# UKD31 Split
UKD31 UKD33 'Split' 'UKD33 + UKD34 + UKD35 = UKD31'
UKD31 UKD34 'Split' 'UKD33 + UKD34 + UKD35 = UKD31'
UKD31 UKD35 'Split' 'UKD33 + UKD34 + UKD35 = UKD31'
# UKD32 Split
UKD32 UKD36 'Split' 'UKD36 + UKD37 = UKD32'
UKD32 UKD37 'Split' 'UKD36 + UKD37 = UKD32'
# UKD43 Split
UKD43 UKD44 'split' 'UKD44 + UKD45 + UKD46 + UKD47 = UKD43'
UKD43 UKD45 'split' 'UKD44 + UKD45 + UKD46 + UKD47 = UKD43'
UKD43 UKD46 'split' 'UKD44 + UKD45 + UKD46 + UKD47 = UKD43'
UKD43 UKD47 'split' 'UKD44 + UKD45 + UKD46 + UKD47 = UKD43'
# UKH13 Split
UKH13 UKH15 'split' 'UKH15 + UKH16 + UKH17 = UKH13'
UKH13 UKH16 'split' 'UKH15 + UKH16 + UKH17 = UKH13'
UKH13 UKH17 'split' 'UKH15 + UKH16 + UKH17 = UKH13'
# UKH33 Split
UKH33 UKH34 'split' 'UKH34 + UKH35 + UKH36 + UKH37 = UKH33'
UKH33 UKH35 'split' 'UKH34 + UKH35 + UKH36 + UKH37 = UKH33'
UKH33 UKH36 'split' 'UKH34 + UKH35 + UKH36 + UKH37 = UKH33'
UKH33 UKH37 'split' 'UKH34 + UKH35 + UKH36 + UKH37 = UKH33'
# UKI11 Split
UKI11 UKI31 'split' 'UKI31 + UKI32 + UKI33 + UKI34 = UKI11'
UKI11 UKI32 'split' 'UKI31 + UKI32 + UKI33 + UKI34 = UKI11'
UKI11 UKI33 'split' 'UKI31 + UKI32 + UKI33 + UKI34 = UKI11'
UKI11 UKI34 'split' 'UKI31 + UKI32 + UKI33 + UKI34 = UKI11'
# UKI12 Split
UKI12 UKI41 'split' 'UKI41 + UKI42 + UKI43 + UKI44 + UKI45= UKI12'
UKI12 UKI42 'split' 'UKI41 + UKI42 + UKI43 + UKI44 + UKI45= UKI12'
UKI12 UKI43 'split' 'UKI41 + UKI42 + UKI43 + UKI44 + UKI45= UKI12'
UKI12 UKI44 'split' 'UKI41 + UKI42 + UKI43 + UKI44 + UKI45= UKI12'
UKI12 UKI45 'split' 'UKI41 + UKI42 + UKI43 + UKI44 + UKI45= UKI12'
# UKI21 Split
UKI21 UKI51 'split' 'UKI51 + UKI52 + UKI53 + UKI54 = UKI21'
UKI21 UKI52 'split' 'UKI51 + UKI52 + UKI53 + UKI54 = UKI21'
UKI21 UKI53 'split' 'UKI51 + UKI52 + UKI53 + UKI54 = UKI21'
UKI21 UKI54 'split' 'UKI51 + UKI52 + UKI53 + UKI54 = UKI21'
# UKI22 Split
UKI22 UKI61 'split' 'UKI61 + UKI62 + UKI63 = UKI22'
UKI22 UKI62 'split' 'UKI61 + UKI62 + UKI63 = UKI22'
UKI22 UKI63 'split' 'UKI61 + UKI62 + UKI63 = UKI22'
# UKI23 Split
UKI23 UKI71 'split' 'UKI71 + UKI72 + UKI73 + UKI74 + UKI75= UKI23'
UKI23 UKI72 'split' 'UKI71 + UKI72 + UKI73 + UKI74 + UKI75= UKI23'
UKI23 UKI73 'split' 'UKI71 + UKI72 + UKI73 + UKI74 + UKI75= UKI23'
UKI23 UKI74 'split' 'UKI71 + UKI72 + UKI73 + UKI74 + UKI75= UKI23'
UKI23 UKI75 'split' 'UKI71 + UKI72 + UKI73 + UKI74 + UKI75= UKI23'
# UKJ23 Split
UKJ23 UKJ25 'split' 'UKJ25 + UKJ26 = UKJ23'
UKJ23 UKJ26 'split' 'UKJ25 + UKJ26 = UKJ23'
# UKJ24 Split
UKJ24 UKJ27 'split' 'UKJ27 + UKJ28 = UKJ24'
UKJ24 UKJ28 'split' 'UKJ27 + UKJ28 = UKJ24'
# UKJ33 Split
UKJ33 UKJ35 'split' 'UKJ35 + UKJ36 + UKJ37 = UKJ33'
UKJ33 UKJ36 'split' 'UKJ35 + UKJ36 + UKJ37 = UKJ33'
UKJ33 UKJ37 'split' 'UKJ35 + UKJ36 + UKJ37 = UKJ33'
# UKJ42 Split
UKJ42 UKJ43 'split' 'UKJ43 + UKJ44 + UKJ45 + UKJ46 = UKJ42'
UKJ42 UKJ44 'split' 'UKJ43 + UKJ44 + UKJ45 + UKJ46 = UKJ42'
UKJ42 UKJ45 'split' 'UKJ43 + UKJ44 + UKJ45 + UKJ46 = UKJ42'
UKJ42 UKJ46 'split' 'UKJ43 + UKJ44 + UKJ45 + UKJ46 = UKJ42'", header = TRUE) %>%
as_tibble()%>%
mutate(version = "2010To2013")
# version 2013 -2016 ----
#....................................
uki_nuts3_2016 <- read.table(text = "NUTS3 NUTS3_new
UKM21 UKM71
UKM22 UKM72
UKM23 UKM73
UKM25 UKM75
UKM26 UKM76
UKM27 UKM77
UKM28 UKM78
UKM31 UKM81
UKM34 UKM82
UKM35 UKM83
UKM36 UKM84
UKM24 UKM91
UKM32 UKM92
UKM33 UKM93
UKM37 UKM94
UKM38 UKM95
UKN01 UKN06
UKN02 ''
UKN03 ''
UKN04 ''
UKN05 ''
'' UKN07
'' UKN08
'' UKN09
'' UKN10
'' UKN11
'' UKN12
'' UKN13
'' UKN14
'' UKN15
'' UKN16 ", header = TRUE) %>%
as_tibble() %>%
mutate( change_nuts3 = case_when (NUTS3_new == '' ~ 'discontinued',
NUTS3 == '' ~ 'new region',
TRUE ~ 'recoded'),
from_ex_NUTS3 = "") %>%
mutate(version = "2013To2016")
# version 2016-2021 ----
#....................................
uki_nuts3_2021 <- read.table( text = "NUTS3 NUTS3_new
UKK21 UKK24
UKK22 UKK25
UKN10 UKN0A
UKN11 UKN0B
UKN12 UKN0C
UKN13 UKN0D
UKN14 UKN0E
UKN15 UKN0F
UKN16 UKN0G", header = TRUE) %>%
as_tibble ()%>%
mutate( change_nuts3 = "recoded",
from_ex_NUTS3 = "") %>%
mutate(version = "2016To2021")
uki_nuts3_2006$NUTS3_new %in% as.character(uki_nuts3_2021$NUTS3)
uki_nuts3_2013$NUTS3_new %in% as.character(uki_nuts3_2021$NUTS3)
uki_nuts3_2016$NUTS3_new %in% as.character(uki_nuts3_2021$NUTS3)
# final ----
# uki_nuts3_16_21 <- uki_nuts3_2016 %>% filter( change_nuts3=="new region") %>%
# left_join(uki_nuts3_2021, by = c("NUTS3_new" = "NUTS3") ) %>% mutate_if(is.factor, as.character) %>%
# # select(-change_nuts3.x,- regional_surface.x,-version.x, -version.y,-NUTS3_new) %>%
# mutate( NUTS3_new.y = case_when(!is.na(NUTS3_new.y)~NUTS3_new.y, TRUE~ NUTS3_new) ,
# change_nuts3.y =case_when(is.na( change_nuts3.y)~change_nuts3.x, TRUE ~ change_nuts3.y)) %>%
# select(NUTS3,NUTS3_new.y, change_nuts3.y) %>%
# rename(NUTS3_new =NUTS3_new.y , change_nuts3 = change_nuts3.y) %>% mutate(version = "2016To2021",
# from_ex_NUTS3 = "")
uki_nuts3_tmp <- bind_rows(uki_nuts3_2006,
uki_nuts3_2013,
uki_nuts3_2016,
uki_nuts3_2021)
changed <- uki_nuts3_tmp %>% mutate_if(is.factor, as.character) %>%
mutate_at(.vars = vars(NUTS3_new),
.funs = list("new" = ~ ifelse(NUTS3_new %in% NUTS3 & NUTS3_new != "", NUTS3,. ),
"change" = ~ ifelse(NUTS3_new %in% NUTS3 & NUTS3_new != "", "changed",. )))
tmp <- changed %>% filter (change=="changed") %>% select(NUTS3_new) %>%
left_join(uki_nuts3_tmp, by= c("NUTS3_new" = "NUTS3")) %>%
rename(NUTS3_new_new = NUTS3_new.y,
NUTS3_origin = NUTS3_new ) %>%
select( NUTS3_origin, NUTS3_new_new)
uki_nuts3 <- changed %>% left_join(tmp, by = c("NUTS3_new"= "NUTS3_origin")) %>% mutate(new = as.factor(new)) %>%
mutate(new = if_else(change=="changed", NUTS3_new_new,new)) %>% select(-NUTS3_new) %>%
rename(NUTS3_new=new)%>% select(-NUTS3_new_new, -change) %>%
mutate(COUNTRY ="UKI",
regional_surface = if_else(change_nuts3 =="recoded","1","") ,
from_NUTS3 = "")
(uki_nuts3 %>% filter(NUTS3_new!= ""))$NUTS3_new %in% (uki_nuts3 %>% filter(NUTS3_new!= ""))$NUTS3
rm(uki_nuts3_tmp, tmp,changed)
# all ----
nuts3.trans <- list()
allNUTS3 <- list(bel_nuts3,cze_nuts3,deu_nuts3,ell_nuts3,esp_nuts3,fra_nuts3,
hun_nuts3,ire_nuts3,ita_nuts3,ltu_nuts3,ned_nuts3,pol_nuts3,por_nuts3,suo_nuts3,
sve_nuts3,svn_nuts3,uki_nuts3)
for (i in(1:length(allNUTS3))){
print(length(allNUTS3[[i]]))
if ("version" %in% colnames(allNUTS3[[i]])) {
nuts3.trans[[i]] <- allNUTS3[[i]] %>% select(-version)}
else{nuts3.trans[[i]] <- allNUTS3[[i]]}
nuts3.trans[[i]] %>% mutate_if(is.factor, as.character)
# nuts3.trans<- bind_rows(nuts3.trans,test)
}
nuts3.trans <- do.call(rbind, nuts3.trans )
rm(bel_nuts3,cze_nuts3,deu_nuts3,ell_nuts3,esp_nuts3,fra_nuts3,
hun_nuts3,ire_nuts3,ita_nuts3,ltu_nuts3,ned_nuts3,pol_nuts3,por_nuts3,suo_nuts3,
sve_nuts3,uki_nuts3,svn_nuts3)
}
rm(list=setdiff(ls(), c("str_data","fadn.animal", "nuts2.trans", "nuts3.trans", "region.trans","nuts1.trans")))
# save to sys data ----
# save(nuts1.trans, file = "data/nuts1_trans.RData")
# save(nuts2.trans, file = "data/nuts2_trans.RData")
# save(nuts3.trans, file = "data/nuts3_trans.RData")
# save(region.trans, file = "data/fadn_region_trans.RData")
usethis::use_data(nuts1.trans, nuts2.trans, nuts3.trans, region.trans, overwrite = T)