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`
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 %>%
    mutate(across(is.logical, as.factor)) %>%
    select(-old_price, -link, -1) %>%
    na.omit() %>%
        
mutate(price = log(price))
## 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))

Explore Data

category

data %>%
    ggplot(aes(category, price)) +
    geom_point()

other colors

data %>%
    ggplot(aes(y = price, x = other_colors)) +
    geom_point()

product height

data %>%
    ggplot(aes(price, height)) +
    geom_point()

product depth

data %>%
    ggplot(aes(price, depth)) +
    geom_point()

product width

data %>%
    ggplot(aes(price, width)) +
    geom_point()

title

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

data_binarized_tbl %>% glimpse()
## Rows: 1,899
## Columns: 82
## $ name__ALGOT                                      <dbl> 0, 0, 0, 0, 0, 0, 0, …
## $ name__BEKANT                                     <dbl> 0, 0, 0, 0, 0, 0, 0, …
## $ name__BESTÅ                                      <dbl> 0, 0, 0, 0, 0, 0, 0, …
## $ `name__BILLY_/_OXBERG`                           <dbl> 0, 0, 0, 0, 0, 0, 0, …
## $ name__BRIMNES                                    <dbl> 0, 0, 0, 0, 0, 0, 0, …
## $ name__BROR                                       <dbl> 0, 0, 0, 0, 0, 0, 0, …
## $ name__EKET                                       <dbl> 0, 0, 0, 0, 0, 0, 0, …
## $ name__GRÖNLID                                    <dbl> 0, 0, 0, 0, 0, 0, 0, …
## $ name__HAVSTA                                     <dbl> 0, 0, 0, 0, 0, 0, 0, …
## $ name__HAVSTEN                                    <dbl> 0, 0, 0, 0, 0, 0, 0, …
## $ name__HEMNES                                     <dbl> 0, 0, 0, 0, 0, 0, 0, …
## $ name__IVAR                                       <dbl> 0, 0, 0, 0, 0, 0, 0, …
## $ name__JONAXEL                                    <dbl> 0, 0, 0, 0, 0, 0, 0, …
## $ name__KALLAX                                     <dbl> 0, 0, 0, 0, 0, 0, 0, …
## $ name__LIDHULT                                    <dbl> 0, 0, 0, 0, 0, 0, 0, …
## $ name__LIXHULT                                    <dbl> 0, 0, 0, 0, 0, 0, 0, …
## $ name__NORDLI                                     <dbl> 0, 0, 0, 0, 0, 0, 0, …
## $ name__PAX                                        <dbl> 0, 0, 0, 0, 0, 0, 0, …
## $ name__PLATSA                                     <dbl> 0, 0, 0, 0, 0, 0, 0, …
## $ `name__STUVA_/_FRITIDS`                          <dbl> 0, 0, 0, 0, 0, 0, 0, …
## $ name__TROFAST                                    <dbl> 0, 0, 0, 0, 0, 0, 0, …
## $ name__VALLENTUNA                                 <dbl> 0, 0, 0, 0, 0, 0, 0, …
## $ name__VIMLE                                      <dbl> 0, 0, 0, 0, 0, 0, 0, …
## $ `name__-OTHER`                                   <dbl> 1, 1, 1, 1, 1, 1, 1, …
## $ 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, …
## $ `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, …
## $ 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, …
# Step 2: Correlate
data_corr_tbl <- data_binarized_tbl %>%
    correlate(price__7.37085996851068_Inf)

data_corr_tbl
## # A tibble: 82 × 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 name     PAX                                     0.302
## 10 category Wardrobes                               0.279
## # ℹ 72 more rows
#Step 3: Plot
data_corr_tbl %>%
    plot_correlation_funnel()
## Warning: ggrepel: 58 unlabeled data points (too many overlaps). Consider
## increasing max.overlaps

Build models

# data <- sample_n(data, 500)

# Split into train and test dataset
set.seed(1234)
data_split <- rsample::initial_split(data)
data_train <- training(data_split)
data_test <- testing(data_split)

# Further split training dataset for cross-validation
set.seed(2345)
data_cv <- rsample::vfold_cv(data_train)
data_cv
## #  10-fold cross-validation 
## # A tibble: 10 × 2
##    splits             id    
##    <list>             <chr> 
##  1 <split [1281/143]> Fold01
##  2 <split [1281/143]> Fold02
##  3 <split [1281/143]> Fold03
##  4 <split [1281/143]> Fold04
##  5 <split [1282/142]> Fold05
##  6 <split [1282/142]> Fold06
##  7 <split [1282/142]> Fold07
##  8 <split [1282/142]> Fold08
##  9 <split [1282/142]> Fold09
## 10 <split [1282/142]> Fold10
library(usemodels)
usemodels::use_ranger(price ~ ., data = data_train)
## ranger_recipe <- 
##   recipe(formula = price ~ ., data = data_train) 
## 
## ranger_spec <- 
##   rand_forest(mtry = tune(), min_n = tune(), trees = 1000) %>% 
##   set_mode("classification") %>% 
##   set_engine("ranger") 
## 
## ranger_workflow <- 
##   workflow() %>% 
##   add_recipe(ranger_recipe) %>% 
##   add_model(ranger_spec) 
## 
## set.seed(41506)
## ranger_tune <-
##   tune_grid(ranger_workflow, resamples = stop("add your rsample object"), grid = stop("add number of candidate points"))
# Specify recipe
ranger_recipe <- 
  recipe(formula = price ~ ., data = data_train) %>% 
   recipes::update_role(item_id, new_role = "id variable") %>%
    step_tokenize(short_description) %>%
    step_tokenfilter(short_description, max_tokens = 100) %>%
    step_tfidf(short_description) %>%
    step_other(designer, name, category) %>%
    step_dummy(designer, name, category, other_colors, sellable_online, one_hot = TRUE) %>%
    step_YeoJohnson(height, width, depth)

ranger_recipe %>%
    prep() %>% juice() %>% glimpse()
## Rows: 1,424
## Columns: 124
## $ item_id                                   <dbl> 19282962, 29320911, 49276549…
## $ depth                                     <dbl> 6.921938, 5.331305, 4.942159…
## $ 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_1                 <dbl> 0.000000, 0.000000, 0.000000…
## $ tfidf_short_description_10                <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ tfidf_short_description_120x40x64         <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ tfidf_short_description_140x200           <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ tfidf_short_description_147x147           <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ tfidf_short_description_150x44x236        <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ tfidf_short_description_150x60x236        <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ 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_200x66x236        <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ tfidf_short_description_25x51x70          <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ 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_41x101            <dbl> 0.0000000, 0.0000000, 0.0000…
## $ tfidf_short_description_41x61             <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ tfidf_short_description_5                 <dbl> 0.0000000, 0.0000000, 0.0000…
## $ tfidf_short_description_50x51x70          <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ tfidf_short_description_6                 <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ tfidf_short_description_60x50x128         <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ tfidf_short_description_61x101            <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ tfidf_short_description_74                <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ tfidf_short_description_75                <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ tfidf_short_description_8                 <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ tfidf_short_description_80x30x202         <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ tfidf_short_description_99x44x56          <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ tfidf_short_description_and               <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_armrest           <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ tfidf_short_description_armrests          <dbl> 0.000000, 0.000000, 0.000000…
## $ 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_box               <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ tfidf_short_description_cabinet           <dbl> 0.0000000, 0.0000000, 0.0000…
## $ tfidf_short_description_cabinets          <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ 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_chaise            <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ tfidf_short_description_changing          <dbl> 0.000000, 0.000000, 0.000000…
## $ tfidf_short_description_chest             <dbl> 0.0000000, 0.0000000, 0.5867…
## $ `tfidf_short_description_children's`      <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ tfidf_short_description_clothes           <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ 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_cover             <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ 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_feet              <dbl> 0.00000, 0.00000, 0.00000, 0…
## $ tfidf_short_description_foldable          <dbl> 0.0000000, 0.0000000, 0.0000…
## $ tfidf_short_description_for               <dbl> 0.0000000, 0.0000000, 0.0000…
## $ 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_highchair         <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ tfidf_short_description_in                <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ tfidf_short_description_inserts           <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ tfidf_short_description_junior            <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ tfidf_short_description_leg               <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ tfidf_short_description_legs              <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ tfidf_short_description_lock              <dbl> 0.0000000, 0.0000000, 0.0000…
## $ tfidf_short_description_longue            <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ tfidf_short_description_mesh              <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_module            <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ 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_panel             <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ tfidf_short_description_plinth            <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ tfidf_short_description_rail              <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ 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_sliding           <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ tfidf_short_description_smart             <dbl> 0.0000000, 0.0000000, 0.0000…
## $ tfidf_short_description_sofa              <dbl> 0.7660576, 0.0000000, 0.0000…
## $ tfidf_short_description_step              <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ 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_top               <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_underframe        <dbl> 0.000000, 0.000000, 0.000000…
## $ tfidf_short_description_unit              <dbl> 0.0000000, 0.0000000, 0.0000…
## $ tfidf_short_description_upright           <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ 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_wire              <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ tfidf_short_description_with              <dbl> 0.0000000, 0.0000000, 0.0000…
## $ designer_IKEA.of.Sweden                   <dbl> 0, 0, 0, 0, 0, 1, 1, 0, 0, 0…
## $ designer_Ola.Wihlborg                     <dbl> 1, 0, 1, 0, 1, 0, 0, 0, 0, 0…
## $ designer_other                            <dbl> 0, 1, 0, 1, 0, 0, 0, 1, 1, 1…
## $ 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…
## $ 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…
## $ other_colors_No                           <dbl> 1, 1, 0, 1, 1, 0, 0, 0, 1, 0…
## $ other_colors_Yes                          <dbl> 0, 0, 1, 0, 0, 1, 1, 1, 0, 1…
## $ sellable_online_FALSE.                    <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ sellable_online_TRUE.                     <dbl> 1, 1, 1, 1, 1, 1, 1, 1, 1, 1…
#Specify model
ranger_spec <- 
  rand_forest(trees = tune()) %>% 
  set_mode("regression") %>% 
  set_engine("ranger") 

# Combine recipe and model using workflow
ranger_workflow <- 
  workflow() %>% 
  add_recipe(ranger_recipe) %>% 
  add_model(ranger_spec) 

# Tune hyperparameters
set.seed(91707)
ranger_tune <-
  tune_grid(ranger_workflow, resamples = data_cv, grid = 5)

Evaluate Models

tune::show_best(ranger_tune, metric = "rmse")
## # A tibble: 5 × 7
##   trees .metric .estimator  mean     n std_err .config             
##   <int> <chr>   <chr>      <dbl> <int>   <dbl> <chr>               
## 1  1346 rmse    standard   0.443    10 0.0101  Preprocessor1_Model2
## 2  1836 rmse    standard   0.444    10 0.0101  Preprocessor1_Model3
## 3  1191 rmse    standard   0.444    10 0.00977 Preprocessor1_Model5
## 4   558 rmse    standard   0.444    10 0.0104  Preprocessor1_Model1
## 5   200 rmse    standard   0.447    10 0.00992 Preprocessor1_Model4
# Update the model by selecting the best hyperparameter
ranger_fw <- tune::finalize_workflow(ranger_workflow,
    tune::select_best(ranger_tune, metric = "rmse"))

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

Make Predictions

The dots are mostly centered around the prediction line. This model would make good predictions.

Changes

I added one_hot = TRUE to the step_dummy function and used rand_forest instead of xgboost. And added “category” to step_other function