Goal: To predict the the price of IKEA furniture Click here for the data

Import data

ikea <- readr::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_ikea1 <- ikea %>%
    # Treat missing values
    select(-old_price, -link, -...1, -designer) %>%
    na.omit() %>%
    
    # Log transform variables with pos-skewed distributions
    mutate(price = log(price)) %>%
    mutate(across(is.logical, as.factor))
## Warning: There was 1 warning in `mutate()`.
## ℹ In argument: `across(is.logical, as.factor)`.
## Caused by warning:
## ! Use of bare predicate functions was deprecated in tidyselect 1.1.0.
## ℹ Please use wrap predicates in `where()` instead.
##   # Was:
##   data %>% select(is.logical)
## 
##   # Now:
##   data %>% select(where(is.logical))

Identify good predictors

# Category
data_ikea1 %>% 
    ggplot(aes(price, category)) +
    geom_boxplot()

# Designer
data_ikea1 %>%
    
    #tokenize title
    unnest_tokens(output = word, input = short_description) %>%
    
    # calculate avg rent per word
    group_by(word) %>%
    summarise(price = mean(price),
              n = n()) %>%
    ungroup() %>%
    
    filter(n > 10, !str_detect(word, "\\d")) %>%
    slice_max(order_by = price, n = 10) %>%
    
    # Plot
    ggplot(aes(price, fct_reorder(word, price))) +
    geom_point() +
    
    labs(y = "Producsts")

EDA shortcut

# Step 1:Prepare data
#Select


#take out short description, and keep designer
binarized_table <- data_ikea1 %>%
    select(price, height, width, depth, sellable_online, category, other_colors) %>%
    binarize()

binarized_table %>% glimpse()
## Rows: 1,899
## Columns: 35
## $ `price__-Inf_5.68697535633982`                   <dbl> 1, 1, 0, 1, 1, 1, 0, …
## $ price__5.68697535633982_6.52209279817015         <dbl> 0, 0, 1, 0, 0, 0, 1, …
## $ price__6.52209279817015_7.37085996851068         <dbl> 0, 0, 0, 0, 0, 0, 0, …
## $ price__7.37085996851068_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, …
## $ `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, …
## $ sellable_online__TRUE                            <dbl> 1, 1, 1, 1, 1, 1, 1, …
## $ `sellable_online__-OTHER`                        <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, …
## $ other_colors__No                                 <dbl> 0, 1, 1, 1, 1, 1, 1, …
## $ other_colors__Yes                                <dbl> 1, 0, 0, 0, 0, 0, 0, …
# Step 2: Correlate
corr_tbl <- binarized_table %>%
    correlate(price__7.37085996851068_Inf)

corr_tbl
## # A tibble: 35 × 3
##    feature  bin                               correlation
##    <fct>    <chr>                                   <dbl>
##  1 price    7.37085996851068_Inf                    1    
##  2 width    161.5_Inf                               0.579
##  3 depth    60_Inf                                  0.447
##  4 category Sofas_&_armchairs                       0.379
##  5 width    -Inf_60                                -0.374
##  6 price    -Inf_5.68697535633982                  -0.336
##  7 price    6.52209279817015_7.37085996851068      -0.333
##  8 price    5.68697535633982_6.52209279817015      -0.331
##  9 category Wardrobes                               0.279
## 10 height   -Inf_71                                -0.277
## # ℹ 25 more rows
# Step 3: Plot
## Label only strong correlations
corr_tbl %>%
    filter(abs(correlation) > 0.3) %>%  
    plot_correlation_funnel()

Build models

Split data

data_ikea2 <- data_ikea1 %>%
    select(-other_colors)
# Split into train and test data set
set.seed(1234)
ikea_split <- rsample::initial_split(data_ikea2, prop = 0.75)
ikea_train <- training(ikea_split)
ikea_test <- testing(ikea_split)
# Specify recipe
ikea_recipe <- recipe(price ~ ., data = ikea_train) %>%
    update_role(item_id, new_role = "id variable") %>%
    step_tokenize(short_description) %>%
    step_tokenfilter(short_description, max_tokens = 50) %>%
    step_tfidf(short_description) %>%
    step_other(category, name, sellable_online) %>%
    step_dummy(category, name, sellable_online, one_hot = TRUE) %>%
    step_YeoJohnson(width, height) %>%
    step_impute_knn(all_predictors())

ikea_recipe %>% prep() %>% juice() %>% glimpse()
## Rows: 1,424
## Columns: 69
## $ item_id                                   <dbl> 19282962, 29320911, 49276549…
## $ depth                                     <dbl> 151, 60, 47, 52, 47, 47, 44,…
## $ height                                    <dbl> 12.95187, 21.33670, 14.11837…
## $ width                                     <dbl> 9.034855, 7.442056, 5.426853…
## $ price                                     <dbl> 7.595890, 7.833996, 6.429719…
## $ tfidf_short_description_150x66x236        <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ tfidf_short_description_2                 <dbl> 0.8840660, 0.0000000, 0.5304…
## $ tfidf_short_description_3                 <dbl> 0.0000000, 0.0000000, 0.0000…
## $ tfidf_short_description_4                 <dbl> 0.000000, 0.000000, 0.000000…
## $ tfidf_short_description_6                 <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ tfidf_short_description_armchair          <dbl> 0.000000, 0.000000, 0.000000…
## $ tfidf_short_description_armrests          <dbl> 0.00000, 0.00000, 0.00000, 0…
## $ tfidf_short_description_backrest          <dbl> 0.0000000, 0.0000000, 0.0000…
## $ tfidf_short_description_bar               <dbl> 0.0000000, 0.0000000, 0.0000…
## $ tfidf_short_description_baskets           <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ tfidf_short_description_bed               <dbl> 0.0000000, 0.0000000, 0.0000…
## $ tfidf_short_description_bench             <dbl> 0.000000, 0.000000, 0.000000…
## $ tfidf_short_description_bookcase          <dbl> 0.000000, 0.000000, 0.000000…
## $ tfidf_short_description_cabinet           <dbl> 0.0000000, 0.0000000, 0.0000…
## $ tfidf_short_description_castors           <dbl> 0.000000, 0.000000, 0.000000…
## $ tfidf_short_description_chair             <dbl> 0.0000000, 0.0000000, 0.0000…
## $ tfidf_short_description_chest             <dbl> 0.0000000, 0.0000000, 0.5867…
## $ tfidf_short_description_cm                <dbl> 0.0000000, 0.2905183, 0.1743…
## $ tfidf_short_description_combination       <dbl> 0.0000000, 0.6909039, 0.0000…
## $ tfidf_short_description_corner            <dbl> 0.000000, 0.000000, 0.000000…
## $ tfidf_short_description_desk              <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ tfidf_short_description_door              <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ tfidf_short_description_doors             <dbl> 0.0000000, 0.0000000, 0.0000…
## $ tfidf_short_description_drawer            <dbl> 0.0000000, 0.0000000, 0.0000…
## $ tfidf_short_description_drawers           <dbl> 0.0000000, 0.0000000, 0.5004…
## $ tfidf_short_description_for               <dbl> 0.000000, 0.000000, 0.000000…
## $ tfidf_short_description_frame             <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ tfidf_short_description_glass             <dbl> 0.0000000, 0.0000000, 0.0000…
## $ tfidf_short_description_in                <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ tfidf_short_description_modular           <dbl> 0.0000000, 0.0000000, 0.0000…
## $ tfidf_short_description_mounted           <dbl> 0.0000000, 0.0000000, 0.0000…
## $ tfidf_short_description_of                <dbl> 0.0000000, 0.0000000, 0.5753…
## $ tfidf_short_description_on                <dbl> 0.0000000, 0.0000000, 0.0000…
## $ tfidf_short_description_outdoor           <dbl> 0.000000, 0.000000, 0.000000…
## $ tfidf_short_description_seat              <dbl> 0.7549716, 0.0000000, 0.0000…
## $ tfidf_short_description_section           <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ tfidf_short_description_sections          <dbl> 0.000000, 0.000000, 0.000000…
## $ tfidf_short_description_shelf             <dbl> 0.000000, 0.000000, 0.000000…
## $ tfidf_short_description_shelves           <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ tfidf_short_description_shelving          <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ tfidf_short_description_sofa              <dbl> 0.7660576, 0.0000000, 0.0000…
## $ tfidf_short_description_stool             <dbl> 0.0000000, 0.0000000, 0.0000…
## $ tfidf_short_description_storage           <dbl> 0.0000000, 0.0000000, 0.0000…
## $ tfidf_short_description_table             <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ tfidf_short_description_tv                <dbl> 0.000000, 0.000000, 0.000000…
## $ tfidf_short_description_unit              <dbl> 0.0000000, 0.0000000, 0.0000…
## $ tfidf_short_description_w                 <dbl> 0.0000000, 0.0000000, 0.0000…
## $ tfidf_short_description_wall              <dbl> 0.0000000, 0.0000000, 0.0000…
## $ tfidf_short_description_wardrobe          <dbl> 0.0000000, 0.7815769, 0.0000…
## $ tfidf_short_description_with              <dbl> 0.0000000, 0.0000000, 0.0000…
## $ category_Bookcases...shelving.units       <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 1…
## $ category_Cabinets...cupboards             <dbl> 0, 0, 0, 0, 0, 1, 0, 1, 0, 0…
## $ category_Chairs                           <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ category_Chests.of.drawers...drawer.units <dbl> 0, 0, 1, 0, 1, 0, 1, 0, 1, 0…
## $ category_Sofas...armchairs                <dbl> 1, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ category_Tables...desks                   <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ category_TV...media.furniture             <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ category_Wardrobes                        <dbl> 0, 1, 0, 0, 0, 0, 0, 0, 0, 0…
## $ category_other                            <dbl> 0, 0, 0, 1, 0, 0, 0, 0, 0, 0…
## $ name_BESTÅ                                <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ name_PAX                                  <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ name_other                                <dbl> 1, 1, 1, 1, 1, 1, 1, 1, 1, 1…
## $ sellable_online_TRUE.                     <dbl> 1, 1, 1, 1, 1, 1, 1, 1, 1, 1…
## $ sellable_online_other                     <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
# Specify model
xgboost_spec <- 
  boost_tree(trees = tune(), min_n = tune(), mtry = tune(), learn_rate = tune()) %>% 
  set_mode("regression") %>% 
  set_engine("xgboost") 

# Combine recipe and model using workflow
xgboost_workflow <- 
  workflow() %>% 
  add_recipe(ikea_recipe) %>% 
  add_model(xgboost_spec) 

# Create cross-validation folds
set.seed(2345)
ikea_cv <- vfold_cv(ikea_train, v = 5)

# Tune hyperperameters
set.seed(3456)
xgboost_tune <-
  tune_grid(xgboost_workflow, 
            resamples = ikea_cv, 
            grid = 2)
## i Creating pre-processing data to finalize unknown parameter: mtry

Evaluate models

tune::show_best(xgboost_tune, metric = "rmse")
## # A tibble: 2 × 10
##    mtry trees min_n learn_rate .metric .estimator  mean     n std_err .config   
##   <int> <int> <int>      <dbl> <chr>   <chr>      <dbl> <int>   <dbl> <chr>     
## 1    23  1420    15     0.0251 rmse    standard   0.416     5  0.0170 Preproces…
## 2    60   502    22     0.0118 rmse    standard   0.468     5  0.0173 Preproces…
# Update de model by selecting the best hyperparameter
xgboost_fw <- tune::finalize_workflow(xgboost_workflow,
                        tune::select_best(xgboost_tune, metric = "rmse"))

# Fit the model on the entire training data and test it on the test data
ikea_fit <- tune::last_fit(xgboost_fw, ikea_split)
tune::collect_metrics(ikea_fit)
## # A tibble: 2 × 4
##   .metric .estimator .estimate .config             
##   <chr>   <chr>          <dbl> <chr>               
## 1 rmse    standard       0.358 Preprocessor1_Model1
## 2 rsq     standard       0.917 Preprocessor1_Model1
tune::collect_predictions(ikea_fit) %>%
    ggplot(aes(price, .pred)) +
    geom_point(alpha = 0.3, fill = "midnightblue") +
    geom_abline(lty = 2, color = "gray50") +
    coord_fixed()

Make predictions