Goal: predict the prices of IKEA items Click here for the data

#Import Data

ikea <- read_csv('https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/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`

Explore Data

skimr::skim(ikea)
Data summary
Name ikea
Number of rows 3694
Number of columns 14
_______________________
Column type frequency:
character 7
logical 1
numeric 6
________________________
Group variables None

Variable type: character

skim_variable n_missing complete_rate min max empty n_unique whitespace
name 0 1 3 27 0 607 0
category 0 1 4 36 0 17 0
old_price 0 1 4 13 0 365 0
link 0 1 52 163 0 2962 0
other_colors 0 1 2 3 0 2 0
short_description 0 1 3 63 0 1706 0
designer 0 1 3 1261 0 381 0

Variable type: logical

skim_variable n_missing complete_rate mean count
sellable_online 0 1 0.99 TRU: 3666, FAL: 28

Variable type: numeric

skim_variable n_missing complete_rate mean sd p0 p25 p50 p75 p100 hist
…1 0 1.00 1846.50 1066.51 0 923.25 1846.5 2769.75 3693 ▇▇▇▇▇
item_id 0 1.00 48632396.79 28887094.10 58487 20390574.00 49288078.0 70403572.75 99932615 ▇▇▇▇▇
price 0 1.00 1078.21 1374.65 3 180.90 544.7 1429.50 9585 ▇▁▁▁▁
depth 1463 0.60 54.38 29.96 1 38.00 47.0 60.00 257 ▇▃▁▁▁
height 988 0.73 101.68 61.10 1 67.00 83.0 124.00 700 ▇▂▁▁▁
width 589 0.84 104.47 71.13 1 60.00 80.0 140.00 420 ▇▅▂▁▁ 
data <- ikea %>%
    
    # Treating missing values
    select(-depth, -height, -width, -old_price, -link, -designer) %>%
    na.omit() %>%
    
    # Log Transformation variables with positive skewed distribution
     mutate(price = log(price))

Identify good predictors:

category

data %>%
    ggplot(aes(price, as.factor(category))) +
    geom_boxplot()

short_description

data %>%
    
    # tokenize description
    unnest_tokens(output = word, input = short_description) %>%
    
    # calculate avg word per item
    group_by(word) %>%
    summarise(price = mean(price),
              n = n()) %>%
    
    ungroup() %>%
    
    filter(n > 10) %>%
    slice_max(order_by = price, n = 20) %>%

    # Plot
    ggplot(aes(price, fct_reorder(word, price))) +
        geom_point()

 # Step 1: Prepare data
data_binarized_tbl <- data %>%
    select(-item_id, -short_description, -...1) %>%
    binarize()

data_binarized_tbl %>% glimpse()
## Rows: 3,694
## Columns: 41
## $ name__BEKANT                                 <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ name__BESTÅ                                  <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ name__EKET                                   <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ name__ELVARLI                                <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ name__GRÖNLID                                <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ name__HAVSTA                                 <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ name__HEMNES                                 <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ name__IVAR                                   <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ name__JONAXEL                                <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ name__KALLAX                                 <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ name__LIDHULT                                <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ name__NORDLI                                 <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ name__PAX                                    <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ name__PLATSA                                 <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ `name__STUVA_/_FRITIDS`                      <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ name__TROFAST                                <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ name__VALLENTUNA                             <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ name__VIMLE                                  <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ `name__-OTHER`                               <dbl> 1, 1, 1, 1, 1, 1, 1, 1, 1…
## $ category__Bar_furniture                      <dbl> 1, 1, 1, 1, 1, 1, 1, 1, 1…
## $ category__Beds                               <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ `category__Bookcases_&_shelving_units`       <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ `category__Cabinets_&_cupboards`             <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ category__Chairs                             <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ `category__Chests_of_drawers_&_drawer_units` <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ `category__Children's_furniture`             <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ category__Nursery_furniture                  <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ category__Outdoor_furniture                  <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ `category__Sofas_&_armchairs`                <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ `category__Tables_&_desks`                   <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ `category__TV_&_media_furniture`             <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ category__Wardrobes                          <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ `category__-OTHER`                           <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ `price__-Inf_5.19790750771426`               <dbl> 0, 0, 0, 1, 0, 0, 1, 0, 1…
## $ price__5.19790750771426_6.30023503272028     <dbl> 1, 0, 0, 0, 1, 1, 0, 1, 0…
## $ price__6.30023503272028_7.26507835784303     <dbl> 0, 1, 0, 0, 0, 0, 0, 0, 0…
## $ price__7.26507835784303_Inf                  <dbl> 0, 0, 1, 0, 0, 0, 0, 0, 0…
## $ sellable_online__1                           <dbl> 1, 0, 0, 1, 1, 1, 1, 1, 1…
## $ `sellable_online__-OTHER`                    <dbl> 0, 1, 1, 0, 0, 0, 0, 0, 0…
## $ other_colors__No                             <dbl> 1, 1, 1, 0, 1, 1, 1, 1, 1…
## $ other_colors__Yes                            <dbl> 0, 0, 0, 1, 0, 0, 0, 0, 0…
 # Step 2: Correlate
data_corr_tbl <- data_binarized_tbl %>%
    correlate(price__7.26507835784303_Inf)

data_corr_tbl
## # A tibble: 41 × 3
##    feature  bin                               correlation
##    <fct>    <chr>                                   <dbl>
##  1 price    7.26507835784303_Inf                    1    
##  2 price    -Inf_5.19790750771426                  -0.334
##  3 price    6.30023503272028_7.26507835784303      -0.333
##  4 price    5.19790750771426_6.30023503272028      -0.333
##  5 category Wardrobes                               0.253
##  6 name     PAX                                     0.250
##  7 category Sofas_&_armchairs                       0.178
##  8 name     -OTHER                                 -0.167
##  9 category Bookcases_&_shelving_units             -0.162
## 10 name     LIDHULT                                 0.143
## # ℹ 31 more rows
 # Step 3: Plot
data_corr_tbl %>%
    plot_correlation_funnel()
## Warning: ggrepel: 31 unlabeled data points (too many overlaps). Consider
## increasing max.overlaps