Newer
Older
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
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
# download the lists of changes between the various NUTS versions from: https://ec.europa.eu/eurostat/en/web/nuts/history
# save the excel: D:\data\fadn\lieferung_20210414\yang\fadn_work_space\NUTS
rm(list=setdiff(ls(), c("str_data","fadn.animal")))
# nuts2 rules ####
nuts2_transformation = TRUE
if (nuts2_transformation){
# deu ####
deu <- tibble(
NUTS2 = c("DEE1","DEE2","DEE3", "DE41", "DE42", "DED1", "DED3"),
NUTS2_new = c("DEE0","DEE0","DEE0", "DE40", "DE40", "DED4" ,"DED5"),
regional_surface = 1,
COUNTRY = "DEU"
) %>% mutate(change = case_when(NUTS2_new == "DEE0" ~ "merge",
NUTS2_new == "DE40" ~"merge",
NUTS2_new == "DED4" ~"boundary shift, new region",
NUTS2_new == "DED5" ~"boundary shift, new region",
TRUE ~ "recoded"),
from_NUTS3 = '', from_ex_NUTS3 = '')
# ell ####
ell <- tibble(
NUTS2 = c("GR11","EL11", "GR12", "EL12","GR13", "EL13", "GR14", "EL14", "GR21", "EL21","GR22", "EL22","GR23", "EL23","GR24", "EL24","GR25", "EL25",
"GR30","GR41","GR42","GR43"),
NUTS2_new = c(rep("EL51",2), rep("EL52", 2), rep("El53",2), rep("EL54",2), rep("EL61",2),rep("EL62",2), rep("EL63",2),rep("EL64",2),rep("EL65",2),
"EL30","EL41","EL42","EL43"),
regional_surface = 1,
COUNTRY = "ELL"
) %>% mutate(change = case_when(regional_surface ==1 ~ "recoded"),
from_NUTS3 = '', from_ex_NUTS3 = '')
# fra ####
fra <- read.table(
text = "NUTS2 NUTS2_new
FR24 FRB0
FR26 FRC1
FR43 FRC2
FR25 FRD1
FR23 FRD2
FR30 FRE1
FR22 FRE2
FR42 FRF1
FR21 FRF2
FR41 FRF3
FR51 FRG0
FR52 FRH0
FR61 FRI1
FR63 FRI2
FR53 FRI3
FR81 FRJ1
FR62 FRJ2
FR72 FRK1
FR71 FRK2
FR82 FRL0
FR83 FRM0
FRA1 FRY1
FRA2 FRY2
FRA3 FRY3
FRA4 FRY4
FRA5 FRY5", header =TRUE) %>% as_tibble() %>%
mutate (COUNTRY = "FRA", regional_surface = 1) %>%
mutate_if(is.factor, as.character) %>%
mutate(change = (case_when(regional_surface ==1 ~ "recoded" )),
from_NUTS3 = '', from_ex_NUTS3 = ''
)
# hun??? ####
# fadn data has no HU11
hun <- read.table(
text = "NUTS2 NUTS2_new COUNTRY regional_surface
HU10 HU12 HUN 0.92
HU10 HU11 HUN 0.08", header = TRUE ) %>%
as_tibble() %>%
mutate_if(is.factor, as.character) %>%
mutate(change = (case_when(NUTS2 =="HU10" ~ "split" )),
from_NUTS3 = '', from_ex_NUTS3 = '')
# IRE ######
# IE01 discontinued
# IE02 discontinued
# IE04 new region ?????????????????
# IE05 new region, made from ex-IE023, IE024 and IE025 IE05=IE023+IE024+IE025 (from NUTS3)
# IE06 new region ?????????????????
# old . new value
#.................
# IE01. IE04 0.77
# IE01. IE06 0.23
# IE02. IE05 0.81
# IE02. IE06 0.42
ire <- read.table(
text = "NUTS2 NUTS2_new regional_surface change
IE01 IE04 0.77 'discontinued, new region'
IE01 IE06 0.23 'discontinued, new region'
IE02 IE05 0.81 'discontinued, new region'
IE02 IE06 0.42 'discontinued, new region' ", header = TRUE ) %>%
as_tibble() %>%
mutate (COUNTRY = "IRE", from_NUTS3 = '', from_ex_NUTS3 = '') %>%
mutate_if(is.factor, as.character)
# ita ####
ita <- read.table(
text = "NUTS2 NUTS2_new regional_surface
ITD1 ITH1 1
ITD2 ITH2 1
ITD3 ITH3 1
ITD4 ITH4 1
ITE4 ITI4 1
ITE1 ITI1 1
ITE2 ITI2 1
ITD5 ITH5 1.03
ITE3 ITI3 0.97", header = TRUE ) %>%
as_tibble() %>%
mutate (COUNTRY = "ITA",
change = (case_when(regional_surface==1 ~ "recoded",
TRUE ~ "boundary shift, new region")),
from_NUTS3 = '',
from_ex_NUTS3 = '') %>%
mutate_if(is.factor, as.character)
# ltu ####
ltu <- read.table(
text = "NUTS2 NUTS2_new regional_surface from_NUTS3
LT00 LT01 0.15 LT00A
LT00 LT02 0.85 'LT00-LT00A'", header = TRUE ) %>%
as_tibble() %>%
mutate (COUNTRY = "LTU",
change = (case_when(regional_surface!=1 ~ "split")),
from_ex_NUTS3 = '') %>%
mutate_if(is.factor, as.character)
# pol ####
pol <- read.table(
text = "NUTS2 NUTS2_new regional_surface from_NUTS3
PL11 PL71 1 ''
PL33 PL72 1 ''
PL31 PL81 1 ''
PL32 PL82 1 ''
PL34 PL84 1 ''
PL12 PL91 0.17 'PL127+PL129+PL12A-newPL926'
PL12 PL92 0.83 'PL128+PL12B+PL12C+PL12D+PL12E+newPL926'", header = TRUE ) %>%
as_tibble() %>%
mutate (COUNTRY = "POL",
change = (case_when(regional_surface==1 ~ "recoded", TRUE ~ "split" )),
from_ex_NUTS3 = '') %>%
mutate_if(is.factor, as.character)
# suo #####
# merge new region
# 1: FI1A FI1D 1
# 2: FI13 FI1D 1
0.01
# ...........................
# split new region
# 3: FI18 FI1B 0.21
# 4: FI18 FI1C 0.78
suo <- read.table(
text = "NUTS2 NUTS2_new regional_surface
FI13 FI1D 1
FI1A FI1D 1
FI18 FI1D 0.01
FI18 FI1B 0.21
FI18 FI1C 0.78
", header = TRUE ) %>%
as_tibble() %>%
mutate (COUNTRY = "SUO",
change = (case_when(NUTS2 %in% c("FI13","FI1A") ~ "merge", TRUE ~ "split" )),
from_NUTS3 = '', from_ex_NUTS3 = '') %>%
mutate_if(is.factor, as.character)
# sve ####
sve <- read.table(
text = "NUTS2 NUTS2_new regional_surface
SE01 SE11 1
SE02 SE12 1
SE09 SE21 1
SE04 SE22 1
SE0A SE23 1
SE06 SE31 1
SE07 SE32 1
SE08 SE33 1", header = TRUE ) %>%
as_tibble() %>%
mutate (COUNTRY = "SVE",
change = "recoded",
from_NUTS3 = '',
from_ex_NUTS3 = '') %>%
mutate_if(is.factor, as.character)
# svn ???####
# before 2006 version: SI00 split into SI01 and SI02 ????????????????
svn <- read.table(
text = "NUTS2 NUTS2_new regional_surface change
SI00 SI01 '' split
SI00 SI01 '' split
SI01 SI03 1.03 'boundary shift, new region'
SI02 SI04 0.97 'boundary shift, new region'", header = TRUE ) %>%
as_tibble() %>%
mutate (COUNTRY = "SVN", from_NUTS3 = '', from_ex_NUTS3 = '') %>%
mutate_if(is.factor, as.character)
# uki ####
uki <- read.table(
text = "NUTS2 NUTS2_new regional_surface change from_ex_NUTS3
# boundary shift
UKD2 UKD6 0.97 'boundary shift' ''
UKD5 UKD7 1.03 'boundary shift' ''
# boundary shift: lost exUKM24
UKM7 UKM7 0.74 'boundary shift' 'UKM2-exUKM24'
# split into new regions
UKM3 UKM8 0.15 'split' ''
UKM3 UKM9 1.12 'split' ''
", header = TRUE ) %>%
as_tibble() %>%
mutate(COUNTRY = "UKI", from_NUTS3 = '') %>%
mutate_if(is.factor, as.character)
# all ####
nuts2.trans <- do.call("rbind", list(deu,ell,fra,hun,ire,ita,ltu,pol,suo,sve,svn,uki))
setnames(nuts2.trans, old = c('regional_surface','change'), new = c('regional_surface_nuts2','change_nuts2'))
rm(deu,ell,fra,hun,ita,ltu,pol,suo,sve,svn,uki,ire)
}
# str_data$info %>% merge(nuts2.trans, by ="NUTS2")
str_data$info %>% left_join(nuts2.trans, by = c( "NUTS2", "COUNTRY")) %>%
mutate(regional_surface_nuts2 = if_else(is.na(regional_surface_nuts2),1,regional_surface_nuts2),
change_nuts2 = if_else(is.na(change_nuts2),"no change", change_nuts2),
NUTS2_new = if_else(is.na(NUTS2_new), NUTS2, NUTS2_new )) %>%
mutate_at(vars(UAA,UAAOWNED), list( new = ~. * regional_surface_nuts2) ) %>%
# mutate_at(vars(UAA,UAAOWNED), list( ~. * regional_surface_nuts2) ) %>%
select(-c(TF8:REGION,SIZEUR,NUTS1,NUTS3,ALTITUDE,NAT2000:INCOME.TAXES)) %>%
filter (change_nuts2 != "no change")
# region rules #####
# https://ec.europa.eu/agriculture/rica/regioncodes_en.cfm?CodeCountry=EUR
region_transformation = TRUE
if (region_transformation) {
# deu ----
# 1981-2017
# version 2018
# 10, 20 merge into 15
de_region <- read.table(
text = "REGION REGION_new change_region
20 15 merge
10 15 merge", header = TRUE) %>%
as_tibble() %>% mutate (COUNTRY = "DEU")
# fra ----
# version 1981-2011
# vresion 2012
# new region 205,206,207
fra_region <- read.table(
text = "REGION REGION_new change_region
'' 205 'new region'
'' 206 'new region'
'' 207 'new region'", header = TRUE) %>%
as_tibble() %>% mutate(COUNTRY = "FRA")
# hun ----
# version 2004-2011
# version 2012-
# 761, 762, 763 merge into 768
# 760, 765, 766 merge into 767
hun_region <- read.table(
text = "REGION REGION_new change_region
761 768 merge
762 768 merge
763 768 merge
760 767 merge
765 767 merge
766 767 merge", header = TRUE) %>%
as_tibble() %>% mutate (COUNTRY = "HUN")
# por ----
# version 1986-2007
# version 2008
# 610,620 merge merge into 615
por_region <- read.table(
text = "REGION REGION_new change_region
610 615 merge
620 615 merge", header = TRUE) %>%
as_tibble() %>% mutate(COUNTRY = "POR")
region.trans <- do.call("rbind", list(de_region,fra_region,hun_region,por_region)) %>% mutate_if(is.integer, as.factor) %>%
mutate(change_region = as.character(change_region))
rm(de_region,fra_region,hun_region,por_region)
}
str_data$info %>% left_join(region.trans, by = c("COUNTRY", "REGION")) %>%
mutate(REGION_new = if_else(is.na(REGION_new),REGION, REGION_new),
change_region = if_else(is.na(change_region),"no change", change_region))
# nuts1 rules ######
nuts1_transformation = TRUE
if (nuts1_transformation) {
# ell
ell_nuts1 <- read.table(
text = "NUTS1 NUTS1_new change_nuts1
GR1 EL5 'recoded, boundary shift'
GR2 EL6 'recoded, boundary shift'
GR3 EL3 recoded
GR4 EL4 recoded
EL1 EL5 'boundary shift'
EL2 EL6 'boundary shift'", header = TRUE) %>%
as_tibble() %>% mutate (COUNTRY = "ELL") %>%
mutate (regional_surface = case_when(NUTS1_new == "EL5" ~ 0.92,
NUTS1_new == "EL6" ~ 1.08,
TRUE ~1),
from_ex_NUTS2 = '',
from_NUTS2 = '')
# fra ??????????????? -----
fra_nuts1 <- read.table(
text = "NUTS1 NUTS1_new change_nuts1 from_NUTS2
FR2 '' discontinued ''
FR3 '' discontinued ''
FR4 '' discontinued ''
FR5 '' discontinued ''
FR6 '' discontinued ''
FR7 FRK recoded ''
FR8 '' discontinued ''
FR9 FRK 'boundary shift' ''
FRA FRK recoded ''
'' FRB 'new region' 'FR24'
'' FRC 'new region' 'FR26+FR43'
'' FRD 'new region' 'FR23+FR25'
'' FRE 'new region' 'FR22+FR30'
'' FRF 'new region' 'FR21+FR41+FR42'
'' FRG 'new region' FR51
'' FRH 'new region' FR52
'' FRI 'new region' 'FR53+FR61+FR63'
'' FRJ 'new region' 'FR62+FR81'
'' FRL 'new region' FR82
'' FRM 'new region' FR83", header = TRUE) %>%
as_tibble() %>%
mutate (COUNTRY = "FRA", from_ex_NUTS2 = "", regional_surface = "")
# ita ----
ita_nuts1 <- read.table(
text = "NUTS1 NUTS1_new change_nuts1
ITD ITH 'boundary shift'
ITE ITI 'boundary shift'", header = TRUE) %>%
as_tibble() %>% mutate (COUNTRY = "ITA", from_ex_NUTS2 = '', from_NUTS2 = '') %>%
mutate (regional_surface = case_when(NUTS1_new == "ITH" ~ 1.01,
NUTS1_new == "ITI" ~ 0.99,
TRUE ~1) )
# pol ----
# PL7=PL11+PL33
# PL8=PL3-PL33
# PL9=PL12
pol_nuts1 <- read.table(
text = "NUTS1 NUTS1_new change_nuts1 from_NUTS2 regional_surface
PL1 '' discontinued '' ''
PL3 '' discontinued '' ''
'' PL7 'new region' 'PL11+PL33' 0.5
'' PL8 'new region' 'PL3-PL33' 0.84
'' PL9 'new region' PL12 0.66
", header = TRUE) %>%
as_tibble() %>% mutate (COUNTRY = "POL", from_ex_NUTS2 = '')
# sve ----
sve_nuts1 <- read.table(
text = "NUTS1 NUTS1_new change_nuts1 'from_ex_NUTS2' 'from_NUTS2'
SE0 SE1 split 'SE01+SE02' 'SE11+SE12'
SE0 SE2 split 'SE09+SE04+SE0A' 'SE21+SE22+SE23'
SE0 SE3 split 'SE06+SE07+SE08' 'SE31+SE32+SE33'
", header = TRUE) %>%
as_tibble() %>% mutate (COUNTRY = "SVE",regional_surface = '')
# nuts1 ----
nuts1.trans <- do.call("rbind", list(ell_nuts1,ita_nuts1,pol_nuts1, sve_nuts1)) %>% mutate(change_nuts1 = as.character(change_nuts1))
rm(ell_nuts1,ita_nuts1,pol_nuts1, sve_nuts1)
}
#
# nuts3 rules ####
nuts3_transformation = TRUE
if (nuts3_transformation) {
# bel regional_surface can be not calculated, there is no nuts3 version 2003 ----
bel_nuts3 <- read.table(
text = "NUTS3 NUTS3_new change_nuts3
BE333 BE335 split
BE333 BE336 split ", header = TRUE) %>%
as_tibble() %>% mutate (COUNTRY = "BEL") %>%
mutate (regional_surface = '',
from_ex_NUTS3 = '',
from_NUTS3 = '')
# BGR: no change ----
# CZE regional_surface can be not calculated, there is no nuts3 version 2003 ----
cze_nuts3 <- read.table(
text = "NUTS3 NUTS3_new change_nuts3
CZ061 CZ063 'boundary shift, new region'
CZ062 CZ064 'boundary shift, new region'", header = TRUE) %>%
as_tibble() %>% mutate (COUNTRY = "CZE") %>%
mutate (regional_surface = '',
from_ex_NUTS3 = '',
from_NUTS3 = '')
# deu ????too many regions----
library(readxl)
deu_nuts3_excel <- read_excel("D:/data/fadn/lieferung_20210414/yang/fadn_work_space/plots/fadn_nuts3_rules/deu.xlsx",
range =cell_cols("A:F")) %>%
mutate(regional_surface = if_else(change_nuts3 == "recoded", 1,regional_surface))
changed <- deu_nuts3_excel %>% mutate_at(.vars = vars(NUTS3_new),
.funs = list('new' = ~ ifelse(NUTS3_new %in% NUTS3, NUTS3,. ),
'change' = ~ ifelse(NUTS3_new %in% NUTS3, 'changed',. )))
tmp <- changed %>% filter (change=="changed") %>% select(NUTS3_new) %>%
left_join(deu_nuts3_excel, by= c("NUTS3_new" = "NUTS3")) %>%
rename(NUTS3_new_new = NUTS3_new.y,
NUTS3_origin = NUTS3_new ) %>% select( NUTS3_origin, NUTS3_new_new)
deu_nuts3 <- changed %>% left_join(tmp, by = c("NUTS3_new"= "NUTS3_origin")) %>%
mutate(new = if_else(change=="changed", NUTS3_new_new,new)) %>% select(-NUTS3_new) %>%
rename(NUTS3_new=new)%>% select(-NUTS3_new_new, -change) %>%
mutate(COUNTRY = "DEU",from_NUTS3 = '')
rm(deu_nuts3_excel,changed,tmp)
# ell transformation from 2006 into 2016 ----
# version 06-10 ----
ell_nuts3_06_10 <- read.table(
text = "NUTS3 NUTS3_new change_nuts3
# version 2006 to version 2010 #####
GR111 EL111 ''
GR112 EL112 ''
GR113 EL113 ''
GR114 EL114 ''
GR115 EL115 ''
GR121 EL121 ''
GR122 EL122 ''
GR123 EL123 ''
GR124 EL124 ''
GR125 EL125 ''
GR126 EL126 ''
GR127 EL127 ''
GR131 EL131 ''
GR132 EL132 ''
GR133 EL133 ''
GR134 EL134 ''
GR141 EL141 ''
GR142 EL142 ''
GR143 EL143 ''
GR144 EL144 ''
GR211 EL211 ''
GR212 EL212 ''
GR213 EL213 ''
GR214 EL214 ''
GR221 EL221 ''
GR222 EL222 ''
GR223 EL223 ''
GR224 EL224 ''
GR231 EL231 ''
GR232 EL232 ''
GR233 EL233 ''
GR241 EL241 ''
GR242 EL242 ''
GR243 EL243 ''
GR244 EL244 ''
GR245 EL245 ''
GR251 EL251 ''
GR252 EL252 ''
GR253 EL253 ''
GR254 EL254 ''
GR255 EL255 ''
GR300 EL300 ''
GR411 EL411 ''
GR412 EL412 ''
GR413 EL413 ''
GR421 EL421 ''
GR422 EL422 ''
GR431 EL431 ''
GR432 EL432 ''
GR433 EL433 ''
GR434 EL434 ''
GRZZZ ELZZZ '' ", header = TRUE) %>%
as_tibble() %>%
mutate (COUNTRY = "ELL",
change_nuts3 = ifelse(is.na(change_nuts3), 'recoded','' ))
# version 10-13----
ell_nuts3_10_13 <- read.table(
text = "NUTS3 NUTS3_new change_nuts3
EL111 EL511 ''
EL112 EL512 ''
EL113 EL513 ''
EL114 EL514 ''
EL115 EL515 ''
EL121 EL521 ''
EL122 EL522 ''
EL123 EL523 ''
EL124 EL524 ''
EL125 EL525 ''
EL126 EL526 ''
EL127 EL527 ''
# merge......
# old new
EL131 EL531 'merge'
EL133 EL531 'merge'
# recoded......
EL132 EL532 ''
EL134 EL533 ''
# merge........
EL211 EL541 'merge'
EL214 EL541 'merge'
# EL541 new region
# recoded...........
EL212 EL542 ''
EL213 EL543 ''
# merge ............
EL141 EL611 'merge'
EL144 EL611 'merge'
# EL611
EL142 EL612 ''
EL143 EL613 ''
EL221 EL621 ''
EL222 EL622 ''
EL223 EL623 ''
EL224 EL624 ''
EL231 EL631 ''
EL232 EL632 ''
EL233 EL633 ''
EL241 EL641 ''
EL242 EL642 ''
EL243 EL643 ''
EL244 EL644 ''
EL245 EL645 ''
# merge .......
EL251 EL651 'merge'
EL252 EL651 'merge'
# EL651
# recoded.......
EL253 EL652 ''
# merge......
EL254 EL653 'merge'
EL255 EL653 'merge'
# EL653
# split .......
# EL300 split into ...
EL300 EL301 'split'
EL300 EL302 'split'
EL300 EL303 'split'
EL300 EL304 'split'
EL300 EL305 'split'
EL300 EL306 'split'
EL300 EL307 'split'", header = TRUE) %>%
as_tibble() %>%
mutate_if(is.factor,as.character) %>%
mutate (COUNTRY = "ELL",
change_nuts3 = case_when(change_nuts3=='' ~ 'recoded',
TRUE~ change_nuts3))
# version 06-13 ####
ell_06_13 <- ell_nuts3_06_10 %>%
select(-COUNTRY) %>%
left_join(ell_nuts3_10_13 %>%
select(-COUNTRY), by = c("NUTS3_new" = "NUTS3") ) %>%
rename( NUTS3_2006 = NUTS3,
NUTS3_2010 =NUTS3_new,
NUTS3_2013 =NUTS3_new.y,
change_TO_2010 = change_nuts3.x,
change_TO_2013 = change_nuts3.y) %>%
select(NUTS3_2006,NUTS3_2010,NUTS3_2013,change_TO_2010,change_TO_2013) %>%
mutate(NUTS3_new = ifelse(is.na(NUTS3_2013), NUTS3_2010,NUTS3_2013 ),
change_nuts3 = ifelse(is.na(change_TO_2013), change_TO_2010, change_TO_2013 ))%>%
select(NUTS3_2006, NUTS3_new,change_nuts3) %>% mutate(COUNTRY = "ELL") %>% rename(NUTS3 = NUTS3_2006) %>%
mutate(version = "2006To2013")
# ell nuts3 ####
library(readxl)
ell_trans <- read_excel("D:/data/fadn/lieferung_20210414/yang/fadn_work_space/plots/fadn_nuts3_rules/ell.xlsx",
sheet = "10_16")
ell_nuts3 <- rbind(ell_06_13,ell_nuts3_10_13 %>% mutate(version = "2010To2013")) %>%
mutate_if(is.factor, as.character)%>%
mutate(regional_surface = ifelse(change_nuts3== "recoded", 1,'')) %>%
merge(ell_trans ) %>% as_tibble() %>% mutate(value =as.character(value)) %>%
mutate(regional_surface= case_when(regional_surface =="" ~ value,
TRUE~ regional_surface)) %>%
mutate(regional_surface = as.double( regional_surface)) %>%
select(NUTS3,NUTS3_new, COUNTRY, change_nuts3, regional_surface, version) %>%
mutate (from_ex_NUTS3 = '',
from_NUTS3 = '')
# ESP regional_surface can be not calculated, there is no nuts3 version 2003 ----
esp_nuts3 <- read.table(
text = "NUTS3 NUTS3_new
ES530 ES531
ES530 ES532
ES530 ES533
ES701 ES704
ES701 ES705
ES701 ES708
ES702 ES703
ES702 ES706
ES702 ES707
ES702 ES709 ", header = TRUE) %>%
as_tibble() %>% mutate (COUNTRY = "ESP") %>%
mutate (regional_surface = '',change_nuts3 = 'split', from_ex_NUTS3 = '',from_NUTS3 = '')
# fra ####
fra_nuts3 <- read.table(
text = "NUTS3 NUTS3_new
FR241 FRB01
FR242 FRB02
FR243 FRB03
FR244 FRB04
FR245 FRB05
FR246 FRB06
FR261 FRC11
FR262 FRC12
FR263 FRC13
FR264 FRC14
FR431 FRC21
FR432 FRC22
FR433 FRC23
FR434 FRC24
FR251 FRD11
FR252 FRD12
FR253 FRD13
FR231 FRD21
FR232 FRD22
FR301 FRE11
FR302 FRE12
FR221 FRE21
FR222 FRE22
FR223 FRE23
FR421 FRF11
FR422 FRF12
FR211 FRF21
FR212 FRF22
FR213 FRF23
FR214 FRF24
FR411 FRF31
FR412 FRF32
FR413 FRF33
FR414 FRF34
FR511 FRG01
FR512 FRG02
FR513 FRG03
FR514 FRG04
FR515 FRG05
FR521 FRH01
FR522 FRH02
FR523 FRH03
FR524 FRH04
FR611 FRI11
FR612 FRI12
FR613 FRI13
FR614 FRI14
FR615 FRI15
FR631 FRI21
FR632 FRI22
FR633 FRI23
FR531 FRI31
FR532 FRI32
FR533 FRI33
FR534 FRI34
FR811 FRJ11
FR812 FRJ12
FR813 FRJ13
FR814 FRJ14
FR815 FRJ15
FR621 FRJ21
FR622 FRJ22
FR623 FRJ23
FR624 FRJ24
FR625 FRJ25
FR626 FRJ26
FR627 FRJ27
FR628 FRJ28
FR721 FRK11
FR722 FRK12
FR723 FRK13
FR724 FRK14
FR711 FRK21
FR712 FRK22
FR713 FRK23
FR714 FRK24
FR715 FRK25
FR716 FRK26
FR717 FRK27
FR718 FRK28
FR821 FRL01
FR822 FRL02
FR823 FRL03
FR824 FRL04
FR825 FRL05
FR826 FRL06
FR831 FRM01
FR832 FRM02
FRA10 FRY10
FRA20 FRY20
FRA30 FRY30
FRA40 FRY40
FRA50 FRY50", header = TRUE)%>%
as_tibble() %>% mutate (COUNTRY = "FRA") %>%
mutate (regional_surface = 1,change_nuts3 = 'recoded', from_ex_NUTS3 = '',from_NUTS3 = '')
# HUN ####
hun_nuts3 <- read.table(
text = "NUTS3 NUTS3_new change_nuts3
HU10 HU120 recoded ", header = TRUE) %>%
as_tibble() %>% mutate (COUNTRY = "HUN") %>%
mutate (regional_surface = 1 , from_ex_NUTS3 = '',from_NUTS3 = '')
# IRE ????####
# NUTS3: IE061, IE062, IE063
# fadn: IE06, IE063
ire_nuts3 <- read.table(
text = " NUTS3 NUTS3_new change_nuts3 regional_surface
IE011 IE041 'boundary shift' 0.93
IE013 IE042 recoded 1
IE023 IE051 'boundary shift' 1.24
IE024 IE052 'boundary shift' 0.76
IE025 IE053 recoded 1
IE021 IE061 recoded 1
IE022 IE062 'boundary shift' 0.07
IE012 IE063 recoded 1", header = TRUE) %>%
as_tibble() %>% mutate (COUNTRY = "IRE", from_ex_NUTS3 = '',from_NUTS3 = '')
# ITA ####
ita2 <- read.table( text = "NUTS3 NUTS3_new change_nuts3 regional_surface
# ............
# ITC45 split ''
ITC45 ITC4C split 0.8
ITC45 ITC4D split 0.2
ITD59 ITH59 'boundary shift' 1.11
ITE31 ITI31 'boundary shift' 0.89
# ITE34 split
ITE34 ITI34 split 0.59
ITE34 ITI35 split 0.41
ITF41 '' discontinued ''
ITF42 '' discontinued ''
'' ITF46 'new region' 0.97
'' ITF47 'new region' 0.75
'' ITF48 'new region' 0.29 ", header = TRUE )
ita_nuts3 <- read.table(
text = " NUTS3 NUTS3_new
ITD10 ITH10
ITD20 ITH20
ITD31 ITH31
ITD32 ITH32
ITD33 ITH33
ITD34 ITH34
ITD35 ITH35
ITD36 ITH36
ITD37 ITH37
ITD41 ITH41
ITD42 ITH42
ITD43 ITH43
ITD44 ITH44
ITD51 ITH51
ITD52 ITH52
ITD53 ITH53
ITD54 ITH54
ITD55 ITH55
ITD56 ITH56
ITD57 ITH57
ITD58 ITH58
ITE11 ITI11
ITE12 ITI12
ITE13 ITI13
ITE14 ITI14
ITE15 ITI15
ITE16 ITI16
ITE17 ITI17
ITE18 ITI18
ITE19 ITI19
ITE1A ITI1A
ITE21 ITI21
ITE22 ITI22
ITE32 ITI32
ITE33 ITI33
ITE41 ITI41
ITE42 ITI42
ITE43 ITI43
ITE44 ITI44
ITE45 ITI45 ", header = TRUE) %>%
mutate (change_nuts3 = "recoded", regional_surface = 1) %>%
bind_rows(ita2) %>% mutate( COUNTRY = "ITA",from_ex_NUTS3 = '',from_NUTS3 = '')
# LTU ####
ltu_nuts3 <- read.table( text = "NUTS3 NUTS3_new
LT00A LT011
LT001 LT021
LT002 LT022
LT003 LT023
LT004 LT024
LT005 LT025
LT006 LT026
LT007 LT027
LT008 LT028
LT009 LT029 ", header = TRUE) %>%
as_tibble() %>% mutate (COUNTRY = "LTU", change_nuts3 = "recoded",
regional_surface = 1,
from_ex_NUTS3 = '',from_NUTS3 = '')
# LVA no change####
# NED ####
ned_nuts3 <- read.table( text = "NUTS3 NUTS3_new regional_surface
NL222 '' ''
NL223 '' ''
NL331 NL337 ''
NL334 NL33B ''
NL335 NL33C ''
NL121 NL124 0.91
NL122 NL125 1.24
NL123 NL126 0.85
NL322 NL328 1.02
NL326 NL329 0.98
NL336 NL33A 0.96
NL338 NL33B 0.88
NL339 NL33C 1.08 ", header = TRUE) %>%
as_tibble() %>% mutate (COUNTRY = "NED", change_nuts3 = "Boundary shift", from_ex_NUTS3 = '',from_NUTS3 = '')
str_data$info %>% filter (COUNTRY == "NED") %>% left_join(ned_nuts3) %>%
mutate(NUTS3_new= as.character(NUTS3_new)) %>%
mutate(regional_surface = if_else(is.na(regional_surface),1,regional_surface),
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=case_when(
change_nuts3 != "no change" ~ NUTS3_new,
TRUE ~ NUTS3)) %>%
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")
# pol ####
# version 2006 ----
pol_nuts3_2006 <- read.table( text = "NUTS3 NUTS3_new change_nuts3
PL111 '' Terminated
PL112 '' Terminated
PL124 '' Terminated
PL126 '' Terminated
PL211 '' Terminated
PL212 '' Terminated
# PL226 Split
PL226 PL228 'split, new region'
PL226 PL229 'split, new region'
PL226 PL22A 'split, new region'
PL226 PL22B 'split, new region'
PL226 PL22C 'split, new region'
# PL313 Split
PL313 PL315 'split, new region'
PL313 PL314 'split, new region'
PL321 '' Terminated
PL322 '' Terminated
# PL330 Split
PL330 PL331 'split, new region'
PL330 PL332 'split, new region'
PL341 '' Terminated
PL342 '' Terminated
PL412 '' Terminated
PL413 '' Terminated
# PL421 Split
PL421 PL423 'split, new region'
PL421 PL424 'split, new region'
PL421 PL425 'split, new region'
PL511 '' Terminated
PL512 '' Terminated
PL513 '' Terminated
# PL520 Split
PL520 PL521 'split, new region'
PL520 PL522 'split, new region'
PL611 '' Terminated
PL612 '' Terminated
# PL632 Split
PL632 PL634 'split, new region'
PL632 PL635 'split, new region'", header = TRUE) %>%
as_tibble() %>% mutate (COUNTRY = "POL", version = "2003To2006", from_ex_NUTS3 = "", from_NUTS3 = "" )
# version 2013 ----
# pol_nuts3_2013 <- read.table( text = "NUTS3 NUTS3_new 'from_ex_NUTS3' regional_surface
# PL121 '' ''
# PL122 '' ''
# '' PL12B 'PL12B=parts of PL121+parts of PL122' 0.64
# '' PL12C 'PL12C=parts of PL121' 0.43
# '' PL12D 'PL12D=parts of PL122' 0.54
# '' PL12E '' 0.39
# PL215 '' ''
# PL216 '' ''
# '' PL218 'PL218=parts of PL215'
# '' PL219 'PL219=parts of PL215+parts of PL216'
# '' PL21A 'PL21A=parts of PL216'
# PL422 '' ''
# PL423 '' ''
# PL425 '' ''
# '' PL426 'PL426=parts of PL422' 0.42
# '' PL427 'PL427=parts of PL422+parts of PL423' 0.58
# '' PL428 'PL428=PL425+parts of PL423'
# PL521 '' ''
# PL522 '' ''
# '' PL523 'PL523=parts of PL521+parts of PL522'
# '' PL524 'PL524=parts of PL521+parts of PL522'
# PL614 '' ''
# PL615 '' ''
# '' PL616 'PL616=parts of PL614+parts of PL615'
# '' PL617 'PL617=parts of PL615'
# '' PL618 'PL618=parts of PL614'
# '' PL619 'PL619=parts of PL615'
# PL631 '' ''
# PL635 '' ''
# '' PL636 'PL636=parts of PL631' 0.64
# '' PL637 'PL637=parts of PL631+parts of PL635' 0.36
# '' PL638 'PL638=parts of PL635'", header = TRUE) %>%
# as_tibble() %>% mutate (COUNTRY = "POL", version = "2010To2013",
# change_nuts3 = case_when(NUTS3_new == "" ~"boundary shift, discontinued",
# TRUE~"new region"))
pol_nuts3_2013 <- read.table( text = "NUTS3 NUTS3_new 'from_ex_NUTS3'
#
PL121 PL12B 'PL12B=parts of PL121+parts of PL122'
PL121 PL12C 'PL12C=parts of PL121'
PL122 PL12B 'PL12B=parts of PL121+parts of PL122'
PL122 PL12D 'PL12D=parts of PL122'
PL122 PL12E ''
#----
PL215 PL218 'PL218=parts of PL215'
PL215 PL219 'PL219=parts of PL215+parts of PL216'
PL216 PL219 'PL219=parts of PL215+parts of PL216'
PL216 PL21A 'PL21A=parts of PL216'
#---
PL422 PL426 'PL426=parts of PL422'
PL422 PL427 'PL427=parts of PL422+parts of PL423'
PL423 PL427 'PL427=parts of PL422+parts of PL423'
PL423 PL428 'PL428=PL425+parts of PL423'
PL425 PL428 'PL428=PL425+parts of PL423'
#---
PL521 PL523 'PL523=parts of PL521+parts of PL522'
PL521 PL524 'PL524=parts of PL521+parts of PL522'
PL522 PL523 'PL523=parts of PL521+parts of PL522'
PL522 PL524 'PL524=parts of PL521+parts of PL522'
#---
PL614 PL616 'PL616=parts of PL614+parts of PL615'
PL615 PL616 'PL616=parts of PL614+parts of PL615'
PL615 PL617 'PL617=parts of PL615'
PL614 PL618 'PL618=parts of PL614'
PL615 PL619 'PL619=parts of PL615'
#---
PL631 PL636 'PL636=parts of PL631'
PL631 PL637 'PL637=parts of PL631+parts of PL635'
PL635 PL637 'PL637=parts of PL631+parts of PL635'
PL635 PL638 'PL638=parts of PL635'", header = TRUE) %>%
as_tibble() %>% mutate (COUNTRY = "POL", version = "2010To2013",
change_nuts3 = "boundary shift, new region", from_NUTS3 = "")
# version 2016 ----
pol_nuts3_2016 <- read.table( text = "NUTS3 NUTS3_new
# version 2016
PL113 PL711
PL114 PL712
PL115 PL713
PL116 PL714
PL117 PL715
PL331 PL721
PL332 PL722
PL311 PL811
PL312 PL812
PL314 PL814
PL315 PL815
PL323 PL821
PL324 PL822
PL325 PL823
PL326 PL824
PL343 PL841
PL344 PL842
PL345 PL843
PL127 PL911
PL129 PL912 #'boundary shift'
PL12A PL913 #'boundary shift lost new PL926, PL913=PL12A-new PL926'
PL128 PL921
PL12B PL922
PL12C PL923
PL12D PL924
PL12E PL925
'' PL926 ", header = TRUE) %>%
as_tibble() %>% mutate (COUNTRY = "POL", version = "2013To2016",
change_nuts3 = case_when(NUTS3 == "PL129" ~"boundary shift",