Apply1

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 <- ikea %>%
    # Treat missing values
    select(-depth, -link, -...1) %>%
    na.omit() %>%
    
    # Log transform variables with pos-skewed distributions
    mutate(price = log(price))

Identify good predictors

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

# Designer
data %>%
    
    #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")

### Need to figure out how to keep the full name.....first and last name separets....

EDA shortcut

# Step 1:Prepare data
#Select


#take out short description, and keep designer
data_binarize_tbl <- data %>%
    select(-item_id, -short_description) %>%
    binarize()

data_binarize_tbl %>% glimpse()

## Rows: 2,591
## Columns: 74
## $ name__ALGOT                                  <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ 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__BILLY_/_OXBERG`                       <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ name__BRIMNES                                <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ name__BROR                                   <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ name__EKET                                   <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__LIXHULT                                <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__Trolleys                           <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.57972982598622`               <dbl> 1, 0, 1, 1, 0, 1, 1, 1, 0…
## $ price__5.57972982598622_6.45362499889269     <dbl> 0, 0, 0, 0, 1, 0, 0, 0, 1…
## $ price__6.45362499889269_7.34277918933185     <dbl> 0, 1, 0, 0, 0, 0, 0, 0, 0…
## $ price__7.34277918933185_Inf                  <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ old_price__No_old_price                      <dbl> 1, 1, 1, 1, 1, 1, 1, 1, 1…
## $ `old_price__-OTHER`                          <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ sellable_online__1                           <dbl> 1, 0, 1, 1, 1, 1, 1, 1, 1…
## $ `sellable_online__-OTHER`                    <dbl> 0, 1, 0, 0, 0, 0, 0, 0, 0…
## $ other_colors__No                             <dbl> 1, 1, 0, 1, 1, 1, 1, 1, 1…
## $ other_colors__Yes                            <dbl> 0, 0, 1, 0, 0, 0, 0, 0, 0…
## $ designer__Carina_Bengs                       <dbl> 0, 0, 0, 0, 1, 0, 0, 0, 1…
## $ designer__Ebba_Strandmark                    <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ designer__Ehlén_Johansson                    <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ `designer__Ehlén_Johansson/IKEA_of_Sweden`   <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ designer__Francis_Cayouette                  <dbl> 0, 1, 0, 0, 0, 0, 0, 0, 0…
## $ designer__Henrik_Preutz                      <dbl> 0, 0, 1, 0, 0, 0, 0, 0, 0…
## $ designer__IKEA_of_Sweden                     <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ `designer__IKEA_of_Sweden/Ehlén_Johansson`   <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ `designer__IKEA_of_Sweden/Jon_Karlsson`      <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ designer__Johan_Kroon                        <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ designer__Jon_Karlsson                       <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ `designer__K_Hagberg/M_Hagberg`              <dbl> 0, 0, 0, 0, 0, 1, 1, 1, 0…
## $ designer__Marcus_Arvonen                     <dbl> 0, 0, 0, 1, 0, 0, 0, 0, 0…
## $ designer__Nike_Karlsson                      <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ designer__Ola_Wihlborg                       <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ designer__Studio_Copenhagen                  <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ designer__Tord_Björklund                     <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ `designer__-OTHER`                           <dbl> 1, 0, 0, 0, 0, 0, 0, 0, 0…
## $ `height__-Inf_70`                            <dbl> 0, 0, 0, 1, 0, 0, 0, 0, 0…
## $ height__70_83                                <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ height__83_127                               <dbl> 1, 1, 1, 0, 1, 1, 1, 1, 1…
## $ height__127_Inf                              <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ `width__-Inf_60`                             <dbl> 1, 0, 1, 0, 1, 1, 1, 1, 1…
## $ width__60_80                                 <dbl> 0, 1, 0, 1, 0, 0, 0, 0, 0…
## $ width__80_150                                <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ width__150_Inf                               <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0…

# Step 2: Correlate
data_corr_tbl <- data_binarize_tbl %>%
    correlate(price__7.34277918933185_Inf)

data_corr_tbl

## # A tibble: 74 × 3
##    feature  bin                               correlation
##    <fct>    <chr>                                   <dbl>
##  1 price    7.34277918933185_Inf                    1    
##  2 width    150_Inf                                 0.546
##  3 width    -Inf_60                                -0.389
##  4 price    -Inf_5.57972982598622                  -0.334
##  5 price    6.45362499889269_7.34277918933185      -0.333
##  6 price    5.57972982598622_6.45362499889269      -0.332
##  7 category Sofas_&_armchairs                       0.317
##  8 height   -Inf_70                                -0.299
##  9 name     PAX                                     0.279
## 10 category Wardrobes                               0.267
## # ℹ 64 more rows

# Step 3: Plot
data_corr_tbl %>%
    plot_correlation_funnel()

## Warning: ggrepel: 53 unlabeled data points (too many overlaps). Consider
## increasing max.overlaps