Apply 4
Bella Kalinyak
2024-10-03
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)| 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
Description
data %>%
tidytext::unnest_tokens(word, short_description) %>%
anti_join(stop_words) %>%
group_by(word) %>%
summarise(
n = n(),
avg_price = mean(price)
) %>%
# Filter out rare words
filter(n >= 40, !word %>% str_detect("\\d")) %>%
# Plot
ggplot(aes(n, avg_price)) +
geom_hline(
yintercept = mean(data$price), lty = 2,
color = "gray50", size = 1.5
) +
geom_jitter(color = "midnightblue", alpha = 0.7) +
geom_text(aes(label = word),
check_overlap = TRUE, family = "IBMPlexSans",
vjust = "top", hjust = "left"
) +
scale_x_log10() ## Joining with `by = join_by(word)`## Warning: Using `size` aesthetic for lines was deprecated in ggplot2 3.4.0.
## ℹ Please use `linewidth` instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.## Warning in grid.Call.graphics(C_text, as.graphicsAnnot(x$label), x$x, x$y, :
## font family not found in Windows font database
title
# Step 1: Prepare data
data_binarized_tbl <- data %>%
select(-item_id, -short_description,) %>%
binarize
data_binarized_tbl <- data %>%
# Add desc dummy
mutate(sofa = str_detect(short_description, "sofa")) %>%
mutate(chair = str_detect(short_description, "chair")) %>%
select(-item_id, -short_description,) %>%
binarize
data_binarized_tbl %>% glimpse()## Rows: 1,899
## Columns: 86
## $ 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, …
## $ sofa__0 <dbl> 1, 1, 1, 1, 1, 1, 1, …
## $ sofa__1 <dbl> 0, 0, 0, 0, 0, 0, 0, …
## $ chair__0 <dbl> 1, 1, 1, 1, 1, 1, 1, …
## $ chair__1 <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: 86 × 3
## feature bin correlation
## <fct> <chr> <dbl>
## 1 price 7.37085996851068_Inf 1
## 2 width 161.5_Inf 0.579
## 3 sofa 0 -0.517
## 4 sofa 1 0.517
## 5 depth 60_Inf 0.447
## 6 category Sofas_&_armchairs 0.379
## 7 width -Inf_60 -0.374
## 8 price -Inf_5.68697535633982 -0.336
## 9 price 6.52209279817015_7.37085996851068 -0.333
## 10 price 5.68697535633982_6.52209279817015 -0.331
## # ℹ 76 more rows#Step 3: Plot
data_corr_tbl %>%
plot_correlation_funnel()## Warning: ggrepel: 58 unlabeled data points (too many overlaps). Consider
## increasing max.overlaps