TidyTuesday 2022W01 – Bring Your Own Data

This week #Tidytuesday is the traditional “Bring Your Own Data” annual event!

To celebrate this very unique new year, I choose to bring to my blog a little dashboard that I’ve created. I use this dataviz to summarize all the available information about a farmer’s field. This viz is all about positioning a specific among other fields without giving any information on the data distribution. It’s usually very appreciated. What do you think? Would you change something about it?

Library

# Data
library(openxlsx)

# EDA
library(lubridate)
library(tidyverse)
library(ggplot2)
library(correlationfunnel)
library(skimr)
library(kableExtra)

# Parallel Processing
library(doFuture)

# Core 
library(recipes)
library(tidymodels)
library(timetk)
library(modeltime)

#My functions
#devtools::install_github("jofou/jofou.lib")
library(jofou.lib)

Data

I present here the case of field 1 of John Doe’s farm. Those little
dashboard are useful to make portraits of corn fields.

data_bilan_valeur <- data.frame(ferme_champ=c("John Doe Farm - Field 1","John Doe Farm - Field 1","John Doe Farm - Field 1","John Doe Farm - Field 1"),
                                type=c("N_tissus_mg_kg", "rdt_tha", "Apport_N", "ratio_c_labile_pct"),
                                valeur=c(167, 11.5, 210, 1.6))

data_bilan_valeur %>% 
  kable() %>% 
  kable_styling(bootstrap_options = c("condensed"), full_width = T, position = "left")
ferme_champ type valeur
John Doe Farm – Field 1 N_tissus_mg_kg 167.0
John Doe Farm – Field 1 rdt_tha 11.5
John Doe Farm – Field 1 Apport_N 210.0
John Doe Farm – Field 1 ratio_c_labile_pct 1.6

This graph aims to help John Doe compare the parameters of his corn field to the parameters of all the corn field. To do that, I use parameters of all corn field to create regressions. The results of those regression, help positionning points on the graph.

coefficient<-data.frame(parametre=c("rendement", "azote", "nitrates", "labile"),
                                 a=c(11.6, 0.165, 0.0174, 25.4),
                                 b=c(-60, 11.3, 26, -4.07))

coefficient %>% 
  kable() %>% 
  kable_styling(bootstrap_options = c("condensed"), full_width = T, position = "left")
parametre a b
rendement 11.6000 -60.00
azote 0.1650 11.30
nitrates 0.0174 26.00
labile 25.4000 -4.07
data_bilan_graph<-data_bilan_valeur %>% 
  pivot_wider(names_from ="type", values_from="valeur") %>% 
  mutate(rdt_pct=coefficient$a[1]*rdt_tha+coefficient$b[1],
         apport_n_pct=coefficient$a[2]*Apport_N+coefficient$b[2],
         N_tissus_pct=coefficient$a[3]*N_tissus_mg_kg+coefficient$b[3],
         c_labile_pct=coefficient$a[4]*ratio_c_labile_pct+coefficient$b[4]) %>% 
  select(ferme_champ, N_tissus_pct, rdt_pct, apport_n_pct, c_labile_pct) %>% 
  pivot_longer(-ferme_champ, names_to = "type", values_to = "valeur")

data_bilan_graph %>% 
  kable() %>% 
  kable_styling(bootstrap_options = c("condensed"), full_width = T, position = "left")
ferme_champ type valeur
John Doe Farm – Field 1 N_tissus_pct 28.9058
John Doe Farm – Field 1 rdt_pct 73.4000
John Doe Farm – Field 1 apport_n_pct 45.9500
John Doe Farm – Field 1 c_labile_pct 36.5700

Plot

data_bilan_graph$type <- factor(data_bilan_graph$type,levels = c("N_tissus_pct", "rdt_pct", "apport_n_pct", "c_labile_pct"))

data_bilan_valeur$type <- factor(data_bilan_valeur$type,levels = c("N_tissus_mg_kg", "rdt_tha", "Apport_N", "ratio_c_labile_pct"))

gg<-ggplot(data_bilan_graph, aes(x=valeur, y=factor(type))) +
  geom_segment(aes(x=0, xend=100,y=type, yend=type), color="#A9A9A9", alpha=0.6, size=3) +    
  geom_vline(xintercept =c(25,75),linetype=2,size=2, color="#0A369D" ) + 
  annotate("rect", xmin=38.58, xmax=39.78, ymin=0.8, ymax=1.2,fill="#101010", alpha=0.6) +
  geom_text(aes(x=38.18, y=1.3, label="700 mg/kg"), color="#101010", size=3.5, vjust=0.5, hjust=0.5) + 
  annotate("rect", xmin=59.2, xmax=60.4, ymin=0.8, ymax=1.2,fill="#101010", alpha=0.6) +
  geom_text(aes(x=60.8, y=1.3, label="2000 mg/kg"), color="#101010", size=3.5, vjust=0.5, hjust=0.5) +
  geom_text(aes(x=20, y=4.5, label="25% inferior"), color="#0A369D", size=4, vjust=0.5, hjust=1, fontface="bold") + 
  geom_text(aes(x=78, y=4.5, label="25% superior"), color="#0A369D", size=4, vjust=0.5, hjust=0, fontface="bold") + 
  geom_point(data=data_bilan_graph, aes(x=valeur, y=factor(type)),color="#F27900", fill="#F1B745", shape=21, size=20) +
  geom_text(aes(x=valeur, y=type, label=(round(data_bilan_valeur$valeur,digits=1))), color="#3E3E3E", size=5.5, vjust=0.5, hjust=0.5, fontface="bold") + 
  scale_x_discrete(breaks=seq(1,4,1), limits=c(0,4.5))+
  scale_y_discrete(label= c( "Nitratenmg/kg", "Yieldnkg/ha","N Brut Supplynkg/ha", "Labil Carbonn%")) +
  theme_classic()+  
  theme(axis.line.x      = element_blank(),
        axis.line.y      = element_blank(),
        axis.ticks       = element_blank(),
        strip.background = element_rect(colour="#3F3E46", fill=NA),
        plot.title       = element_text(size=20, hjust=0.5,vjust=0.5,face="bold", color="#201F23" ),
        plot.subtitle = element_blank(),
        plot.caption  = element_blank(),
        axis.title.y  = element_blank(),
        axis.title.x  = element_blank(),
        axis.text.y   = element_text(size=16, hjust=1,vjust=0.5, color="#3F3E46"),
        axis.text.x   = element_blank()) + 
  labs(title="John Doe Farm - Field 1",
                x=" ",
                y=" ")

gg

Now we can clearly see that John Doe’s Fiel 1 has yielded nearly as good as the top 25% event thought the nitrogen supply was on the average and the nitrate in the rod was close to the 25% inferior group.


Sys.time()

FALSE [1] "2022-01-09 13:54:40 EST"

git2r::repository()

FALSE Local:    master /Users/johaniefournier/Library/Mobile Documents/com~apple~CloudDocs/TidyTuesday
FALSE Remote:   master @ origin (https://github.com/Jofou/TidyTuesday.git)
FALSE Head:     [80b63ea] 2022-01-09: correct table

sessionInfo()

FALSE R version 4.0.4 (2021-02-15)
FALSE Platform: x86_64-apple-darwin17.0 (64-bit)
FALSE Running under: macOS Big Sur 10.16
FALSE 
FALSE Matrix products: default
FALSE BLAS:   /Library/Frameworks/R.framework/Versions/4.0/Resources/lib/libRblas.dylib
FALSE LAPACK: /Library/Frameworks/R.framework/Versions/4.0/Resources/lib/libRlapack.dylib
FALSE 
FALSE locale:
FALSE [1] en_CA.UTF-8/en_CA.UTF-8/en_CA.UTF-8/C/en_CA.UTF-8/en_CA.UTF-8
FALSE 
FALSE attached base packages:
FALSE [1] stats     graphics  grDevices utils     datasets  methods   base     
FALSE 
FALSE other attached packages:
FALSE  [1] jofou.lib_0.0.0.9000    modeltime_0.4.1         timetk_2.6.1           
FALSE  [4] yardstick_0.0.7         workflows_0.2.1         tune_0.1.2             
FALSE  [7] rsample_0.0.9           parsnip_0.1.5           modeldata_0.1.0        
FALSE [10] infer_0.5.4             dials_0.0.9             scales_1.1.1           
FALSE [13] broom_0.7.5             tidymodels_0.1.2        recipes_0.1.17         
FALSE [16] doFuture_0.12.0         future_1.21.0           foreach_1.5.1          
FALSE [19] kableExtra_1.3.4        skimr_2.1.2             correlationfunnel_0.2.0
FALSE [22] forcats_0.5.1           stringr_1.4.0           dplyr_1.0.4            
FALSE [25] purrr_0.3.4             readr_1.4.0             tidyr_1.1.2            
FALSE [28] tibble_3.1.0            ggplot2_3.3.3           tidyverse_1.3.0        
FALSE [31] lubridate_1.7.9.2       openxlsx_4.2.3         
FALSE 
FALSE loaded via a namespace (and not attached):
FALSE  [1] colorspace_2.0-0     ellipsis_0.3.2       class_7.3-18        
FALSE  [4] base64enc_0.1-3      fs_1.5.0             rstudioapi_0.13     
FALSE  [7] farver_2.0.3         listenv_0.8.0        furrr_0.2.2         
FALSE [10] prodlim_2019.11.13   fansi_0.4.2          xml2_1.3.2          
FALSE [13] codetools_0.2-18     splines_4.0.4        knitr_1.30          
FALSE [16] jsonlite_1.7.2       pROC_1.17.0.1        dbplyr_2.0.0        
FALSE [19] compiler_4.0.4       httr_1.4.2           backports_1.2.1     
FALSE [22] assertthat_0.2.1     Matrix_1.3-2         fastmap_1.1.0       
FALSE [25] cli_2.3.1            htmltools_0.5.2      tools_4.0.4         
FALSE [28] gtable_0.3.0         glue_1.4.2           Rcpp_1.0.6          
FALSE [31] cellranger_1.1.0     DiceDesign_1.9       vctrs_0.3.6         
FALSE [34] svglite_2.0.0        iterators_1.0.13     timeDate_3043.102   
FALSE [37] gower_0.2.2          xfun_0.26            globals_0.14.0      
FALSE [40] rvest_0.3.6          lifecycle_1.0.0      zoo_1.8-8           
FALSE [43] MASS_7.3-53          ipred_0.9-12         hms_1.0.0           
FALSE [46] parallel_4.0.4       yaml_2.2.1           StanHeaders_2.21.0-7
FALSE [49] rpart_4.1-15         stringi_1.5.3        highr_0.8           
FALSE [52] lhs_1.1.1            zip_2.1.1            lava_1.6.8.1        
FALSE [55] repr_1.1.3           rlang_0.4.11         pkgconfig_2.0.3     
FALSE [58] systemfonts_1.0.1    evaluate_0.14        lattice_0.20-41     
FALSE [61] tidyselect_1.1.0     parallelly_1.23.0    plyr_1.8.6          
FALSE [64] magrittr_2.0.1       R6_2.5.0             generics_0.1.0      
FALSE [67] DBI_1.1.1            pillar_1.5.0         haven_2.3.1         
FALSE [70] withr_2.4.2          xts_0.12.1           survival_3.2-7      
FALSE [73] nnet_7.3-15          modelr_0.1.8         crayon_1.4.1        
FALSE [76] utf8_1.1.4           rmarkdown_2.9        grid_4.0.4          
FALSE [79] readxl_1.3.1         git2r_0.28.0         reprex_0.3.0        
FALSE [82] digest_0.6.27        webshot_0.5.2        RcppParallel_5.0.3  
FALSE [85] munsell_0.5.0        GPfit_1.0-8          viridisLite_0.3.0

Leave a Reply

This site uses Akismet to reduce spam. Learn how your comment data is processed.