Final Project

Introduction

We are living in a world that produces a huge volume of waste everyday. It is estimated that by 2050, the global waste produced will be more than 3.4 billion tons every year. Certain industries produce large volume of waste while some other industries are considered to be cleaner than others. The world has already moved towards recycling as a part of reducing waste dumped in overall. Waste materials produced by certain industries can be used as raw material for certain other industries. This project is an attempt to study the input-output data of materials between industries and the categories of wastes each industries produce. The dataset is from the ‘Waste Input Output Analysis’ by Nakamura, S. and Kondo, Yasushi. It is a data from Japan and therefore the economic flow is given in 1 million Japanese yen. The analysis will help us to find which all industries serve how many other industries with the goods they produce and compare it with the waste emission by each of those industires.

Research Question

How the most influencial industries in terms of their interaction to other industries contribute to the wastes produced?

Reading the Data

Code

data_2011 <- read_xlsx("_data/Project_data/WIO_2011.xlsx", sheet = "WIOdata")

New names:
• `` -> `...1`

Code

head(data_2011)

# A tibble: 6 × 103
  ...1      `Crop cultivation` Livestock Agricultural service…¹ Forestry Fishery
  <chr>                  <dbl>     <dbl>                  <dbl>    <dbl>   <dbl>
1 Crop cul…             183568    305684                   7436     2481       0
2 Livestock              47771    238628                  14235       11       0
3 Agricult…             337249    176157                      0       20       0
4 Forestry                1321         0                      0    86929     216
5 Fishery                    0         0                      0        0   54905
6 Metallic…                  0         0                      0        0       0
# ℹ abbreviated name: ¹​`Agricultural services`
# ℹ 97 more variables: `Metallic ores` <dbl>, `Coal mining etc.` <dbl>,
#   `Non-metallic ores` <dbl>, Foods <dbl>, Beverage <dbl>,
#   `Feeds & organic fertilizer` <dbl>, Tobacco <dbl>,
#   `Textile products` <dbl>, `Wearing apparel etc.` <dbl>,
#   `Lumber and wood products` <dbl>, `Furniture & fixtures` <dbl>,
#   `Pulp & paper` <dbl>, `Paper products` <dbl>, `Printing etc.` <dbl>, …

Code

#data_2011
dim(data_2011)

[1] 294 103

The dataset has 294 rows and 103 columns. We are interested in only the output flow between industries and the waste flow from industries to different waste management processes. Therefore, we can trim the data as a subset which is in the form we want.
## Cleaning Data

Code

df <- data_2011[1:81, 1:92]
head(df)

# A tibble: 6 × 92
  ...1      `Crop cultivation` Livestock Agricultural service…¹ Forestry Fishery
  <chr>                  <dbl>     <dbl>                  <dbl>    <dbl>   <dbl>
1 Crop cul…             183568    305684                   7436     2481       0
2 Livestock              47771    238628                  14235       11       0
3 Agricult…             337249    176157                      0       20       0
4 Forestry                1321         0                      0    86929     216
5 Fishery                    0         0                      0        0   54905
6 Metallic…                  0         0                      0        0       0
# ℹ abbreviated name: ¹​`Agricultural services`
# ℹ 86 more variables: `Metallic ores` <dbl>, `Coal mining etc.` <dbl>,
#   `Non-metallic ores` <dbl>, Foods <dbl>, Beverage <dbl>,
#   `Feeds & organic fertilizer` <dbl>, Tobacco <dbl>,
#   `Textile products` <dbl>, `Wearing apparel etc.` <dbl>,
#   `Lumber and wood products` <dbl>, `Furniture & fixtures` <dbl>,
#   `Pulp & paper` <dbl>, `Paper products` <dbl>, `Printing etc.` <dbl>, …

Code

industry_io <- data_2011[1:81, 1:82]
waste_io <- data_2011[1:81, c(1, 83:92)]
head(waste_io)

# A tibble: 6 × 11
  ...1    Incineration Dehydration Concentration Shredding Filtration Composting
  <chr>          <dbl>       <dbl>         <dbl>     <dbl>      <dbl>      <dbl>
1 Crop c…            0           0             0         0          0          0
2 Livest…            0           0             0         0          0          0
3 Agricu…            0           0             0         0          0          0
4 Forest…            0           0             0         0          0          0
5 Fishery            0           0             0         0          0          0
6 Metall…            0           0             0         0          0          0
# ℹ 4 more variables: `Feed conversion` <dbl>, Gasification <dbl>,
#   `Refuse derived fuel` <dbl>, Landfill <dbl>

Creating Network

After cleaning the dataset, next step is to create network data out of it.

Code

#df <- industry_io
# Transform the data to long format
df_long <- melt(df, id.vars = "...1", variable.name = "to", value.name = "weight", variable.factor = FALSE)

# Rename the "Industries" column to "From"
colnames(df_long)[colnames(df_long) == "...1"] <- "from"

# Drop rows with weight 0
df_long <- df_long[df_long$weight != 0, ]

df_long <- df_long |>
  mutate(waste_process = ifelse(to %in% c("Incineration", "Dehydration", "Concentration", "Shredding", "Filtration", "Composting",
                                  "Feed conversion", "Gasification", "Refuse derived fuel", "Landfill"), 1, 0))
head(df_long)

                         from               to weight waste_process
1            Crop cultivation Crop cultivation 183568             0
2                   Livestock Crop cultivation  47771             0
3       Agricultural services Crop cultivation 337249             0
4                    Forestry Crop cultivation   1321             0
11 Feeds & organic fertilizer Crop cultivation  46056             0
13           Textile products Crop cultivation    829             0

Code

dim(df_long)

[1] 4167    4

There are negative values in the ‘weight’ column. When the value is negative in directed network, it could be probably because the transaction was done in the reverse direction. So, assuming likewise, we can swap the from and to where weight is negative and then get the absolute values for weight so that we don’t want to deal with anymore negative values!

Code

str(df_long)

'data.frame':   4167 obs. of  4 variables:
 $ from         : chr  "Crop cultivation" "Livestock" "Agricultural services" "Forestry" ...
 $ to           : Factor w/ 91 levels "Crop cultivation",..: 1 1 1 1 1 1 1 1 1 1 ...
 $ weight       : num  183568 47771 337249 1321 46056 ...
 $ waste_process: num  0 0 0 0 0 0 0 0 0 0 ...

Code

df_long$to <- as.character(df_long$to)


df_long <- df_long %>%
  mutate(new_from = ifelse(weight < 0, to, from),
         new_to = ifelse(weight < 0, from, to)) %>%
  select(-c(from, to)) %>%
  mutate(weight = abs(weight)) %>%
  rename(from = new_from, to = new_to)
df_long <- df_long[, c("from", "to", "weight", "waste_process")]


df_long |>
  filter(waste_process == 1) |>
  head()

                      from           to      weight waste_process
1         Coal mining etc. Incineration   16.705982             1
2         Textile products Incineration   44.167870             1
3     Wearing apparel etc. Incineration 2035.383591             1
4 Lumber and wood products Incineration    2.975038             1
5     Furniture & fixtures Incineration 2438.157947             1
6             Pulp & paper Incineration  192.004366             1

Creating the network

Code

g_df <- graph_from_data_frame(df_long)
# Extract the weighted vertex attribute values from the dataframe
#vertex_attributes <- df[, 82:92]
E(g_df)$weight <- df_long$weight
#E(g_df)$waste_process <- df_long$waste_process

process_names <- c("Incineration", "Dehydration", "Concentration", "Shredding", "Filtration", "Composting",
                   "Feed conversion", "Gasification", "Refuse derived fuel", "Landfill")

# Create an empty vector to store the attribute values
vertex_attribute <- rep("industry", vcount(g_df))

# Find the vertices with names in the list and assign attribute value of "waste processing"
matching_vertices <- which(V(g_df)$name %in% process_names)
vertex_attribute[matching_vertices] <- "waste processing"

# Add the vertex attribute to the graph
V(g_df)$process <- vertex_attribute


#V(g_df)$process

ls(df_long)

[1] "from"          "to"            "waste_process" "weight"       

Code

#plot(g_df)

Describing the Network Data

Code

vcount(g_df)

[1] 90

Code

ecount(g_df)

[1] 4167

Code

is_bipartite(g_df)

[1] FALSE

Code

is_directed(g_df)

[1] TRUE

Code

is_weighted(g_df)

[1] TRUE

The network has 90 vertices and 4167 edges.

Code

summary(E(g_df)$weight)

    Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
       0      467     5410   110218    36673 11899111 

Code

vertex_attr_names(g_df)

[1] "name"    "process"

Code

edge_attr_names(g_df)

[1] "weight"        "waste_process"

Dyad & Triad Census

Code

igraph::dyad.census(g_df)

$mut
[1] 1064

$asym
[1] 1951

$null
[1] 990

Code

igraph::triad_census(g_df)

 [1]  7680 10472  2204 21177  1242  2515   663 11570 11335   188  1561  2147
[13] 21579  2396 12177  8574

Code

sum(igraph::triad_census(g_df))

[1] 117480

Code

(90*89*88)/(3*2)

[1] 117480

Transitivity/ Global Clustering

Let us look at the clustering pattern in a global level of network

Code

transitivity(g_df)

[1] 0.818957

The network has a high level of transitivity. It means, when two nodes are connected to a neighbouring node, it is highly likely that all of them are connected to each other.

Local Transitivity / Clustering

Now let us look at the Local transitivity. Since the number of vertices are fairly high, we will look on the average clustering coefficient rather than local clustering coefficient.

Code

transitivity(g_df, type = "average")

[1] 0.8658444

The average clustering coefficient of 0.8658 suggests that the network is highly clustered. This means that the network has tightly connected sub groups/clusters.

Path Length and Geodesic

Code

average.path.length(g_df, directed = F)

[1] 7.457572

The average path length of the network is 7.45.

Component Structure and Membership

Code

names(igraph::components(g_df)) # Elements of components

[1] "membership" "csize"      "no"        

Code

igraph::components(g_df)$no

[1] 1

Code

igraph::components(g_df)$csize

[1] 90

Code

#igraph::components(g_df)$membership

The component structure shows that there is only one big component with 90 members. In other words, there is no isolates in this network.

Density of Network

Code

graph.density(g_df)

[1] 0.5202247

The network has a 0.5202 density which means 0.5202 proportion of all possible ties are present in this network.

Creating a Dataframe with the Vertex Degree values

Code

df_degree <- data.frame(name = V(g_df)$name, degree = igraph::degree(g_df))
head(df_degree)

                                                 name degree
Crop cultivation                     Crop cultivation     75
Livestock                                   Livestock     53
Agricultural services           Agricultural services     48
Forestry                                     Forestry     73
Feeds & organic fertilizer Feeds & organic fertilizer     54
Textile products                     Textile products    121

In degree and out degree

Code

df_degree <- df_degree |>
  mutate(indegree = igraph::degree(g_df, mode = "in"), 
         
         outdegree = igraph::degree(g_df, mode = "out"))
df_degree |>
  arrange(desc(outdegree)) |>
  slice(1:5)

                                                     name degree indegree
Commerce                                         Commerce    135       43
Miscellaneous metal products Miscellaneous metal products    145       54
Misc. manufacturing products Misc. manufacturing products    152       61
Wearing apparel etc.                 Wearing apparel etc.    132       42
Final chemical products           Final chemical products    144       54
                             outdegree
Commerce                            92
Miscellaneous metal products        91
Misc. manufacturing products        91
Wearing apparel etc.                90
Final chemical products             90

Code

df_degree |>
  arrange(desc(indegree)) |>
  slice(1:5)

                                                     name degree indegree
Pig iron & crude steel             Pig iron & crude steel     76       66
Public administration               Public administration     66       65
Misc. manufacturing products Misc. manufacturing products    152       61
Transport & post service         Transport & post service    151       61
Personal services                       Personal services    150       61
                             outdegree
Pig iron & crude steel              10
Public administration                1
Misc. manufacturing products        91
Transport & post service            90
Personal services                   89

Summary statistics of Network Degree

Code

summary(df_degree)

     name               degree          indegree       outdegree    
 Length:90          Min.   : 38.00   Min.   :17.00   Min.   : 0.00  
 Class :character   1st Qu.: 57.75   1st Qu.:39.25   1st Qu.:10.25  
 Mode  :character   Median : 89.00   Median :48.00   Median :41.00  
                    Mean   : 92.60   Mean   :46.30   Mean   :46.30  
                    3rd Qu.:126.75   3rd Qu.:52.00   3rd Qu.:86.00  
                    Max.   :152.00   Max.   :66.00   Max.   :92.00  

Network Degree Distribution

Code

df_degree %>% melt %>% filter(variable != 'output' & variable != 'eigen.centrality') %>% 
  ggplot(aes(x = value, fill = variable, color = variable)) + geom_density(alpha = .2, bw = 5) +
  ggtitle('Degree Distribution')

Using name as id variables

Warning: attributes are not identical across measure variables; they will be
dropped

The distribution of degrees shows that the indegree values are more at a level of 50.

Network Degree Centralization

Code

centr_degree(g_df, mode = "in")$centralization

[1] 0.2213483

Code

centr_degree(g_df, mode = "out")$centralization

[1] 0.5134831

Eigen Vector

Code

temp_eigen <- centr_eigen(g_df, directed = T)
names(temp_eigen)

[1] "vector"          "value"           "options"         "centralization" 
[5] "theoretical_max"

Code

length(temp_eigen$vector)

[1] 90

Code

temp_eigen$vector

 [1] 0.5953827 0.5120362 0.6280237 0.6805738 0.5954991 0.6824618 0.6057831
 [8] 0.8187135 0.7071076 0.6528368 0.6034703 0.6478165 0.7163664 0.7881786
[15] 0.5418807 0.7574951 0.6661287 0.6401862 0.6576396 0.7781058 0.6086314
[22] 0.7930444 0.7667579 0.7641407 0.7718081 0.8899521 0.7727183 0.5146864
[29] 0.5145222 0.6882062 0.6419725 0.5519556 0.5175506 0.9087712 0.7717444
[36] 0.7442549 0.5454263 0.8646528 0.9102065 0.2697866 0.7511301 0.7086050
[43] 0.6025945 0.6784769 0.6992363 0.7370351 0.7233416 0.7887455 0.7168331
[50] 0.6934170 0.7050182 0.7535558 0.8082977 0.8390455 0.6841809 0.7379447
[57] 0.7483575 0.7978797 0.7380666 0.5369580 0.5485777 0.5782104 0.4740734
[64] 0.5273760 0.6535068 0.5117106 0.5468021 1.0000000 0.7119895 0.7187400
[71] 0.7131842 0.7267811 0.7680584 0.7145214 0.6885328 0.8205471 0.8157092
[78] 0.7580999 0.9623841 0.6121869 0.8306890 0.5704533 0.5704533 0.5594488
[85] 0.5594488 0.5594488 0.5594488 0.5594488 0.5594488 0.5704533

Code

temp_eigen$centralization

[1] 0.3226412

Adding Eigen Vector to node level measures dataframe

Code

df_degree$eigen <- centr_eigen(g_df, directed = T)$vector
#df_degree
arrange(df_degree, desc(eigen)) |> slice(1:5)

                                                     name degree indegree
Pig iron & crude steel             Pig iron & crude steel     76       66
Public administration               Public administration     66       65
Personal services                       Personal services    150       61
Transport & post service         Transport & post service    151       61
Misc. manufacturing products Misc. manufacturing products    152       61
                             outdegree     eigen
Pig iron & crude steel              10 1.0000000
Public administration                1 0.9623841
Personal services                   89 0.9102065
Transport & post service            90 0.9087712
Misc. manufacturing products        91 0.8899521

Bonacich Power Centrality to the dataframe

Code

df_degree$bonpow <- power_centrality(g_df)

df_degree |>
  arrange(desc(bonpow)) |>
  slice(1:5)

                                                     name degree indegree
Petrochemical basic products Petrochemical basic products     64       33
Medical service etc.                 Medical service etc.     82       54
Textile products                         Textile products    121       48
Non-ferrous metal products     Non-ferrous metal products    124       50
Glass & glass products             Glass & glass products    116       48
                             outdegree     eigen   bonpow
Petrochemical basic products        31 0.4740734 1.980978
Medical service etc.                28 0.7887455 1.940789
Textile products                    73 0.6824618 1.842212
Non-ferrous metal products          74 0.7380666 1.829821
Glass & glass products              68 0.6934170 1.790583

Derived and Reflected Centrality

Code

matrix_df_degree <- as.matrix(as_adjacency_matrix(g_df, attr = "weight"))
# Square the adjacency matrix
matrix_df_degree_sq <- t(matrix_df_degree) %*% matrix_df_degree
# Calculate the proportion of reflected centrality
df_degree$rc <- diag(matrix_df_degree_sq)/rowSums(matrix_df_degree_sq)

# Replace missing values with 0
df_degree$rc <- ifelse(is.nan(df_degree$rc), 0, df_degree$rc)

# Calculate received eigen value centrality

df_degree$eigen.rc <- df_degree$eigen * df_degree$rc

Code

# Calculate the proportion of derived centrality
df_degree$dc <- 1-diag(matrix_df_degree_sq)/rowSums(matrix_df_degree_sq)

# Replace missing values with 0
df_degree$dc <- ifelse(is.nan(df_degree$dc), 0, df_degree$dc)

# Calculate derived eigen value centrality

df_degree$eigen.dc <- df_degree$eigen * df_degree$dc

Centrality Score Distribution

Code

df_degree |>
  select(-name) |>
  gather() |>
  ggplot(aes(value)) +
  geom_histogram() +
  facet_wrap(~key, scales = "free")

Warning: attributes are not identical across measure variables; they will be
dropped

`stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

Centrality Measure Correlations

Closeness Centrality

Code

df_degree$close <- igraph::closeness(g_df)

df_degree |>
  arrange(desc(close)) |>
  slice(1:5)

                                                           name degree indegree
Misc. electronic components         Misc. electronic components    115       51
Household electronics equipment Household electronics equipment    137       52
Forestry                                               Forestry     73       46
Medical service etc.                       Medical service etc.     82       54
Glass & glass products                   Glass & glass products    116       48
                                outdegree     eigen     bonpow          rc
Misc. electronic components            64 0.7483575 -0.9292872 0.058312827
Household electronics equipment        85 0.7718081  0.2486351 0.036339969
Forestry                               27 0.6805738 -1.0649043 0.002618866
Medical service etc.                   28 0.7887455  1.9407891 0.187127156
Glass & glass products                 68 0.6934170  1.7905830 0.004020029
                                   eigen.rc        dc  eigen.dc        close
Misc. electronic components     0.043638842 0.9416872 0.7047187 0.0004294927
Household electronics equipment 0.028047484 0.9636600 0.7437607 0.0003648980
Forestry                        0.001782331 0.9973811 0.6787915 0.0003220622
Medical service etc.            0.147595704 0.8128728 0.6411498 0.0003208223
Glass & glass products          0.002787557 0.9959800 0.6906294 0.0003087959

Betweenness Centrality

Code

df_degree$between <- igraph::betweenness(g_df)

df_degree |>
  arrange(desc(between)) |>
  slice(1:5)

                                                     name degree indegree
Glass & glass products             Glass & glass products    116       48
Pottery, china & earthenware Pottery, china & earthenware     99       45
Forestry                                         Forestry     73       46
Chemical fertilizer                   Chemical fertilizer     86       45
Metallic ores                               Metallic ores     45       36
                             outdegree     eigen     bonpow           rc
Glass & glass products              68 0.6934170  1.7905830 4.020029e-03
Pottery, china & earthenware        54 0.6576396  0.9827723 1.447672e-03
Forestry                            27 0.6805738 -1.0649043 2.618866e-03
Chemical fertilizer                 41 0.6478165 -2.7943767 2.322144e-03
Metallic ores                        9 0.5468021 -0.7909125 6.729973e-05
                                 eigen.rc        dc  eigen.dc        close
Glass & glass products       2.787557e-03 0.9959800 0.6906294 0.0003087959
Pottery, china & earthenware 9.520466e-04 0.9985523 0.6566876 0.0003059049
Forestry                     1.782331e-03 0.9973811 0.6787915 0.0003220622
Chemical fertilizer          1.504323e-03 0.9976779 0.6463122 0.0003035391
Metallic ores                3.679964e-05 0.9999327 0.5467653 0.0001723726
                              between
Glass & glass products       2424.500
Pottery, china & earthenware 2018.000
Forestry                     1897.667
Chemical fertilizer          1823.000
Metallic ores                1097.500

We can calculate the network level score of betweenness centralization

Code

centr_betw(g_df)$centralization

[1] 0.02636484

Network Constraint

Code

df_degree$constraint <- constraint(g_df)

df_degree |> arrange(constraint) |> slice(1:5)

                                                                     name
Misc. ceramic, stone & clay products Misc. ceramic, stone & clay products
Glass & glass products                             Glass & glass products
Industrial inorganic chemicals             Industrial inorganic chemicals
Miscellaneous metal products                 Miscellaneous metal products
Plastic products                                         Plastic products
                                     degree indegree outdegree     eigen
Misc. ceramic, stone & clay products    129       54        75 0.7781058
Glass & glass products                  116       48        68 0.6934170
Industrial inorganic chemicals          133       49        84 0.7163664
Miscellaneous metal products            145       54        91 0.7930444
Plastic products                        138       52        86 0.7574951
                                         bonpow          rc    eigen.rc
Misc. ceramic, stone & clay products -2.2143080 0.003338320 0.002597566
Glass & glass products                1.7905830 0.004020029 0.002787557
Industrial inorganic chemicals       -1.0782885 0.011994287 0.008592304
Miscellaneous metal products         -0.1973909 0.034581989 0.027425052
Plastic products                     -0.3806956 0.102300442 0.077492086
                                            dc  eigen.dc        close between
Misc. ceramic, stone & clay products 0.9966617 0.7755083 0.0001890447   284.0
Glass & glass products               0.9959800 0.6906294 0.0003087959  2424.5
Industrial inorganic chemicals       0.9880057 0.7077741 0.0001681996   108.0
Miscellaneous metal products         0.9654180 0.7656193 0.0002504898    85.0
Plastic products                     0.8976996 0.6800030 0.0001914863    11.5
                                     constraint
Misc. ceramic, stone & clay products  0.1079631
Glass & glass products                0.1139342
Industrial inorganic chemicals        0.1153943
Miscellaneous metal products          0.1241241
Plastic products                      0.1291672

Code

df_degree |> arrange(desc(constraint)) |> slice(1:5)

                                                 name degree indegree outdegree
Feeds & organic fertilizer Feeds & organic fertilizer     54       41        13
Metallic ores                           Metallic ores     45       36         9
Medicaments                               Medicaments     74       48        26
Livestock                                   Livestock     53       35        18
Coal mining etc.                     Coal mining etc.     89       36        53
                               eigen     bonpow           rc     eigen.rc
Feeds & organic fertilizer 0.5954991 -2.5409675 2.244451e-02 1.336568e-02
Metallic ores              0.5468021 -0.7909125 6.729973e-05 3.679964e-05
Medicaments                0.6992363 -0.2167730 3.451293e-02 2.413270e-02
Livestock                  0.5120362 -0.8037581 5.637439e-02 2.886573e-02
Coal mining etc.           0.5369580  0.7873295 3.621458e-04 1.944571e-04
                                  dc  eigen.dc        close between constraint
Feeds & organic fertilizer 0.9775555 0.5821334 2.312144e-04  1031.0  0.5746577
Metallic ores              0.9999327 0.5467653 1.723726e-04  1097.5  0.5452584
Medicaments                0.9654871 0.6751036 5.124449e-05    55.0  0.4914972
Livestock                  0.9436256 0.4831705 2.963850e-04   508.5  0.4913486
Coal mining etc.           0.9996379 0.5367635 1.916560e-04   131.5  0.4890750

Feeds & organic fertilizer, Metallic ores and Medicaments are the most reduntant industries while Misc. ceramic, stone & clay products, Glass & glass products and Industrial inorganic chemicals industries are the least reduntant ones.

Centrality Measure Correlations

Code

corrplot :: corrplot(cor(df_degree[ , -1]), title = 'Correlation Plot')

Code

table1 <- kableExtra :: kable(apply(df_degree[ , -1], 2, function (x) df_degree$name[order(x, decreasing = TRUE)][1 : 10]))
table1

degree	indegree	outdegree	eigen	bonpow	rc	eigen.rc	dc	eigen.dc	close	between	constraint
Misc. manufacturing products	Pig iron & crude steel	Commerce	Pig iron & crude steel	Petrochemical basic products	Petroleum refinery products	Pig iron & crude steel	Feed conversion	Public administration	Misc. electronic components	Glass & glass products	Feeds & organic fertilizer
Transport & post service	Public administration	Miscellaneous metal products	Public administration	Medical service etc.	Steel products	Petroleum refinery products	Gasification	Misc. manufacturing products	Household electronics equipment	Pottery, china & earthenware	Metallic ores
Personal services	Misc. manufacturing products	Misc. manufacturing products	Personal services	Textile products	Motor vehicle parts & accessories	Motor vehicle parts & accessories	Composting	Lumber and wood products	Forestry	Forestry	Medicaments
Business services	Transport & post service	Wearing apparel etc.	Transport & post service	Non-ferrous metal products	Pig iron & crude steel	Steel products	Refuse derived fuel	Personal services	Medical service etc.	Chemical fertilizer	Livestock
Miscellaneous metal products	Personal services	Final chemical products	Misc. manufacturing products	Glass & glass products	Passenger motor cars	Passenger motor cars	Filtration	Public construction	Glass & glass products	Metallic ores	Coal mining etc.
Final chemical products	Business services	Petroleum refinery products	Business services	General-purpose machinery	Medical service etc.	Medical service etc.	Metallic ores	Misc. transportation equipment & repair	Steel products	Coal products	Miscellaneous cars
Repair of construction	Production machinery	Electricity	Production machinery	Cement & cement products	Foods	Foods	Coal mining etc.	Production machinery	Pottery, china & earthenware	Feeds & organic fertilizer	Passenger motor cars
Communications & broadcasting	Lumber and wood products	Transport & post service	Building construction	Synthetic fibers	Non-ferrous metal products	Non-ferrous metal products	Concentration	Building construction	Chemical fertilizer	Lumber and wood products	Petrochemical basic products
Activities not elsewhere classified	Building construction	Printing etc.	Misc. transportation equipment & repair	Pottery, china & earthenware	Real estate services	Transport & post service	Agricultural services	Transport & post service	Non-ferrous metal products	Textile products	Fishery
Lumber and wood products	General-purpose machinery	Repair of construction	Lumber and wood products	Metal products for construction	Communications & broadcasting	Communications & broadcasting	Pottery, china & earthenware	Ships & repair of ships	Rubber products	Pig iron & crude steel	Pig iron & crude steel

Code

industry_io.node <-data.frame(apply(df_degree[ , -1], 2, function (x) df_degree$name[order(x, decreasing = TRUE)][1 : 10]))
industry_io.node

                                degree                     indegree
1         Misc. manufacturing products       Pig iron & crude steel
2             Transport & post service        Public administration
3                    Personal services Misc. manufacturing products
4                    Business services     Transport & post service
5         Miscellaneous metal products            Personal services
6              Final chemical products            Business services
7               Repair of construction         Production machinery
8        Communications & broadcasting     Lumber and wood products
9  Activities not elsewhere classified        Building construction
10            Lumber and wood products    General-purpose machinery
                      outdegree                                    eigen
1                      Commerce                   Pig iron & crude steel
2  Miscellaneous metal products                    Public administration
3  Misc. manufacturing products                        Personal services
4          Wearing apparel etc.                 Transport & post service
5       Final chemical products             Misc. manufacturing products
6   Petroleum refinery products                        Business services
7                   Electricity                     Production machinery
8      Transport & post service                    Building construction
9                 Printing etc. Misc. transportation equipment  & repair
10       Repair of construction                 Lumber and wood products
                            bonpow                                rc
1     Petrochemical basic products       Petroleum refinery products
2             Medical service etc.                    Steel products
3                 Textile products Motor vehicle parts & accessories
4       Non-ferrous metal products            Pig iron & crude steel
5           Glass & glass products              Passenger motor cars
6        General-purpose machinery              Medical service etc.
7         Cement & cement products                             Foods
8                 Synthetic fibers        Non-ferrous metal products
9     Pottery, china & earthenware              Real estate services
10 Metal products for construction     Communications & broadcasting
                            eigen.rc                           dc
1             Pig iron & crude steel              Feed conversion
2        Petroleum refinery products                 Gasification
3  Motor vehicle parts & accessories                   Composting
4                     Steel products          Refuse derived fuel
5               Passenger motor cars                   Filtration
6               Medical service etc.                Metallic ores
7                              Foods             Coal mining etc.
8         Non-ferrous metal products                Concentration
9           Transport & post service        Agricultural services
10     Communications & broadcasting Pottery, china & earthenware
                                   eigen.dc                           close
1                     Public administration     Misc. electronic components
2              Misc. manufacturing products Household electronics equipment
3                  Lumber and wood products                        Forestry
4                         Personal services            Medical service etc.
5                       Public construction          Glass & glass products
6  Misc. transportation equipment  & repair                  Steel products
7                      Production machinery    Pottery, china & earthenware
8                     Building construction             Chemical fertilizer
9                  Transport & post service      Non-ferrous metal products
10                  Ships & repair of ships                 Rubber products
                        between                   constraint
1        Glass & glass products   Feeds & organic fertilizer
2  Pottery, china & earthenware                Metallic ores
3                      Forestry                  Medicaments
4           Chemical fertilizer                    Livestock
5                 Metallic ores             Coal mining etc.
6                 Coal products           Miscellaneous cars
7    Feeds & organic fertilizer         Passenger motor cars
8      Lumber and wood products Petrochemical basic products
9              Textile products                      Fishery
10       Pig iron & crude steel       Pig iron & crude steel

Code

df_degree_io <- df_degree

These are the industries having the highest of centrality measures for the industries network. The nodes having higher indegrees have more inwards directed edges while outdegree gives an idea about how the outwards connections are for the node. Eigen vector, Bonacich value, Eigen Reflected Centrality, Eigen Derived Centrality are various measures of centrality of nodes. These measures suggests how influential the nodes are. Betweenness is a measure of the position of nodes in terms of closeness to other influential nodes. Constraint tells us about the level of redundancy of a node in the network to create connections with other neighbouring nodes.

Most and Least influential industries and their contribution to the waste output

Eventhough the different measures of centrality talks about the significance and influence of nodes, we are taking into consideration, Bonacich power and Constraint here to compare the waste output.

Code

df_bonpow <- df_degree |>
  arrange(desc(bonpow)) |>
  slice(1:5)

df_constraint <- df_degree |> arrange(desc(constraint)) |> slice(1:5)

industry_waste <- data_2011 |> select(
...1, 83:92)
industry_waste

# A tibble: 294 × 11
   ...1   Incineration Dehydration Concentration Shredding Filtration Composting
   <chr>         <dbl>       <dbl>         <dbl>     <dbl>      <dbl>      <dbl>
 1 Crop …          0           0            0          0        0         0     
 2 Lives…          0           0            0          0        0         0     
 3 Agric…          0           0            0          0        0         0     
 4 Fores…          0           0            0          0        0         0     
 5 Fishe…          0           0            0          0        0         0     
 6 Metal…          0           0            0          0        0         0     
 7 Coal …         16.7        39.7          3.98      12.2      0.253     0.0431
 8 Non-m…          0           0            0          0        0         0     
 9 Foods           0           0            0          0        0         0     
10 Bever…          0           0            0          0        0         0     
# ℹ 284 more rows
# ℹ 4 more variables: `Feed conversion` <dbl>, Gasification <dbl>,
#   `Refuse derived fuel` <dbl>, Landfill <dbl>

Code

filtered_data1 <- industry_waste[industry_waste$...1 %in% df_bonpow$name, ]
filtered_data2 <- industry_waste[industry_waste$...1 %in% df_constraint$name, ]

Code

combined_df_long <- melt(combined_df, id.vars = "...1", variable.name = "to", value.name = "weight", variable.factor = FALSE)

Error in eval(expr, envir, enclos): object 'combined_df' not found

Code

# Rename the "Industries" column to "From"
colnames(combined_df_long)[colnames(combined_df_long) == "...1"] <- "from"

Error: object 'combined_df_long' not found

Code

combined_df_long

Error in eval(expr, envir, enclos): object 'combined_df_long' not found

Waste output from most significant industries

Code

filter1_long <- melt(filtered_data1, id.vars = "...1", variable.name = "to", value.name = "weight", variable.factor = FALSE)

# Rename the "Industries" column to "From"
colnames(filter1_long)[colnames(filter1_long) == "...1"] <- "from"
#filter1_long


# Create a heatmap plot
ggplot(filter1_long, aes(x = from, y = to, fill = log(weight))) +
  geom_tile() +
  scale_fill_gradient(low = "yellow", high = "red") +  # Change the color pattern
  labs(x = NULL, y = "To", title = "Heatmap of Weight") +
  theme_minimal() +
  theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust = 1))  # Rotate x-axis labels

Waste output from industries with high redundancy

Code

filter2_long <- melt(filtered_data2, id.vars = "...1", variable.name = "to", value.name = "weight", variable.factor = FALSE)

# Rename the "Industries" column to "From"
colnames(filter2_long)[colnames(filter2_long) == "...1"] <- "from"
#filter2_long


# Create a heatmap plot
ggplot(filter2_long, aes(x = from, y = to, fill = log(weight))) +
  geom_tile() +
  scale_fill_gradient(low = "yellow", high = "red") +  # Change the color pattern
  labs(x = NULL, y = "To", title = "Heatmap of Weight") +
  theme_minimal() +
  theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust = 1))  # Rotate x-axis labels

Conclusion

The results show how much wastes go to each of the waste processing methods from the industries having most centrality measures and the most redundancy measures.

Limitation

The dataset is an older data. It is from Japan. Taking these things into consideration, we cannot make a solid conclusion about the waste outputs from industries in other parts of the world today. Also, we can compare the weight outputs from industries having each of the centrality score high and low. This would make the analysis even harder. So this study has been concluded with the available results.

Reference:

1. Nakamura, S. (2020). Tracking the Product Origins of Waste for Treatment Using the WIO Data Developed by the Japanese Ministry of the Environment. Env. Sci. Technol. https://doi.org/10.1021/acs.est.0c06015