library(tidyverse)
## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr     1.1.4     ✔ readr     2.1.6
## ✔ forcats   1.0.1     ✔ stringr   1.6.0
## ✔ ggplot2   4.0.2     ✔ tibble    3.3.1
## ✔ lubridate 1.9.4     ✔ tidyr     1.3.2
## ✔ purrr     1.2.1     
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag()    masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors
library(correlationfunnel)
## ══ correlationfunnel Tip #2 ════════════════════════════════════════════════════
## Clean your NA's prior to using `binarize()`.
## Missing values and cleaning data are critical to getting great correlations. :)
data <- read_csv('https://raw.githubusercontent.com/rfordatascience/tidytuesday/main/data/2020/2020-11-03/ikea.csv')
## New names:
## Rows: 3694 Columns: 14
## ── Column specification
## ──────────────────────────────────────────────────────── Delimiter: "," chr
## (7): name, category, old_price, link, other_colors, short_description, d... dbl
## (6): ...1, item_id, price, depth, height, width lgl (1): sellable_online
## ℹ Use `spec()` to retrieve the full column specification for this data. ℹ
## Specify the column types or set `show_col_types = FALSE` to quiet this message.
## • `` -> `...1`

Issues with data

factors_vec <- data %>% 
  select(category, sellable_online, other_colors, designer) %>% 
  names()

data_clean <- data %>%
  
  # Convert categorical variables to factors
  mutate(across(all_of(factors_vec), as.factor)) %>%
  
  # Drop columns not useful for modeling
  select(-link, -name, -short_description, -item_id)

Explore data

data_clean %>% count(category)
## # A tibble: 17 × 2
##    category                                 n
##    <fct>                                <int>
##  1 Bar furniture                           47
##  2 Beds                                   208
##  3 Bookcases & shelving units             548
##  4 Cabinets & cupboards                   292
##  5 Café furniture                          26
##  6 Chairs                                 481
##  7 Chests of drawers & drawer units       125
##  8 Children's furniture                   124
##  9 Nursery furniture                       97
## 10 Outdoor furniture                      216
## 11 Room dividers                           13
## 12 Sideboards, buffets & console tables    23
## 13 Sofas & armchairs                      428
## 14 Tables & desks                         612
## 15 Trolleys                                28
## 16 TV & media furniture                   190
## 17 Wardrobes                              236
data_clean %>%
  ggplot(aes(category)) +
  geom_bar() +
  coord_flip()

data_clean %>%
  ggplot(aes(category, price)) +
  geom_boxplot() +
  coord_flip()

# step 1: binarizes
data_model <- data_clean %>%
  drop_na(depth, height, width)

# step 2: correlation
data_binarized <- data_model %>%
  select(-price) %>%
  binarize() %>%
  bind_cols(price = data_model$price)
## New names:
## • `...1__-Inf_799.5` -> `...1`
## • `...1__799.5_1653` -> `...2`
## • `...1__1653_2474.5` -> `...3`
## • `...1__2474.5_Inf` -> `...4`
data_binarized %>% glimpse()
## Rows: 1,899
## Columns: 61
## $ ...1                                             <dbl> 1, 1, 1, 1, 1, 1, 1, …
## $ ...2                                             <dbl> 0, 0, 0, 0, 0, 0, 0, …
## $ ...3                                             <dbl> 0, 0, 0, 0, 0, 0, 0, …
## $ ...4                                             <dbl> 0, 0, 0, 0, 0, 0, 0, …
## $ category__Bar_furniture                          <dbl> 1, 1, 1, 1, 1, 1, 1, …
## $ category__Beds                                   <dbl> 0, 0, 0, 0, 0, 0, 0, …
## $ `category__Bookcases_&_shelving_units`           <dbl> 0, 0, 0, 0, 0, 0, 0, …
## $ `category__Cabinets_&_cupboards`                 <dbl> 0, 0, 0, 0, 0, 0, 0, …
## $ category__Chairs                                 <dbl> 0, 0, 0, 0, 0, 0, 0, …
## $ `category__Chests_of_drawers_&_drawer_units`     <dbl> 0, 0, 0, 0, 0, 0, 0, …
## $ `category__Children's_furniture`                 <dbl> 0, 0, 0, 0, 0, 0, 0, …
## $ category__Nursery_furniture                      <dbl> 0, 0, 0, 0, 0, 0, 0, …
## $ category__Outdoor_furniture                      <dbl> 0, 0, 0, 0, 0, 0, 0, …
## $ `category__Sideboards,_buffets_&_console_tables` <dbl> 0, 0, 0, 0, 0, 0, 0, …
## $ `category__Sofas_&_armchairs`                    <dbl> 0, 0, 0, 0, 0, 0, 0, …
## $ `category__Tables_&_desks`                       <dbl> 0, 0, 0, 0, 0, 0, 0, …
## $ `category__TV_&_media_furniture`                 <dbl> 0, 0, 0, 0, 0, 0, 0, …
## $ category__Wardrobes                              <dbl> 0, 0, 0, 0, 0, 0, 0, …
## $ `category__-OTHER`                               <dbl> 0, 0, 0, 0, 0, 0, 0, …
## $ old_price__No_old_price                          <dbl> 1, 1, 1, 1, 1, 1, 1, …
## $ `old_price__-OTHER`                              <dbl> 0, 0, 0, 0, 0, 0, 0, …
## $ sellable_online__TRUE                            <dbl> 1, 1, 1, 1, 1, 1, 1, …
## $ `sellable_online__-OTHER`                        <dbl> 0, 0, 0, 0, 0, 0, 0, …
## $ other_colors__No                                 <dbl> 0, 1, 1, 1, 1, 1, 1, …
## $ other_colors__Yes                                <dbl> 1, 0, 0, 0, 0, 0, 0, …
## $ designer__Andreas_Fredriksson                    <dbl> 0, 0, 0, 0, 0, 0, 0, …
## $ designer__Carina_Bengs                           <dbl> 0, 0, 1, 0, 0, 0, 1, …
## $ designer__Carl_Öjerstam                          <dbl> 0, 0, 0, 0, 0, 0, 0, …
## $ designer__Ebba_Strandmark                        <dbl> 0, 0, 0, 0, 0, 0, 0, …
## $ designer__Ehlén_Johansson                        <dbl> 0, 0, 0, 0, 0, 0, 0, …
## $ `designer__Ehlén_Johansson/IKEA_of_Sweden`       <dbl> 0, 0, 0, 0, 0, 0, 0, …
## $ designer__Eva_Lilja_Löwenhielm                   <dbl> 0, 0, 0, 0, 0, 0, 0, …
## $ designer__Francis_Cayouette                      <dbl> 0, 0, 0, 0, 0, 0, 0, …
## $ designer__Gillis_Lundgren                        <dbl> 0, 0, 0, 0, 0, 0, 0, …
## $ designer__Henrik_Preutz                          <dbl> 1, 0, 0, 0, 0, 0, 0, …
## $ designer__IKEA_of_Sweden                         <dbl> 0, 0, 0, 0, 0, 0, 0, …
## $ `designer__IKEA_of_Sweden/Ehlén_Johansson`       <dbl> 0, 0, 0, 0, 0, 0, 0, …
## $ `designer__IKEA_of_Sweden/Jon_Karlsson`          <dbl> 0, 0, 0, 0, 0, 0, 0, …
## $ designer__Johan_Kroon                            <dbl> 0, 0, 0, 0, 0, 0, 0, …
## $ designer__Jon_Karlsson                           <dbl> 0, 0, 0, 0, 0, 0, 0, …
## $ `designer__Jon_Karlsson/IKEA_of_Sweden`          <dbl> 0, 0, 0, 0, 0, 0, 0, …
## $ `designer__K_Hagberg/M_Hagberg`                  <dbl> 0, 0, 0, 1, 1, 1, 0, …
## $ designer__Mia_Lagerman                           <dbl> 0, 0, 0, 0, 0, 0, 0, …
## $ designer__Nike_Karlsson                          <dbl> 0, 0, 0, 0, 0, 0, 0, …
## $ designer__Ola_Wihlborg                           <dbl> 0, 0, 0, 0, 0, 0, 0, …
## $ designer__Studio_Copenhagen                      <dbl> 0, 0, 0, 0, 0, 0, 0, …
## $ designer__Tord_Björklund                         <dbl> 0, 0, 0, 0, 0, 0, 0, …
## $ `designer__-OTHER`                               <dbl> 0, 1, 0, 0, 0, 0, 0, …
## $ `depth__-Inf_40`                                 <dbl> 0, 0, 0, 0, 0, 0, 0, …
## $ depth__40_47                                     <dbl> 0, 0, 1, 1, 1, 1, 1, …
## $ depth__47_60                                     <dbl> 1, 1, 0, 0, 0, 0, 0, …
## $ depth__60_Inf                                    <dbl> 0, 0, 0, 0, 0, 0, 0, …
## $ `height__-Inf_71`                                <dbl> 0, 1, 0, 0, 0, 0, 0, …
## $ height__71_92                                    <dbl> 0, 0, 1, 0, 0, 0, 0, …
## $ height__92_171                                   <dbl> 1, 0, 0, 1, 1, 1, 1, …
## $ height__171_Inf                                  <dbl> 0, 0, 0, 0, 0, 0, 0, …
## $ `width__-Inf_60`                                 <dbl> 1, 0, 1, 1, 1, 1, 1, …
## $ width__60_93                                     <dbl> 0, 1, 0, 0, 0, 0, 0, …
## $ width__93_161.5                                  <dbl> 0, 0, 0, 0, 0, 0, 0, …
## $ width__161.5_Inf                                 <dbl> 0, 0, 0, 0, 0, 0, 0, …
## $ price                                            <dbl> 69, 225, 345, 129, 12…
# step 3: correlation
data_correlation <- data_binarized %>%
  correlate(price)
## Warning: Expected 2 pieces. Missing pieces filled with `NA` in 5 rows [1, 2, 3,
## 4, 61].
# step 4: plot
data_correlation %>%
  correlationfunnel::plot_correlation_funnel()
## Warning: The `size` argument of `element_line()` is deprecated as of ggplot2 3.4.0.
## ℹ Please use the `linewidth` argument instead.
## ℹ The deprecated feature was likely used in the correlationfunnel package.
##   Please report the issue at
##   <https://github.com/business-science/correlationfunnel/issues>.
## This warning is displayed once per session.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.
## Warning: The `size` argument of `element_rect()` is deprecated as of ggplot2 3.4.0.
## ℹ Please use the `linewidth` argument instead.
## ℹ The deprecated feature was likely used in the correlationfunnel package.
##   Please report the issue at
##   <https://github.com/business-science/correlationfunnel/issues>.
## This warning is displayed once per session.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.
## Warning: Removed 5 rows containing missing values or values outside the scale range
## (`geom_text_repel()`).
## Warning: ggrepel: 35 unlabeled data points (too many overlaps). Consider
## increasing max.overlaps