Leaf Plant Classification: An Exploratory Analysis – Part 1

[This article was first published on R Programming – DataScience+, and kindly contributed to R-bloggers]. (You can report issue about the content on this page here)
Want to share your content on R-bloggers? click here if you have a blog, or here if you don't.

    Categories

    1. Getting Data

    Tags

    1. Data Management
    2. Data Visualisation
    3. Exploratory Analysis
    4. R Programming

    In this post, I am going to run an exploratory analysis of the plant leaf dataset as made available by UCI Machine Learning repository at this link. The dataset is expected to comprise sixteen samples each of one-hundred plant species. Its analysis was introduced within ref. [1]. That paper describes a method designed to work in conditions of small training set size and possibly incomplete extraction of features.

    This motivated separate processing of three feature types:

    • shape
    • texture
    • margin

    Those are then combined to provide an overall indication of the species (and associated probability). For an accurate description of those features, please see ref. [1] where the classification is implemented by a K-Nearest-Neighbor density estimator. Ref. [1] authors show the accuracy reached by K-Nearest-Neighbor classification for any combination of the datasets in use (see ref. [1] Table 2).

    Packages

    suppressPackageStartupMessages(library(caret))
    suppressPackageStartupMessages(library(dplyr))
    suppressPackageStartupMessages(library(ggplot2))
    suppressPackageStartupMessages(library(corrplot))
    suppressPackageStartupMessages(library(Hmisc))

    Exploratory Analysis

    Getting Data

    We can download the leaf dataset as a zip file by taking advantage of the following UCI Machine Learning url.

    url <- "https://archive.ics.uci.edu/ml/machine-learning-databases/00241/100%20leaves%20plant%20species.zip"
    temp_file <- tempfile()
    download.file(url, temp_file)

    The files of interest are:

    margin_file <- "100 leaves plant species/data_Mar_64.txt"
    shape_file <- "100 leaves plant species/data_Sha_64.txt"
    texture_file <- "100 leaves plant species/data_Tex_64.txt"

    that can be so extracted.

    files_to_unzip <- c(margin_file, shape_file, texture_file)
    unzip(temp_file, files = files_to_unzip, exdir=".", overwrite = TRUE)

    We read them as CSV files. No header is originally provided.

    margin_data <- read.csv(margin_file, header=FALSE, sep=",", stringsAsFactors = TRUE)
    shape_data <- read.csv(shape_file, header=FALSE, sep=",", stringsAsFactors = TRUE)
    texture_data <- read.csv(texture_file, header=FALSE, sep=",", stringsAsFactors = TRUE)

    We check the number of rows and columns of the resulting datasets.

    dim(margin_data)</code>
    <em>## [1] 1600   65
    </em></pre>
    <pre><code class="r">dim(shape_data)</code>
    <em>## [1] 1600   65
    </em></pre>
    <pre><code class="r">dim(texture_data)</code>
    <em>## [1] 1599   65
    </em></pre>
    <p>We notice that the texture dataset has one row less. Such issue will be fixed at a later moment. </p>
    <pre><code class="r">sum(complete.cases(margin_data)) == nrow(margin_data)</code>
    <em>## [1] TRUE
    </em></pre>
    <pre><code class="r">sum(complete.cases(shape_data)) == nrow(shape_data)</code>
    <em>## [1] TRUE
    </em></pre>
    <pre><code class="r">sum(complete.cases(texture_data)) == nrow(texture_data)</code>
    <em>## [1] TRUE
    </em></pre>
    <p>No NA's value are present. Column naming is necessary due to the absence of header.</p>
    <pre><code class="r">n_features <- ncol(margin_data) - 1
    colnames(margin_data) <- c("species", paste("margin", as.character(1:n_features), sep=""))
    margin_data$species <- factor(margin_data$species)
    
    n_features <- ncol(shape_data) - 1
    colnames(shape_data) <- c("species", paste("shape", as.character(1:n_features), sep=""))
    shape_data$species <- factor(shape_data$species)
    
    n_features <- ncol(texture_data) - 1
    colnames(texture_data) <- c("species", paste("texture", as.character(1:n_features), sep=""))
    texture_data$species <- factor(texture_data$species)

    We count the number of entries for each species within each dataset.

    margin_count <- sapply(base::split(margin_data, margin_data$species), nrow)
    shape_count <- sapply(base::split(shape_data, shape_data$species), nrow)
    texture_count <- sapply(base::split(texture_data, texture_data$species), nrow)

    That in order to identify what species is associated to the missing entry inside the texture dataset.

    which(margin_count != texture_count)</code>
    <em>## Acer Campestre 
    ##              1
    </em></pre>
    <pre><code class="r">which(shape_count != texture_count)</code>
    <em>## Acer Campestre 
    ##              1
    </em></pre>
    <p>The texture data missing entry is associated to Acer Campestre species. Adding an identifier column to all datasets to allow for datasets merging (joining).</p>
    <pre><code class="r">margin_data <- mutate(margin_data, id = 1:nrow(margin_data))
    shape_data <- mutate(shape_data, id = 1:nrow(shape_data))
    texture_data <- mutate(texture_data, id = 1:nrow(texture_data))

    Imputation

    In the following, we fix the missing entry by imputation technique based on median. We suppose the missing entry is related with 16th sample of Acer Campestre texture data, which is the first plant species of our datasets. For the purpose, we take advantage of a temporary dataset made of first 15 entries and then we add such new row with median computed data. Afterwards, we “row-bind” such temporary dataset with the rest of the original texture samples.

    dd <- data.frame(matrix(nrow=1, ncol = 66))
    colnames(dd) <- colnames(texture_data)
    dd$species <- "Acer Campestre"
    dd$id <- 16
    
    temp_texture_data <- rbind(texture_data[1:15,], dd)
    features <- setdiff(colnames(temp_texture_data), c("species", "id"))
    imputed <- sapply(features, function(x) { as.numeric(impute(temp_texture_data[, x], median)[16])})
    temp_texture_data[16, names(imputed)] <- imputed
    
    texture_data <- rbind(temp_texture_data, texture_data[-(1:15),])
    texture_data <- mutate(texture_data, id = 1:nrow(texture_data))
    dim(texture_data)</code>
    <em>## [1] 1600   66
    </em></pre>
    <p>Here is what we got at the end. </p>
    <pre><code class="r">str(margin_data)</code>
    <em>## 'data.frame':    1600 obs. of  66 variables:
    ##  $ species : Factor w/ 100 levels "Acer Campestre",..: 1 1 1 1 1 1 1 1 1 1 ...
    ##  $ margin1 : num  0.00391 0.00586 0.01172 0.01367 0.00781 ...
    ##  $ margin2 : num  0.00391 0.01367 0.00195 0.01172 0.00977 ...
    ##  $ margin3 : num  0.0273 0.0273 0.0273 0.0371 0.0273 ...
    ##  $ margin4 : num  0.0332 0.0254 0.0449 0.0176 0.0254 ...
    ##  $ margin5 : num  0.00781 0.01367 0.01758 0.01172 0.00195 ...
    ##  $ margin6 : num  0.01758 0.0293 0.04297 0.08789 0.00586 ...
    ##  $ margin7 : num  0.0234 0.0195 0.0234 0.0234 0.0156 ...
    ##  $ margin8 : num  0.00586 0 0 0 0 ...
    ##  $ margin9 : num  0 0.00195 0.00391 0 0.00586 ...
    ##  $ margin10: num  0.0156 0.0215 0.0195 0.0273 0.0176 ...
    ....
    ....
    </em></pre>
    <pre><code class="r">str(shape_data)</code>
    <em>## 'data.frame':    1600 obs. of  66 variables:
    ##  $ species: Factor w/ 100 levels "Acer Campestre",..: 2 2 2 2 2 2 2 2 2 2 ...
    ##  $ shape1 : num  0.000579 0.00063 0.000616 0.000613 0.000599 ...
    ##  $ shape2 : num  0.000609 0.000661 0.000615 0.000569 0.000552 ...
    ##  $ shape3 : num  0.000551 0.000719 0.000606 0.000564 0.000558 ...
    ##  $ shape4 : num  0.000554 0.000651 0.000568 0.000607 0.000569 ...
    ##  $ shape5 : num  0.000603 0.000643 0.000558 0.000643 0.000616 ...
    ##  $ shape6 : num  0.000614 0.00064 0.000552 0.000647 0.000639 ...
    ##  $ shape7 : num  0.000611 0.000646 0.000551 0.000663 0.000631 ...
    ##  $ shape8 : num  0.000611 0.000624 0.000552 0.000658 0.000634 ...
    ##  $ shape9 : num  0.000611 0.000584 0.000531 0.000635 0.000639 ...
    ##  $ shape10: num  0.000594 0.000546 0.00053 0.0006 0.000596 ...
    ...
    ...
    </em></pre>
    <pre><code class="r">str(texture_data)</code>
    <em>## 'data.frame':    1600 obs. of  66 variables:
    ##  $ species  : Factor w/ 100 levels "Acer Campestre",..: 1 1 1 1 1 1 1 1 1 1 ...
    ##  $ texture1 : num  0.02539 0.00488 0.01855 0.03516 0.03809 ...
    ##  $ texture2 : num  0.0127 0.0186 0.0137 0.0234 0.0146 ...
    ##  $ texture3 : num  0.003906 0.00293 0.00293 0.000977 0.003906 ...
    ##  $ texture4 : num  0.004883 0 0.00293 0 0.000977 ...
    ##  $ texture5 : num  0.0391 0.0693 0.0518 0.0615 0.0469 ...
    ##  $ texture6 : num  0 0 0 0 0 0 0 0 0 0 ...
    ##  $ texture7 : num  0.0176 0.0137 0.0195 0.0215 0.0225 ...
    ##  $ texture8 : num  0.0352 0.0439 0.0352 0.0615 0.0537 ...
    ##  $ texture9 : num  0.0234 0.0264 0.0225 0.0107 0.0195 ...
    ##  $ texture10: num  0.013672 0 0.000977 0.001953 0.004883 ...
    ...
    ...
    </em></pre>
    <h3>Correlation Analysis</h3>
    <p>Since margin, shape and texture covariates are quantitative variables, it is of interest to evaluate correlation among such leaf features.</p>
    <p>We do it by taking advantage of the correlation plot. We show that for the margin1 feature.</p>
    <pre><code class="r">m_l <- split(margin_data, margin_data$species)
    
    extract_feature <- function(m_l, feature) {
      f <- lapply(m_l, function(x) { x[,feature] })
      do.call(cbind, f)
    }
    
    thefeature <- "margin1"
    m <- extract_feature(m_l, thefeature)
    cor_mat <- cor(m)
    corrplot(cor_mat, method = "circle", type="upper", tl.cex=0.3)

    The correlation plot is not so easy to interpret. Therefore we implement a procedure capable to filter out the significative and most relevant correlations. At the purpose, we use an helper function named as flattenCorrMatrix as can be found in ref. [3].

    flattenCorrMatrix <- function(cormat, pmat) {
      ut <- upper.tri(cormat)
      data.frame(
        row = rownames(cormat)[row(cormat)[ut]],
        column = rownames(cormat)[col(cormat)[ut]],
        cor  =(cormat)[ut],
        p = pmat[ut]
        )
    }

    The following utility function is capable to extract a given feature from one of the available datasets and report the flatten correlation matrix providing with the significative correlation and whose relevance is above a certain absolute value as specified by the threshold parameter.

    most_correlated <- function(dataset, feature, threshold) {
      m_l <- split(dataset, dataset$species)
      m <- extract_feature(m_l, feature)
      rcorr_m <- rcorr(m)
      flat_cor <- flattenCorrMatrix(rcorr_m$r, rcorr_m$P)
      attr(flat_cor, "variable") <- feature
      flat_cor <- flat_cor %>% filter(p < 0.05) %>% filter(abs(cor) > threshold)
      flat_cor[,-4] # getting rid of the p-value column
    }

    Here is what we get as correlation matrix for the margin_data dataset and the margin2 feature with a threshold equal to 0.7.

    corr_margin2 <- most_correlated(margin_data, "margin2", 0.7)
    corr_margin2</code>
    <em>##                    row                  column        cor
    ## 1      Acer Capillipes     Cercis Siliquastrum  0.7038700
    ## 2  Cercis Siliquastrum      Cornus Controversa -0.7294585
    ## 3            Acer Mono Liriodendron Tulipifera -0.7032354
    ## 4      Ilex Aquifolium             Morus Nigra  0.7647532
    ## 5          Acer Opalus   Populus Grandidentata -0.7751047
    ## 6  Cercis Siliquastrum            Prunus Avium  0.7295616
    ## 7     Cornus Chinensis   Pterocarya Stenoptera  0.7345398
    ## 8        Alnus Cordata         Quercus Brantii  0.7257876
    ## 9       Acer Campestre  Quercus Phillyraeoides -0.7150759
    ## 10     Acer Circinatum           Quercus Rubra  0.8082904
    ## 11  Cornus Controversa  Quercus Semecarpifolia -0.7089530
    ## 12     Castanea Sativa      Quercus Variabilis  0.7299116
    ## 13      Acer Rufinerve       Quercus Vulcanica  0.7180856
    </em></pre>
    <p>If we want to collect all the correlation matrixes for the margin_data, here is how we can do.</p>
    <pre><code class="r">margin_names <- setdiff(colnames(margin_data), c("species", "id"))
    margin_corr_l <- lapply(margin_names, function(x) {most_correlated(margin_data, x, 0.7)})
    names(margin_corr_l) <- margin_names

    Let us have a look at a correlation matrix as item of such list.

    margin_corr_l[["margin32"]]</code>
    <em>##                      row                       column        cor
    ## 1    Eucalyptus Urnigera                  Morus Nigra  0.7623514
    ## 2    Eucalyptus Urnigera                Olea Europaea  1.0000000
    ## 3            Morus Nigra                Olea Europaea  0.7623514
    ## 4    Cercis Siliquastrum            Quercus Agrifolia  0.7474093
    ## 5     Cornus Macrophylla              Quercus Brantii  0.8071712
    ## 6      Populus Adenopoda        Quercus Castaneifolia  0.7092994
    ## 7      Quercus Coccifera            Quercus Crassipes  0.7422717
    ## 8    Arundinaria Simonii        Quercus Ellipsoidalis  0.7625542
    ## 9     Cornus Controversa              Quercus Greggii  1.0000000
    ## 10             Acer Mono              Quercus Phellos  0.9165285
    ## 11     Quercus Crassipes       Quercus Semecarpifolia  0.7682705
    ## 12   Cytisus Battandieri            Quercus Shumardii -0.7324311
    ## 13          Quercus Ilex                Quercus Suber  0.8382549
    ## 14  Quercus Dolicholepis               Quercus Texana  0.7090909
    ## 15     Quercus Pubescens               Salix Intergra  0.7603719
    ## 16       Ilex Aquifolium           Tilia Platyphyllos  0.7939940
    ## 17    Cornus Macrophylla               Viburnum Tinus  0.8451543
    ## 18        Betula Pendula Viburnum x Rhytidophylloides -0.7224267
    ## 19 Populus Grandidentata              Zelkova Serrata  0.7453458
    </em></pre>
    <p>Here we do the same for shape and texture features datasets. For shape dataset we show shape3 feature correlation matrix result.</p>
    <pre><code class="r">shape_names <- setdiff(colnames(shape_data), c("species", "id"))
    shape_corr_l <- lapply(shape_names, function(x) {most_correlated(shape_data, x, 0.7)})
    names(shape_corr_l) <- shape_names

    shape_corr_l[["shape3"]]</code>
    <em>##                       row                 column        cor
    ## 1          Acer Campestre    Arundinaria Simonii  0.7643580
    ## 2           Alnus Viridis   Callicarpa Bodinieri -0.7467261
    ## 3         Acer Platanoids            Morus Nigra -0.7674200
    ## 4    Magnolia Salicifolia           Prunus Avium  0.7306309
    ## 5            Prunus Avium  Pterocarya Stenoptera  0.7042563
    ## 6             Morus Nigra         Quercus Cerris -0.7316674
    ## 7       Quercus Alnifolia    Quercus Chrysolepis  0.7019743
    ## 8  Eucalyptus Glaucescens    Quercus Crassifolia  0.7414744
    ## 9          Quercus Cerris        Quercus Greggii  0.7100278
    ## 10         Quercus Cerris           Quercus Ilex -0.8346480
    ## 11  Quercus Castaneifolia Quercus Phillyraeoides  0.7305218
    ## 12     Cornus Macrophylla          Quercus Rubra  0.8231097
    ## 13            Morus Nigra         Quercus Texana  0.7232813
    ## 14          Populus Nigra        Quercus Trojana -0.7157611
    ## 15      Quercus Alnifolia      Quercus Vulcanica -0.7350224
    ## 16    Quercus Chrysolepis      Quercus Vulcanica -0.8157281
    ## 17  Quercus Castaneifolia     Ulmus Bergmanniana  0.7747396
    </em></pre>
    <p>For texture dataset we show texture19 feature correlation matrix result.</p>
    <pre><code class="r">texture_names <- setdiff(colnames(texture_data), c("species", "id"))
    texture_corr_l <- lapply(texture_names, function(x) {most_correlated(texture_data, x, 0.7)})
    names(texture_corr_l) <- texture_names

    texture_corr_l[["texture19"]]</code>
    <em>##                          row                       column        cor
    ## 1              Acer Palmatum         Callicarpa Bodinieri -0.8069241
    ## 2         Cornus Macrophylla              Ilex Aquifolium  0.7243966
    ## 3     Eucalyptus Glaucescens      Liriodendron Tulipifera  0.7609341
    ## 4        Eucalyptus Urnigera    Lithocarpus Cleistocarpus  0.8353815
    ## 5                  Acer Mono                Olea Europaea  0.8007114
    ## 6                Alnus Rubra                Olea Europaea  0.7121676
    ## 7    Liquidambar Styraciflua          Quercus Chrysolepis  0.7252803
    ## 8         Magnolia Heptapeta             Quercus Coccinea  0.7512588
    ## 9         Magnolia Heptapeta          Quercus Crassifolia  0.8270324
    ## 10          Quercus Coccinea          Quercus Crassifolia  0.7479191
    ## 11 Lithocarpus Cleistocarpus            Quercus Crassipes  0.7031255
    ## 12         Cotinus Coggygria            Quercus Palustris  0.7104135
    ## 13         Alnus Sieboldiana            Quercus Pyrenaica  0.7401955
    ## 14              Ilex Cornuta              Quercus Trojana  0.7432011
    ## 15               Morus Nigra              Quercus Trojana  0.7238492
    ## 16           Quercus Greggii          Quercus x Hispanica  0.7396316
    ## 17         Quercus Pyrenaica                  Sorbus Aria  0.7345942
    ## 18       Eucalyptus Neglecta                Tilia Oliveri  0.7565882
    ## 19              Prunus Avium Viburnum x Rhytidophylloides -0.7451209
    ## 20             Alnus Viridis              Zelkova Serrata -0.7052669
    </em></pre>
    <p>Furthermore, by collecting the number of rows of such correlation matrixes, the most correlated features among the one hundred leaf plant species can be put in evidence.</p>
    <pre><code class="r">t <- sapply(margin_corr_l, nrow)
    margin_c <- data.frame(feature = names(t), value = t)
    
    t <- sapply(shape_corr_l, nrow)
    shape_c <- data.frame(feature = names(t), value = t)
    
    t <- sapply(texture_corr_l, nrow)
    texture_c <- data.frame(feature = names(t), value = t)

    ggplot(data = margin_c, aes(x=feature, y=value, fill = feature)) + theme_bw() + theme(legend.position = "none") + geom_histogram(stat='identity') + coord_flip()

    ggplot(data = margin_c, aes(x=feature, y=value, fill = feature)) + theme_bw() + theme(legend.position = "none") + geom_histogram(stat='identity') + coord_flip()

    ggplot(data = margin_c, aes(x=feature, y=value, fill = feature)) + theme_bw() + theme(legend.position = "none") + geom_histogram(stat='identity') + coord_flip()

    Boxplots are shown to highlight differences in features among species. At the purpose, we define the following utility function.

    species_boxplot <- function(dataset, variable) {
      p <- ggplot(data = dataset, aes(x = species, y = eval(parse(text=variable)), fill= species)) + theme_bw() + theme(legend.position = "none") + geom_boxplot() + ylab(parse(text=variable))
      p <- p + theme(axis.text.x = element_text(angle = 90, hjust = 1)) + ggtitle(paste(variable, "among species", sep = " "))
      p
    }

    Margin feature boxplot

    For each margin feature, a boxplot as shown below can be generated. Herein, the boxplot associated to the margin1 feature.

    species_boxplot(margin_data, "margin1")

    If you are interested in having a summary report, you may take advantage of the following line of code.

    with(margin_data, tapply(margin1, species, summary))

    Shape feature boxplot

    We show the boxplot for shape features by considering the shape20 as example.

    species_boxplot(shape_data, "shape20")

    Texture feature boxplot

    We show the boxplot for texture features by considering the texture31 as example.

    species_boxplot(texture_data, "texture31")

    Saving the current enviroment for further analysis.

    save.image(file='PlantLeafEnvironment.RData')

    References

    1. Charles Mallah, James Cope and James Orwell, “PLANT LEAF CLASSIFICATION USING PROBABILISTIC INTEGRATION OF SHAPE, TEXTURE AND MARGIN FEATURES”, link
    2. 100 Plant Leaf Dataset
    3. Correlation Matrix: a quick start guide
      1. Related Post

        1. Proteomics Data Analysis (1/3): Data Acquisition and Cleaning
        2. Accessing Web Data (JSON) in R using httr
        3. Zomato Web Scraping with BeautifulSoup in Python
        4. Processing Huge Dataset with Python
        5. Finding the Popular Indian Blogging Platform by Web Scraping in Python

        To leave a comment for the author, please follow the link and comment on their blog: R Programming – DataScience+.

        R-bloggers.com offers daily e-mail updates about R news and tutorials about learning R and many other topics. Click here if you're looking to post or find an R/data-science job.
        Want to share your content on R-bloggers? click here if you have a blog, or here if you don't.

    Never miss an update!
    Subscribe to R-bloggers to receive
    e-mails with the latest R posts.
    (You will not see this message again.)

    Click here to close (This popup will not appear again)