This study has been designed to explore the trade relations that have developed over 10 years from 2012 to 2021 for top producers of Copper, Lithium, and Graphite. These commodities have been selected to study how has the battery and electric economy evolved. The data has been extracted using UN Comtrade API. The commodities have been selected using international HS codes for trade. The commodities selected are in the input form rather than value added finished products to understand the production pattern of producers and consumption pattern of importers.
solve problem of duplication arising becuase of aggregate function…
# Converting all Imports to Exports by interchanging the reporter and partner
trade %>%
filter(trade_flow == "Import") %>%
mutate(aux = reporter, reporter = partner, partner = aux,
trade_flow = "Export") %>%
select(-aux) -> tmp
rbind(trade, tmp) %>%
filter(trade_flow == "Export") -> total_trade_clean
total_trade_clean <- total_trade_clean %>% group_by(commodity_code)
head(total_trade_clean)
# A tibble: 6 x 9
# Groups: commodity_code [1]
year trade_flow reporter_iso reporter partner_iso partner
<dbl> <chr> <chr> <chr> <chr> <chr>
1 2012 Export CHL Chile BRA Brazil
2 2012 Export CHL Chile BGR Bulgaria
3 2012 Export CHL Chile CAN Canada
4 2012 Export CHL Chile CHN China
5 2012 Export CHL Chile FIN Finland
6 2012 Export CHL Chile DEU Germany
# ... with 3 more variables: commodity_code <dbl>, commodity <chr>,
# trade_value_usd <dbl>unique(total_trade_clean$commodity_code)
[1] 2603 7404 7406 282520 283691 2504 3801unique(total_trade_clean$commodity)
[1] "Copper ores and concentrates"
[2] "Copper; waste and scrap"
[3] "Copper; powders and flakes"
[4] "Copper waste and scrap."
[5] "Lithium oxide and hydroxide"
[6] "Carbonates; lithium carbonate"
[7] "Lithium oxide & hydroxide"
[8] "Lithium carbonates"
[9] "Graphite; natural"
[10] "Artificial graphite; colloidal or semi-colloidal graphite; preparations based on graphite or other carbon in the form of pastes, blocks, plates or other semi-manufactures"
[11] "Natural graphite."
[12] "Artificial graphite; colloidal or semi-colloidal graphite; preparations based on graphite or other carbon in the form of pastes, blocks, plates or other semi-manufactures."
[13] "Copper ores and concentrates."
[14] "Copper powders and flakes." Graphite <- 3801 2504 Lithium <- 283691 282520 Copper <- 2603 7406 7404
graphite_trade_clean <- total_trade_clean[total_trade_clean$commodity_code == c("3801", "2504"),]
head(graphite_trade_clean)
# A tibble: 6 x 9
# Groups: commodity_code [1]
year trade_flow reporter_iso reporter partner_iso partner
<dbl> <chr> <chr> <chr> <chr> <chr>
1 2012 Export CHN China DZA Algeria
2 2012 Export CHN China AZE Azerbaijan
3 2012 Export CHN China AUS Australia
4 2012 Export CHN China BGD Bangladesh
5 2012 Export CHN China BRA Brazil
6 2012 Export CHN China MMR Myanmar
# ... with 3 more variables: commodity_code <dbl>, commodity <chr>,
# trade_value_usd <dbl>lithium_trade_clean <- total_trade_clean[total_trade_clean$commodity_code == c("283691", "282520"),]
head(lithium_trade_clean)
# A tibble: 6 x 9
# Groups: commodity_code [2]
year trade_flow reporter_iso reporter partner_iso partner
<dbl> <chr> <chr> <chr> <chr> <chr>
1 2012 Export AUS Australia SLB Solomon Isds
2 2014 Export AUS Australia NCL New Caledonia
3 2015 Export AUS Australia USA USA
4 2012 Export AUS Australia PNG Papua New Guinea
5 2013 Export AUS Australia JPN Japan
6 2014 Export AUS Australia NZL New Zealand
# ... with 3 more variables: commodity_code <dbl>, commodity <chr>,
# trade_value_usd <dbl>copper_trade_clean <- total_trade_clean[total_trade_clean$commodity_code == c("2603", "7406", "7404"),]
head(copper_trade_clean)
# A tibble: 6 x 9
# Groups: commodity_code [1]
year trade_flow reporter_iso reporter partner_iso partner
<dbl> <chr> <chr> <chr> <chr> <chr>
1 2012 Export CHL Chile BRA Brazil
2 2012 Export CHL Chile CHN China
3 2012 Export CHL Chile JPN Japan
4 2012 Export CHL Chile MEX Mexico
5 2012 Export CHL Chile PHL Philippines
6 2012 Export CHL Chile ESP Spain
# ... with 3 more variables: commodity_code <dbl>, commodity <chr>,
# trade_value_usd <dbl>Week 1
# creating igraph network
X <- data.frame("From" = total_trade_clean$reporter,
"To" = total_trade_clean$partner,
"weight" = total_trade_clean$trade_value_usd)
net.ig <- graph.data.frame(X, directed = TRUE)
E(net.ig)$weight <- total_trade_clean$trade_value_usd
adj <- get.adjacency(net.ig, sparse = FALSE)
summary(net.ig)
IGRAPH e6191b8 DNW- 212 22269 --
+ attr: name (v/c), weight (e/n)# Coercing igraph object to statnet object
network <- intergraph::asNetwork(net.ig)
# plotting the network
set.seed(64823)
plot(network)
Network Structure
[1] "The number of vertices in the network is:212"[1] "The number of edges in the network is:22269"#exploring the dyad census
dyad_census(net.ig)
$mut
[1] 716
$asym
[1] 681
$null
[1] 20969There are 716 mutually directed relationships among pair of countries trading across the three commodities over 10 years time frame. There are 681 countries that have just exported the three commodities and have no imports over 10 years There are 20969 pair of countries with no trade relationships. These asymmetric dyads reflect a hierarchy in terms of exporting countries.
triad.census(network)
003 012 102 021D 021U 021C 111D 111U 030T 030C 201
[1,] 1356065 72870 58663 6833 4943 4526 15256 17223 61 14 23448
120D 120U 120C 210 300
[1,] 261 379 614 2324 2140As per triad census, there are 1356065 empty triads. 72870 one edge directed triads. 58663 directed one edge mutual triads. 6833 triads exist where 6833 countries with downward asymmetric relationship are exporting to 13,666 (could be duplicated multiple times) countries in those triads. 4943 triads exist with upward directed asymmetric export relationship from 9,886 countries. There are 14 closed triads. A total of 61 transitive triads exist in the trade network.
The network developed is directed due the nature of trade i.e. export and the network is weighted with with the export trade value in USD.
#get global clustering cofficient: igraph
transitivity(net.ig, type="global")
[1] 0.1939447The Global transitivity of the network is 0.19, which is the overall proportion of triads among all connected triads.
#get average local clustering coefficient: igraph
transitivity(net.ig, type="average")
[1] 0.9202577transitivity(net.ig, type="local")
[1] 0.25633803 0.08514140 0.13196044 0.72794118 0.09038031
[6] 0.07994496 0.39271255 0.17357246 0.51746032 0.58064516
[11] 0.22303850 0.93333333 0.78362573 0.20390720 0.22068763
[16] 0.10927748 0.19063545 0.35709294 0.24714662 1.00000000
[21] 0.97777778 0.91176471 1.00000000 0.96153846 0.95000000
[26] 1.00000000 0.98717949 0.96703297 0.98901099 0.89705882
[31] 1.00000000 1.00000000 0.97222222 0.95833333 0.97802198
[36] 1.00000000 0.89705882 0.97802198 0.89705882 0.97222222
[41] 0.98901099 1.00000000 0.84558824 0.97435897 1.00000000
[46] 1.00000000 1.00000000 0.93333333 0.95238095 0.97777778
[51] 1.00000000 1.00000000 1.00000000 1.00000000 1.00000000
[56] 1.00000000 1.00000000 1.00000000 1.00000000 1.00000000
[61] 1.00000000 1.00000000 1.00000000 1.00000000 1.00000000
[66] 1.00000000 1.00000000 1.00000000 0.98717949 1.00000000
[71] 0.94871795 1.00000000 NaN 1.00000000 0.97777778
[76] 0.98484848 1.00000000 1.00000000 0.94166667 0.97435897
[81] 1.00000000 1.00000000 0.98484848 1.00000000 1.00000000
[86] 1.00000000 1.00000000 1.00000000 0.95555556 0.97222222
[91] 1.00000000 1.00000000 1.00000000 1.00000000 1.00000000
[96] 1.00000000 1.00000000 1.00000000 1.00000000 0.98717949
[101] 0.98484848 0.98484848 1.00000000 0.98181818 1.00000000
[106] 1.00000000 1.00000000 1.00000000 1.00000000 0.97777778
[111] 1.00000000 1.00000000 1.00000000 1.00000000 1.00000000
[116] 0.91666667 1.00000000 1.00000000 0.98484848 1.00000000
[121] 1.00000000 NaN 1.00000000 1.00000000 0.93333333
[126] 1.00000000 1.00000000 1.00000000 1.00000000 1.00000000
[131] 1.00000000 1.00000000 NaN 0.98484848 1.00000000
[136] 1.00000000 1.00000000 1.00000000 1.00000000 1.00000000
[141] 1.00000000 1.00000000 1.00000000 1.00000000 1.00000000
[146] 1.00000000 1.00000000 1.00000000 1.00000000 1.00000000
[151] 1.00000000 1.00000000 1.00000000 NaN 1.00000000
[156] 1.00000000 NaN 1.00000000 NaN 0.97222222
[161] NaN NaN 1.00000000 NaN 1.00000000
[166] NaN NaN NaN 1.00000000 1.00000000
[171] 0.93333333 1.00000000 1.00000000 1.00000000 0.93333333
[176] 1.00000000 NaN NaN 1.00000000 NaN
[181] 1.00000000 1.00000000 1.00000000 1.00000000 1.00000000
[186] 1.00000000 1.00000000 1.00000000 1.00000000 1.00000000
[191] 1.00000000 1.00000000 1.00000000 0.83333333 1.00000000
[196] NaN NaN NaN 1.00000000 NaN
[201] NaN 1.00000000 NaN 1.00000000 NaN
[206] NaN NaN NaN NaN NaN
[211] NaN NaNPath Lengths
average.path.length(net.ig)
[1] 76037.51The distances function enables us to look at the distance traveled between two nodes. Let’s explore some distances between two countries USA and India
distances(net.ig,"India", "USA")
USA
India 10gd<- all_shortest_paths(net.ig,"India", "USA", weights = NA)
gd$nrgeo# geodesic distance.
[1] 16 41 38 5 52 70 19 24 19 18 25 8 1 20 21 1 30 21 2 0 7
[22] 13 12 5 13 0 4 2 20 18 4 5 13 6 15 4 14 10 15 5 17 4
[43] 15 17 19 11 18 14 14 14 3 8 0 0 3 0 4 8 4 0 20 0 1
[64] 11 0 0 0 1 3 0 7 1 0 7 9 3 4 2 3 0 0 2 6 6
[85] 11 20 17 0 7 0 2 0 0 0 0 0 16 0 15 6 11 2 1 0 12
[106] 0 7 3 1 7 5 14 2 4 1 20 4 0 16 7 0 0 0 2 11 0
[127] 11 0 0 0 18 7 0 19 16 1 0 2 4 0 7 1 0 1 0 5 1
[148] 3 0 4 6 4 0 0 0 0 0 1 0 0 0 0 0 0 0 0 0 0
[169] 2 3 1 6 2 0 15 4 0 0 8 0 20 0 2 1 1 1 0 4 0
[190] 0 1 16 14 0 0 0 0 0 0 0 0 5 0 0 0 0 0 0 0 0
[211] 0 0gd<- all_shortest_paths(net.ig,"India", "USA")
gd$nrgeo
[1] 1 1 1 0 1 1 0 1 1 0 1 1 1 1 0 1 1 1 1 1 0 1 1 0 0 1 1 0 1 1 0 0
[33] 1 1 0 1 1 0 1 1 0 1 1 1 0 1 0 2 1 1 0 1 0 0 0 0 1 0 0 0 0 0 0 0
[65] 0 0 0 0 1 0 1 0 0 0 0 0 1 0 1 1 0 0 1 0 0 0 0 0 0 0 1 1 0 1 0 1
[97] 1 0 0 1 0 1 0 0 1 0 1 0 0 1 1 0 0 0 0 1 0 0 1 0 0 0 0 0 1 0 1 0
[129] 0 0 0 0 0 1 0 0 0 0 0 0 1 0 0 1 0 0 0 0 0 1 1 0 0 0 1 0 0 0 0 0
[161] 0 0 1 0 0 0 0 0 1 1 0 0 1 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 0 1
[193] 0 0 0 0 0 0 0 0 0 1 0 0 0 0 0 0 1 0 0 0Density
graph.density(net.ig)
[1] 0.4978315graph.density(net.ig, loops=TRUE)
[1] 0.4954833graph.density(net.ig)
[1] 0.4978315igraph::degree(net.ig)
Chile
1527
Germany
3575
Japan
1781
Congo
74
USA
3518
China
5955
Zambia
232
Russian Federation
1735
Australia
485
Argentina
396
Brazil
1312
Zimbabwe
60
Portugal
238
Netherlands
1409
Belgium
1514
India
2177
Canada
1411
Mexico
748
Ukraine
757
Bolivia (Plurinational State of)
99
Bulgaria
180
Rep. of Korea
491
Other Asia, nes
399
Peru
237
Spain
441
Areas, nes
75
Austria
323
Finland
214
Indonesia
229
United Kingdom
563
Colombia
191
Morocco
105
Iran
108
Switzerland
351
Poland
326
Uruguay
87
Italy
482
Sweden
306
France
489
Kazakhstan
156
Malaysia
294
Papua New Guinea
47
South Africa
309
Turkey
297
United Rep. of Tanzania
100
Ghana
59
Saudi Arabia
168
Singapore
260
Thailand
295
Philippines
196
Dominican Rep.
101
Ecuador
147
Eritrea
11
Armenia
59
Afghanistan
11
Albania
28
Algeria
28
Angola
41
Azerbaijan
65
Bahamas
28
Bangladesh
117
Bosnia Herzegovina
33
Belarus
136
Dem. Rep. of the Congo
72
Costa Rica
96
Croatia
63
Cuba
48
Cyprus
56
Czechia
261
Benin
24
Denmark
166
Estonia
109
Faeroe Isds
1
Gabon
17
Georgia
98
Greece
146
Guatemala
104
Honduras
68
China, Hong Kong SAR
286
Hungary
130
Iceland
42
Ireland
106
Israel
187
C<f4>te d'Ivoire
51
Jordan
89
Kenya
82
Kuwait
64
Kyrgyzstan
54
Lebanon
79
Latvia
110
Lithuania
135
Luxembourg
93
China, Macao SAR
20
Malta
51
Rep. of Moldova
44
Montenegro
14
Oman
82
Aruba
16
Nigeria
96
Norway
175
Pakistan
175
Panama
80
Paraguay
66
Romania
140
Rwanda
21
Sao Tome and Principe
2
Senegal
40
Serbia
70
Seychelles
8
Slovakia
189
Slovenia
153
Sudan
43
Suriname
18
Togo
28
Trinidad and Tobago
67
United Arab Emirates
226
Tunisia
67
North Macedonia
13
Egypt
123
Yemen
44
El Salvador
46
Gibraltar
1
Guyana
33
Libya
19
Mozambique
67
Namibia
33
New Zealand
136
Nicaragua
47
Other Africa, nes
2
Tajikistan
15
Bahrain
60
Cameroon
17
San Marino
2
Sri Lanka
120
Qatar
78
Venezuela
86
Jamaica
28
Liberia
23
Mali
15
Cura<e7>ao
23
Viet Nam
205
Syria
29
Lao People's Dem. Rep.
29
Mongolia
35
Haiti
31
Mauritius
15
Antigua and Barbuda
16
Mauritania
24
New Caledonia
12
Brunei Darussalam
13
Guinea
25
Sierra Leone
16
Barbados
21
Bermuda
14
Belize
9
Br. Virgin Isds
12
Cayman Isds
17
Dominica
11
Kiribati
2
Madagascar
56
Montserrat
3
Saint Maarten
10
Saint Kitts and Nevis
15
Anguilla
3
Saint Lucia
11
Saint Vincent and the Grenadines
12
Turks and Caicos Isds
11
Grenada
8
Botswana
9
Myanmar
51
Dem. People's Rep. of Korea
53
Malawi
13
Fiji
4
Cambodia
36
Ethiopia
41
Djibouti
12
Oceania, nes
3
North America and Central America, nes
1
Iraq
37
FS Micronesia
1
Nepal
30
Other Europe, nes
9
Turkmenistan
19
Uzbekistan
75
Somalia
10
Burkina Faso
3
Cabo Verde
3
Burundi
5
Gambia
2
Marshall Isds
7
Niger
9
Uganda
27
Bhutan
22
Eswatini
4
Christmas Isds
2
United States Minor Outlying Islands
1
State of Palestine
7
Andorra
2
Chad
5
Cocos Isds
1
South Sudan
1
Maldives
6
Br. Indian Ocean Terr.
2
Greenland
3
French Polynesia
1
Tuvalu
1
Guinea-Bissau
1
Solomon Isds
1
Bunkers
1
Comoros
1
Equatorial Guinea
5
Saint Pierre and Miquelon
1 trade.nodes<-data.frame(name=V(net.ig)$name, degree=igraph::degree(net.ig))
In Degree and Out Degree
Summarize by Group
# A tibble: 212 x 7
name degree_mean indegree_mean outdegree_mean degree_n indegree_n
<chr> <dbl> <dbl> <dbl> <int> <int>
1 Afgha~ 11 10 1 1 1
2 Alban~ 28 6 22 1 1
3 Alger~ 28 26 2 1 1
4 Andor~ 2 2 0 1 1
5 Angola 41 35 6 1 1
6 Angui~ 3 0 3 1 1
7 Antig~ 16 5 11 1 1
8 Areas~ 75 6 69 1 1
9 Argen~ 396 226 166 1 1
10 Armen~ 59 31 28 1 1
# ... with 202 more rows, and 1 more variable: outdegree_n <int>#create a histogram of trade Indegree
hist(trade.nodes$indegree, main="Trade: In-degree Distribution", xlab="Number of Importers")
#create a histogram of trade Indegree
hist(trade.nodes$outdegree, main="Trade: Out-degree Distribution", xlab="Number of Exporters")
Network Degree Centrality
#get network centralization score: igraph
centr_degree(net.ig, loops = FALSE, mode="in")$centralization
[1] 12.47748centr_degree(net.ig, loops = FALSE, mode="out")$centralization
[1] 14.40601##Highest and Lowest In and Out degrees
name degree indegree outdegree
China China 5955 2725 3130
Germany Germany 3575 1815 1760
USA USA 3518 1319 2199
Japan Japan 1781 1153 628
Russian Federation Russian Federation 1735 865 868 name degree indegree outdegree
Faeroe Isds Faeroe Isds 1 0 1
Gibraltar Gibraltar 1 0 1
Other Africa, nes Other Africa, nes 2 0 2
Kiribati Kiribati 2 0 2
Montserrat Montserrat 3 0 3 name degree indegree outdegree
China China 5955 2725 3130
USA USA 3518 1319 2199
Germany Germany 3575 1815 1760
India India 2177 862 1315
Belgium Belgium 1514 472 1042 name degree indegree outdegree
State of Palestine State of Palestine 7 7 0
Andorra Andorra 2 2 0
Chad Chad 5 5 0
Cocos Isds Cocos Isds 1 1 0
South Sudan South Sudan 1 1 0##Network Status
#add eigenvector centrality to node measures
temp <- centr_eigen(net.ig,directed=T)
trade.nodes$eigen<-temp$vector
#arrange descending and return top 5 nodes
arrange(trade.nodes, desc(eigen)) %>%
slice(1:5)
name degree indegree outdegree eigen
China China 5955 2725 3130 1.0000000
Germany Germany 3575 1815 1760 0.6629672
USA USA 3518 1319 2199 0.6151251
Japan Japan 1781 1153 628 0.5107358
India India 2177 862 1315 0.4693189##Derived and Reflected Centrality
matrix <- as.matrix(as_adjacency_matrix(net.ig, attr = "weight"))
#square the adjacency matrix
matsq<-t(matrix) %*% matrix
#Calculate the proportion of reflected centrality.
trade.nodes$rc<-diag(matsq)/rowSums(matsq)
#replace missing values with 0
trade.nodes$rc<-ifelse(is.nan(trade.nodes$rc),0,trade.nodes$rc)
#Calculate received eigenvalue centrality
trade.nodes$eigen.rc<-trade.nodes$eigen*trade.nodes$rc
#Calculate the proportion of derived centrality.
trade.nodes$dc<-1-diag(matsq)/rowSums(matsq)
#replace missing values with 0
trade.nodes$dc<-ifelse(is.nan(trade.nodes$dc),1,trade.nodes$dc)
#Calculate received eigenvalue centrality
trade.nodes$eigen.dc<-trade.nodes$eigen*trade.nodes$dc
name degree indegree outdegree eigen rc eigen.rc
USA USA 3518 1319 2199 0.6151251 0.05928166 0.03646564
India India 2177 862 1315 0.4693189 0.04699940 0.02205771
dc eigen.dc
USA 0.9407183 0.5786595
India 0.9530006 0.4472612trade.nodes%>%
select(-name) %>%
gather() %>%
ggplot(aes(value)) +
geom_histogram() +
facet_wrap(~key, scales = "free")
fashion(temp)
term eigen.dc eigen degree indegree outdegree eigen.rc
1 eigen.dc .96 .84 .85 .82 .39
2 eigen .96 .94 .95 .91 .63
3 degree .84 .94 .99 .99 .75
4 indegree .85 .95 .99 .96 .77
5 outdegree .82 .91 .99 .96 .72
6 eigen.rc .39 .63 .75 .77 .72 rplot(temp)
