Classification of knitting patterns

Knitting patterns for sale on Ravelry are accompanied by a text description going from a few words to a full page story in several languages. This text sometimes includes instructions about knitting techniques, a personal background story, or a reference to a larger collection of patterns by the same designer. This post looks how reliably one can predict the pattern category (hat, sweater, scarf …) from the text of the pattern.

We first build a dataset using Ravelry database queries and web scraping. This will consist in a data frame with pattern names, their text descriptions, and their category: hat, sweater etc.


## Build dataset from Ravelry API: pattern permalink, pattern category, pattern text description
# Get url to patterns of interest from API search
pat0 <- GET("https://api.ravelry.com/patterns/search.json?page_size=2000&craft=knitting", config=config("token"=ravelry.token))
pat <- content(pat0)

permalinks <- sapply(pat$patterns, function(x) x$permalink)
permalinks_full <- sapply(permalinks, function(name) paste("http://www.ravelry.com/patterns/library/",name,sep="",collapse=""))
names(permalinks_full) <- permalinks

# Get top level pattern category and description text using web scraping 
pattern_info <- lapply(permalinks_full, htmlTreeParse, useInternalNodes = TRUE)

pattern_description_par <- lapply(pattern_info, getNodeSet, path="//p", fun=xmlValue)
pattern_description <- sapply(pattern_description_par, paste, collapse=" ")

pattern_cat <- lapply(pattern_info, getNodeSet, path="//div[@class='category']/a/span/text()", fun=xmlValue)
pattern_topcat <- simplify2array(sapply(pattern_cat, head, 1))

Some pattern categories appear quite rarely, and may be not frequent enough to get a decent accuracy on prediction. We can filter out the corresponding  entries to get cleaner data.


## Data: 3 columns with pattern permalink, text description, and toplevel category
data <- as.data.frame(cbind(permalinks, pattern_topcat, pattern_description),stringsAsFactors=F,row.names=F)
names(data) <- c("permalink", "category", "description")
data$category <- as.factor(data$category)

cat_freq <- table(data$category)
nbr_examples <- dim(data)[1]

# Remove from data the categories with too few examples 
data <- subset(data, subset=(cat_freq[category] > 50))
data$category <- factor(data$category)

The following R functions are quite useful to prepare the data for text mining. In order to predict a pattern category from its text, we look at the frequencies of words in each text for each category, and use these numbers for prediction. For example, a description in which the word “head” appears several times is more likely to be for a hat than a sock.

The first function removes the punctuation, numbers, and stopwords (“the”, “a” …) that appear very often in all text but do not carry enough meaning to help prediction. It returns a clean corpus of texts where each document corresponds to a cleaned up pattern description.

The second function builds the Document Term Matrix (DTM), an object that holds for each document the frequencies of all the words in it. The columns are all the words in the corpus, and the lines are all the documents in the corpus (pattern descriptions). This DTM will be the dataset for running the algorithms, with words being the features, and text descriptions being the cases.

The third function wraps it all together to turn the data frame into a ready to use dataset.



cleanCorpus = function(corpus){
  # Clean the text data to remove punctuation, suffixes, numbers etc
  # To lowercase
  corpus <- tm_map(corpus, content_transformer(tolower))
  # Remove stopwords first, else for ex. l'or becomes lor and l' is not removed
  corpus <- tm_map(corpus, removeWords, stopwords("english"))
  # Remove punctuation
  corpus <- tm_map(corpus, removePunctuation)
  corpus <- tm_map(corpus, content_transformer(function(str) gsub("[^[:alnum:] ]", " ",str)))
  # Remove  html tags with regexp
  corpus <- tm_map(corpus, content_transformer(function(x) gsub("<[a-z]*>", " ", x)))
  # Remove numbers - but they may be useful ... TODO ?
  corpus <- tm_map(corpus, removeNumbers)
  # Simplify whitespace
  corpus <- tm_map(corpus, stripWhitespace)
  # Stem words (tm_map stem has type error), use option lazy=T on mac os
  corpus <- tm_map(corpus, stemDocument, "english", lazy=T)
}

buildData = function(corpus, sparsity=0.999){
  # Arg: corpus where one document is one pattern description
  #      optionnal float word sparsity threshold 
  #      default: remove (almost) nothing
  # Returns Document Term Matrix
  dtm <- DocumentTermMatrix(corpus, 
                            control = list(weighting = weightTfIdf))
  # remove words that don't appear often enough for every category, else weird words and very large matrix
  dtm <- removeSparseTerms(dtm, sparsity)
}

prepareData <- function(df){
  # make clean cases and outcome based on text/category data frame
  corpus <- Corpus(VectorSource(df$description))
  names(corpus) <- df$category
  y <- df$category
  clean <- cleanCorpus(corpus)
  dtm = buildData(clean, 0.9)
  data <- as.data.frame(as.matrix(dtm))
  names(data) <- dtm$dimnames$Terms
  return (list("category" = y, "data" = data))
}

Before diving into the classical machine learning algorithms, we can do a very simple prediction benchmark. We search the text for the pattern category name or related keywords (for example “scarf” and “shawl” for the Neck/Torso category). We then predict the category as the one whose  keywords appear most often. A text including “sock” and “foot” but no “sweater” is probably in the “Feet / Legs” category. The code below does just that, predicting the most frequent category in case none of the keywords appear in the description. (The keywords are guessed using this knitter’s domain knowledge !)



## Build train, cross-validation, and test sets, 50% of cases go to train set
sampler <- createDataPartition(data$category, times=3)
trainData <- data[sampler[[1]],]
crossValData <- data[sampler[[2]],]
testData <- data[sampler[[3]],]

trainFull <- prepareData(trainData)
y_train <- trainFull$category
train <- trainFull$data

cvFull <- prepareData(crossValData)
y_cv <- cvFull$category
cv <- cvFull$data

testFull <- prepareData(testData)
y_test <- testFull$category
test <- testFull$data

# benchmark test: predict category whose keywords appearing the most in the text
# if no keywords in text, predict most frequent category
predEasy <- function(text, sortedCategories){
  # assumes categories sorted by most frequent in trainning set
  # categoryInText holds for each category the indexes where the category keywords appears in the text
  categoryInText <- sapply(sortedCategories, function(pattern) gregexpr(pattern, text)[[1]])
  # catNbrOccurences holds the number of times a category keyword appears in the text 
  catNbrOccurences <- sapply(categoryInText, function(l) sum(l > 0))
  # return category with most keywords occurences
  cat <- sortedCategories[which.max(catNbrOccurences)]
}

sort(table(y_train), decreasing = T)
sortedCategories <- c("[sS]hawl|[sS]carf", "[Ss]weater|[sS]leeve", "\\b[Hh]at\\b", 
                      "[Ff]eet|[Ff]oot|[sS]ock", "\\b[Hh]and\\b|[gG]love|[mMitt]]", "[Ss]ofties|[tT]oy")
y_easy <- sapply(crossValData$description, predEasy, sortedCategories)
# reorder y_cv names to have true positives in the diagonal (regexp letters mess up ordering)
table(y_easy, y_cv)[, c(1,5,6,4,2,3)]

# resulting confusion matrix:

# y_easy                     y_cv     Feet / Legs Softies Sweater Neck / Torso Hands Hat
# [Ff]eet|[Ff]oot|[sS]ock                  79       6       5           11     4   3
# [Ss]ofties|[tT]oy                         0       6       0            0     0   0
# [Ss]weater|[sS]leeve                      0       1     123            2     1   1
# [sS]hawl|[sS]carf                        38      13      45          361    10  36
# \\b[Hh]and\\b|[gG]love|[mMitt]]           0       2       4            6    16   3
# \\b[Hh]at\\b                              0       1       0            8     6 101

 

The performance can be checked in the confusion matrix. This benchmark is not so bad, most of the patterns in each category are correctly predicted.

However, if our keywords do not appear in the text, the prediction quality will go down. In order to take the full text into account, we need the algorithm to take the whole Document Term Matrix into account instead of guessing a priori the keywords that are good predictors of  a category.

Since we have several categories and plenty of features in the dataset, we can try a random forest. The default forest in R’s randomForest library works quite well here, after a bit a data preparation (matching the words in the DTM for the train/test/cross-validation sets):



matchWords <- function(testDtm, referenceDtm){
  # Can't predict categories never seen in reference set 
  # => remove them from the set used for prediction
  # and add to predicting set the words that were in train set but not in predicting set
  # Args: document term matrix to modify and reference document term matrix
  # Returns the modified dtm with columns matching the reference dtm
  test2 <- testDtm[, intersect(colnames(referenceDtm), colnames(testDtm))]
  trainWordsNotInTest <- setdiff(names(referenceDtm), names(test2))
  yy <- data.frame(matrix(0, ncol = length(trainWordsNotInTest),
                          nrow = dim(test2)[1]))
  names(yy) <- trainWordsNotInTest
  # Final processed test set
  return(cbind(test2, yy))
}

cvMatched <- matchWords(cv, train)
testMatched <- matchWords(test, train)

## Random Forest
rf <- randomForest(train, y_train)
pred <- predict(rf, cvMatched)
table(pred, y_cv)
# interpretation: graph showing which words make the most interesting splits in the trees
varImpPlot(rf, type=2) 

# (pred)          Feet / Legs Hands Hat Neck / Torso Softies Sweater     (y_cv)
# Feet / Legs           97     3   3           12       2       8
# Hands                  0    20   0            0       0       0
# Hat                    2     3 130            6       1       1
# Neck / Torso          17    10   8          362       9      28
# Softies                0     0   0            1      17       0
# Sweater                1     1   3            7       0     140

Comparing the confusion matrices between the benchmark and the random forest, the forest wins !

RFcategoryGini

Words importance for category prediction, as illustrated by their contribution to the decrease of the Gini index.

Looking at the forest variable importance plot, it appears as expected that words like “hat” or “sleeves” are good predictors (no sleeves on scarves usually). Other more generic good predictors appear: “top” probably narrows the category to scarves or sweaters, excluding socks, and “fit” is probably more likely to appear for items where size matters (hats, socks, and sweaters).

Autumn tree canopy, Foret des Laurentides, Quebec, Canada

Random forests are the best forests.

 

In order to estimate the performance of the winner on wild data, we use the test set:


# on test set:
predTest <- predict(rf, testMatched)
table(predTest, y_test)

# (predTest)      Feet / Legs Hands Hat Neck / Torso Softies Sweater (y_test)
# Feet / Legs          102     0   1           12       3       8
# Hands                  0    21   0            0       0       0
# Hat                    2     2 132            5       2       1
# Neck / Torso          12    12  10          363      11      23
# Softies                0     0   0            0      13       0
# Sweater                1     2   1            8       0     145

Pattern launch study

On Ravelry, users make heavy use of the bookmarking tools (“favorite” and “queue”) to remember the knitting patterns that caught their eye among the several millions that the database holds.

The popular Brooklyn Tweed design house released their Fall 2015 knitting patterns collection on Wednesday, September 16th; I used this opportunity to look at the bookmarking activity on these patterns in real time for several days after the launch.

Screen Shot 2015-09-26 at 11.26.49

Some of the 15 patterns in the Brooklyn Tweed Fall 2015 collection.

The pattern names are kept secret until the launch, so it’s not possible to “listen” to the Ravelry database to detect their apparition and start following them. One needs to first search the Ravelry database for recently published Brooklyn Tweed designs, and assuming that the Fall 2015 designs will be among the most recent results. This can, and should, be changed after the launch, editing the script to query the actual names of the collection patterns, because at some point there will be more recent patterns tagged “Brooklyn Tweed” that push those from this Fall collection out of the most recent results. The following code does just that, getting the permalinks (unique pattern names) for the 30 most recent “Brooklyn Tweed” search results:

# Search for recent BT patterns (will also have others made with BT yarns)
BT_query <- GET("https://api.ravelry.com/patterns/search.json?page_size=30&query=Olga%20Buraya%20Kefelian&sort=date",
             config=config("token"=ravelry.token))
content_to_follow <- content(BT_query)

permalinks_to_follow <- sapply(content_to_follow[[1]], function(x) x$permalink)

Once we have the links, the following code queries the API for each pattern for the properties we want to look at: current number of favorites, of users who queued the pattern, of comments, and of projects. It then appends the resulting data to a text file “BT_follow.txt”.

# get url from pattern unique name (permalink)
links_to_follow <- sapply(permalinks_to_follow, function(name) paste("https://api.ravelry.com/patterns/",name,".json&amp;quot;,sep=&amp;quot;&amp;quot;,collapse=&amp;quot;&amp;quot;))
# query the API
pat0 <- lapply(links_to_follow, GET, config=config("token"=ravelry.token))
pats <- lapply(pat0, content)

# filter the results for the properties we are interested in
pattern_data <- sapply(pats, function(x) x$pattern[c("permalink",
                                                    "queued_projects_count",
                                                     "projects_count&amp",                                                       "favorites_count",
                                                     "comments_count")])

# turn into a data frame object
pattern_df <- data.frame(matrix(unlist(pattern_data), nrow=length(links_to_follow), byrow=T))
# add time and date
pattern_df$time <- Sys.time()

# write to text file
write.table(pattern_df, file = "/Users/saskia/R/ravelry_explorer/BT_follow.txt",append=T,row.names=F,col.names=F,quote=F)

This code gets the data at the point in time where it is run; in order to get this data as a function of time, the code above in ran automatically every 30 minutes using a Cron job (useful advice here).

After letting the data file grow for a few days, it’s time for harvest !

# read from the text file
BT_time <- read.csv("BT_follow.txt",header=F,sep=";")
# add columns names
names(BT_time) <- c("pattern","queued_projects_count","projects_count","favorites_count","comments_count","day","time")

# Fall 2015 pattern unique names
names_BT <- c("ashland-2","bannock","birch-bay-2","cascades","deschutes-2","copse-2",
             "fletching-3","lander","lolo","mcloughlin","nehalem-2","riverbend-2",
             "sauvie","trailhead-2","willamette-7")

# Fall 2015 pattern official names
names_full <- c("Ashland","Bannock","Birch Bay","Cascades","Deschutes","Copse",
                "Fletching","Lander","Lolo","McLoughlin","Nehalem","Riverbend",
                "Sauvie","Trailhead","Willamette")

names(names_full) <- names_BT

# filter the data to keep only Brooklyn tweed Fall 2015 patterns
BT_time <- subset(BT_time,subset=(pattern %in% names_BT))
BT_time$pattern <- droplevels(BT_time$pattern)
# use pattern name as identifier instead of permalink
BT_time$pattern <- revalue(BT_time$pattern, names_full)
# get full date from day and hour/min, in Brooklyn Tweed's local time (PDT)
BT_time$date <- as.POSIXct(paste(BT_time$day, BT_time$time))
attributes(BT_time$date)$tzone <- "America/Los_Angeles"

And now we can plot the graph of the number of favorites on each pattern as a function of time. I chose 15 colors as far from each other as possible using this handy tool from the Medialab at Sciences Po.

ggplot(BT_time) + 
  geom_line(aes(x=date, y=favorites_count, color=pattern, group=pattern)) +
  geom_text(data=BT_time[BT_time$date ==lastdate,], 
            aes(x=date,
                y=favorites_count,
                color=pattern,
                label=pattern),
            vjust = -0.2) +
  xlab("Time") +
  ylab("Number of favorites") +
  theme(legend.position="none") +
  scale_colour_manual(values=BT_colors) +
  ggtitle("Evolution of number of favorites on BT Fall 2015 patterns")
The sun (almost) never sets on the knitting empire !

The sun (almost) never sets on the knitting empire! (click to enlarge)

Looks like the hottest time window is within the first day! The time dependence has a very similar shape for each pattern, probably because they are all released in the same context, with a consistent design concept throughout the collection.

People bookmark patterns all the time, although when it’s night in the USA, there is a small dip in activity. This is much more visible if we plot the favoriting rate (number of new favorites per hour):

# function getting the nbr of favorites per unit time
dfav_dt <- function(data){
  n <- dim(data)[1] # nbr lines
  favdiff <- c(0, diff(data$favorites_count)) # length n
  timediff <- difftime(data$date, c(data$date[1], data$date[1:n-1]),units="hours")
  # div by 0 on first item, but ggplot will just ignore those points
  timediff <- as.numeric(timediff) 
  favderiv <- SMA(favdiff/timediff)
  return(data.frame(deriv = favderiv, 
                    date = data$date))
}

# rate gets pretty constant after a few days, so keep only
# the points shortly after launch
m <- 3000
# get rates for each pattern
rates <- ddply(BT_time[1:m,],.(pattern), dfav_dt)

# normalize the data to more easily see the general behavior
norm_col <- function(data){
  maxd <- max(data$deriv, na.rm=T)
  return(cbind(data,norm_deriv=data$deriv/maxd))
}

rates <- ddply(rates,.(pattern), norm_col)

ggplot(rates) + 
  geom_line(aes(x=date, y=norm_deriv, color="red", group=pattern)) +
  xlab("Time") +
  ylab("Normalized favoriting rate") +
  theme(legend.position="none") +
  ggtitle("Evolution of favoriting rate on BT Fall 2015 patterns")

BT_fav_rate_t

Favoriting rate for the few days after the launch; the dip in activity when night moves over the USA is now quite visible. There are 15 normalized curves, one for each pattern in the collection. (click to enlarge)

The time dependence of the number of times a pattern was queued is very highly correlated with the time dependence of the number of favorites, so I’m not showing it here.

I’m letting the code run once per day now; I’ll post the new data in a few months to look at long term tendencies, and at the number of projects (there are obviously not a lot of them so soon after the launch). I’m guessing Christmas Crunch will be having interesting effects …

Knitting patterns price distribution

Ravelry allows knitting designers from all over the world to sell individual patterns directly to knitters. This post looks at the distribution of the prices of these items. The Ravelry pattern database holds patterns published as books, e-book collections, pdf downloads, or club subscriptions; all patterns that are available online for purchase have their price indicated on their Ravelry page.

The following code queries the Ravelry API for the 500 patterns with most projects in each of the following categories: “hat”, “sweater”, “neck/torso”, “feet/legs”, “hands”, “home”, “component” (these are tutorial or special techniques instead of full patterns), “toys and hobbies”, and “pet”. From this data we get the URLs to the patterns and use standard web scrapping to get the html code for each pattern page. This works on patterns, since their pages are public (viewable by users not logged into Ravelry), but would not work for projects or stash entries, which are private by default (viewable only by Ravelry users).




categories <- c("hat","sweater","neck-torso","feet-legs","hands","home","toysandhobbies","pattern-component","pet")

# Get dataset of non-free patterns with a high number of projects, available as pdf downloads
# (Full treatment 1h30 for 500/category)
search_url <- "https://api.ravelry.com/patterns/search.json?page_size=500&sort=projects&craft=knitting&availability=ravelry%2B-free&pc="
cat_search <- sapply(categories, function(name) paste(search_url, name,sep="", collapse=""))

# Get lists of search results; price attribute is NULL => use web scraping to get it
pat0 <- lapply(cat_search, GET, config=config("token"=ravelry.token))
pat <- lapply(pat0, content)

# Extract patterns permalinks in each category
permalinks <- sapply(pat, function(x) sapply(x$patterns, function(y) y$permalink))
names(permalinks) <- categories
permalinks <- melt(permalinks)
names(permalinks) <- c("link","category")

permalinks_full <- sapply(permalinks$link, function(name) paste("http://www.ravelry.com/patterns/library/",name,sep="",collapse=""))

# Random sampling for testing
samp = sample(1:length(permalinks$link),length(permalinks$link))
permalinks_full <- permalinks_full[samp]       
permalinks <- permalinks[samp,]       

# Web scraping to get the price from the pattern page
# Takes about 1 min for 50 links
n=dim(permalinks)[1] # 1000 ok
pattern_info <- lapply(permalinks_full[1:n], htmlTreeParse, useInternalNodes = TRUE)
names(pattern_info) <- permalinks$link[1:n]

Once we have the html code for each pattern page, we parse it for the prices. The path to the price information in the html tree can be checked by looking at the source code for a typical pattern page. Since most patterns are priced in US dollars (around 75% of them in this dataset), all the price data is converted to current USD to match, using the R quantmod library.

 

pattern_prices <- lapply(pattern_info, function(html) getNodeSet(html, 
                                                                 path="//strong[@class='price']/a/text()", 
                                                                 fun=xmlValue)[[1]] )

num_prices <- lapply(pattern_prices, function(str) c("price"=regmatches(str,
                                                                regexpr("[[:digit:]]+\\.*[[:digit:]]*",str)),
                                                     "currency"=substr(str, nchar(str)-2, nchar(str)) 
                                                     )
                     )


pattern_nbr_projects <- melt(sapply(pattern_info, nbr_projects))
price_data  <- data.frame(matrix(unlist(num_prices), nrow=length(num_prices), byrow=T), stringsAsFactors=F)
price_data <- cbind(pattern_nbr_projects, permalinks[1:n,], price_data)
names(price_data) <- c("nbr_projects", "link","category", "price", "currency")
price_data$price <- as.numeric(price_data$price)

# Local currency conversion is proposed by Ravelry only for logged in users
# => do normalizeing of prices here
currencies_codes = sapply(price_data$currency, paste,"USD",sep="")
# getFX puts exchange rate in the environment, but sapply does not change env. variables
for (curr in unique(price_data$currency)) getFX(paste(curr, "/USD", sep=""), from = Sys.Date())
exchange_rates = sapply(currencies_codes, get)
price_data$price_usd = price_data$price * exchange_rates

And finally, the global price distribution (all categories aggregated):

ggplot(price_data) +
  geom_histogram(aes(x=price_usd), fill='Blue', alpha=0.5, binwidth=0.5) +
  scale_x_continuous(limits = c(0, 20), breaks = round(seq(0, 20, by = 1), 1)) +
  xlab("Pattern price in USD") +
  ylab("Number of patterns")

hist_prices

Pattern prices distribution. The data is only shown for patterns up to 20 dollars (there are a few expensive outliers, mostly kits with pattern+yarn included).

It looks like the “99 cents is cheaper than 1$” strategy is mostly used in the lower prices range. In the prices 6$ to 9$, there are much fewer price points just below the integer prices, but in the 3$ to 5$, it’s the contrary.

The breakdown by category:

ggplot(price_data, aes(x=category, y=price_usd, fill=category)) +
  geom_boxplot(alpha=0.5) +
  ylab("Price in USD") +
  title("Pattern prices distributions in each category")
Prices by category

Pattern price is pretty constant.

Price does not depend on category much. But negative results are just as interesting as positive results, so this graph is still proudly displayed! I was a bit surprised by this, since there can be a lot a variance in pattern design complexity between a one-size-fits-all accessory and a sweater.

Which yarn colors are most stashed and most used ?

Color is a pretty important part of a knitting project, and a big factor in deciding to buy and knit a skein (or hank, as is more often the case with hand-dyed yarns). Maybe counter-intuitively for non-knitters, many knitters buy yarn without a specific project planned for it, sometimes even in quantities that they couldn’t knit through even if they spent the rest of their lives knitting 24/7! Such is the power of beautiful yarn.

The yarn stash entry on ravelry allows the user to select the color category of their yarn when adding it to their notebook stash. Color is quite subjective and categorizing yarn colors can be especially difficult, as shown on those pictures:

Which color is this ? (“Top Draw Sock” by Skein in the “inner city” colorway)

Is this yellow, brown, or orange ? (“Tosh Sock” by Madelinetosh in the “ginger glazed” colorway)

Often though, the color distinctly falls into one of the Ravelry color families: “Blue”, “Green”, “Purple”, “Brown”, “Gray”, “Blue-green”, “Pink”, “Red”, “Natural/Undyed”, “Black”, “Red-purple”, “White”, “Orange”, “Yellow”, “Blue-purple”, “Red-orange”, “Yellow-green”, and “Yellow-orange”. This post excludes yarn spun by the users (“handspun”), to look only at commercial yarns (spun at a mill) that users have bought and added to the “yarn stash” section of their notebooks.

The color family of projects cannot be retrieved with the API (it is a yarn property); in addition, the actual number of stashed yarn items and projects in Ravelry are displayed when doing a manual search. I entered this data by hand to look at color distributions rather than doing an API call. Not as practical as an API call, but it’s more accurate since those tend to timeout if we query more than 5000 entries.

The code below defines the data as taken (manually) from Ravelry, and shows a plot of how many items are stashed in each color (bars) and how many projects were knitted using this color (dots).


# Colors selected among the 140 html supported color names
ravColors <- c("Black"="#000000","Blue"="#0000ff","Blue-green"="#008080","Blue-purple"="#6A5ACD","Brown"="#A52A2A",
                "Gray"="#808080","Green"="#008000","Natural/Undyed"="#e0d8c8","Orange"="#FFA500","Pink"="#FFC0CB",
                "Purple"="#800080","Red"="#ff0000","Red-orange"="#FF4500","Red-purple"="#C71585","White"="#ffffff",
                "Yellow"="#ffff00","Yellow-green"="#ADFF2F","Yellow-orange"="#FFD700")

# Color breakdown (august) from project and stash search page info: 
yarnColors <- data.frame("color"=c("Blue","Green","Purple","Brown","Gray","Blue-green",
                                    "Pink","Red","Natural/Undyed", "Black","Red-purple",
                                    "White","Orange","Yellow","Blue-purple","Red-orange",
                                    "Yellow-green","Yellow-orange"),
                          "project"=c(702934,572417,420128,384078,495350,368599,
                                      412316,362362,268711,237424,148006,
                                      254850,170679,168060,143248,92505,
                                      65680,53732),
                          "stash"=c(923548,753213,600723,534547,506782,493983,
                                    561139,433341,304647,261388,204782,
                                    241738,228724,194401,198696,127643,
                                    82374,65809))


# sort by increasing number of items in stash
yarn_colors <- arrange(yarn_colors,stash)

ggplot(data=yarnColors)+
  geom_bar(aes(x=seq_along(color), y=stash, fill=factor(color)),
           stat="identity")+
  geom_point(aes(x=seq_along(color), y=project, fill=factor(color)),
             colour="white", pch=21, size=5)+
  guides(fill=guide_legend(title="colors\nbars: stash\ndots: projects"))+
  theme(axis.text.x=element_blank())+
  theme(axis.ticks.x=element_blank())+
  scale_fill_manual(values=rav_colors)+
  xlab("Ravelry color family")+
  ylab("Number of stash items / projects")+
  ggtitle("Color distribution of stashed yarns and yarns used in projects")

Colors in stashes and projects. Blue and green lead !

Colors in stashes and projects. Blue and green lead !

Projects colors tend to follow the same distribution as stash colors. Blue is clearly the winner, both in stashes and in projects. Yellows and oranges, on the other hand, don’t seem to tempt many knitters.

Gray is knitted a lot more, comparatively, than it is stashed (its dot doesn’t follow the slope defined by the other dots).

Knitting patterns categories

Let’s have a look at the repartition of Ravelry patterns among the various categories. The categories have a tree structure. The number of patterns in each category is not accessible via the API, but it is visible on the website main page.

The code below is not the most exciting, but it is a more accurate reflection of the breakdown of knitting patterns in August 2015 than what could be estimated from an API call on the database. I took into account only the patterns that have at least one picture, to avoid potential bad entries (duplicates, drafts …). Some of the categories are aggregated to keep the tree plot simple; the entries named “All Item” are aggregated and actually contain subcategories.

pattern_nbr_tree <- list("Clothing"=list( "Coat/Jacket"=10707,
                                          "Dress"=5232,
                                          "Intimate Apparel"=list("Bra"=35,
                                                                 "Pasties"=10,
                                                                 "Underwear"=152,
                                                                 "Other"=69),
                                          "Leggings"=332,
                                          "Onesies"=905,
                                          "Pants"=1107,
                                          "Robe"=104,
                                          "Shorts"=330,
                                          "Shrug/Bolero"=3939,
                                          "Skirt"=1660,
                                          "Sleepwear"=354,
                                          "Soakers"=470,
                                          "Sweater"=list("Cardigan"=31580,
                                                         "Pullover"=41795,
                                                         "Other"=1088),
                                          "Swimwear"=135,
                                          "Tops"=list("Sleeveles Top"=7195,
                                                      "Strapless Top"=130,
                                                      "Tee"=3604,
                                                      "Other"=550),
                                          "Vest"=9256,
                                          "Other"=767),
                          "Accesories"=list("All Bag"=8883,
                                            "Belt"=271,
                                            "Feet/Legs"=list("Booties"=3501,
                                                             "Legwarmers"=1801,
                                                             "Slippers"=2188,
                                                             "All Socks"=23631,
                                                             "Spats"=89,
                                                             "Other"=540),
                                            "All Hands"=23733,
                                            "All Hat"=45386,
                                            "All Jewelry"=1642,
                                            "Neck/Torso"=list("Bib"=364,
                                                              "Cape"=1591,
                                                              "Collar"=921,
                                                              "Cowl"=17798,
                                                              "Necktie"=362,
                                                              "Poncho"=2604,
                                                              "Scarf"=26600,
                                                              "Shawl/Wrap"=26210,
                                                              "Other"=691),
                                            "All Other Headwear"=3989,
                                            "Other"=1277),
                          "All Home"=36478,
                          "All Toys and Hobbies"=21023,
                          "All Pet"=1551,
                          "All Components"=7073)

This plot shows the number of patterns in each category as the area of the corresponding rectangle.

pattern_nbr_tree <- melt(pattern_nbr_tree)
names(pattern_nbr_tree) <- c("patterns_count","cat3","cat2","cat1")

custom_palette <- c("#FAF0E6","#7FFFD4","#008080","#FF6347","#FA8072","#B0C4DE")
treemap(pattern_nbr_tree,index=c("cat1","cat2","cat3"),vSize="patterns_count",
title="Number of knitting patterns per category",palette=custom_palette,border.col="White",border.lwds=c(6,3,0.5),
        bg.labels=0,fontsize.labels=c(14,13,11),
        align.labels=list(c("left","top"),c("center","center"),c("center","center")))
Number of patterns in each category.

Number of patterns in each category (click to enlarge).

Accessories dominate, probably because they represent a smaller time commitment than clothing items, and there are fewer risks on the fit!

Tags in popular knitting projects

This second post in the “Knitting data” series looks at the text Ravelry users use to describe their own projects, and more specifically the tags attached to popular projects, i.e. the projects with the most “favorites”. “Favoriting” is a way for users to bookmark and manifest their appreciation for an item.

The following code queries the Ravelry API for the 5000 most favorited projects.

knit_all <- GET("https://api.ravelry.com/projects/search.json?page_size=5000&amp;craft=knitting&amp;sort=favorites", config=config("token"=ravelry.token))
knit <- content(knit_all)

The following function retrieves the tags from a list of projects (the result of the query above) that have a number of favorites above a given threshold. The tags are then grouped into a text corpus to use with the R text mining library tm. (The corpus form may generally be useful to split the tags into several groups by popularity thresholds for example).

get_tags <- function(projects, fav_threshold){
  # get the tags from the project list
  # use only projects where nbr of favorites >= fav_threshold
  tags_threshold <- lapply(projects,
                  function(x) ifelse(x$favorites_count>=fav_threshold,x$tag_names,""))
  tags <- paste(unlist(tags_threshold), collapse=" ")
  # build corpus from project tags
  corpus_tags <- Corpus(VectorSource(tags))
  names(corpus_tags) <- paste("fav",as.character(fav_threshold),sep="")
  # clean up the tags
  corpus_tags <- tm_map(corpus_tags, removeNumbers) # ignore dates
  corpus_tags <- tm_map(corpus_tags, removePunctuation)
  corpus_tags <- tm_map(corpus_tags, stemDocument)
  return(corpus_tags)
}

Now the “alltags” object below is a text corpus with all the tags used in the 5000 most favorited projects; since the threshold is 0, all projects are included. The tags are stemmed, meaning that the end of the word is cut according to certain rules such as to avoid differencing between “cables” and “cabling” for example.

alltags <- get_tags(knit$projects, 0)

The following function gets the frequency of each tag into a data frame (useful to more easily get the origins of the stemmed words).

tags_frequencies <- function(corpus_tags){
  # return tags and their frequencies in each document of corpus
  tdm <- TermDocumentMatrix(corpus_tags)
  tdmframe <- as.data.frame(as.matrix(tdm) )
  names(tdmframe) <- names(corpus_tags)
  tdmframe$tags <- tdm$dimnames$Terms
  return(tdmframe)
}

Now we can apply this to our tag corpus to make a word cloud and a bar chart showing the most frequently used tags.

The tags are linked back to a correct word origin: “cable” is the simplest origin of the stem “cabl”; “cardigan”, on the other hand, is not changed by stemming. There should be a more elegant way (probably using Wordnet) to do this than the simple table lookup below, which I hope to get to in a later post !

all_freq <- tags_frequencies(alltags)
# keep only most frequent tags on all dataset
all_freq <- arrange(all_freq, desc(fav0))
all_freq <- all_freq[1:30,]
# replace stemmed word by a readable origin word
correction <- c(babi="baby",cabl="cable",pullov="pullover",bulki="bulky",contigu="contiguous",finger="fingering")
realword <- function(x) ifelse(x %in% names(correction), correction[x],x)
all_freq$tags <- sapply(all_freq$tags, realword)

wordcloud(words=all_freq$tags, freq=all_freq$fav0,colors=brewer.pal(8, "Dark2"),rot.per=0)
Word cloud of the most frequent tags in popular projects

Word cloud of the most frequent tags in popular projects

And the bar chart and its code:

cloud_acc

Chart of the most frequent tags in popular projects (same data as the word cloud)

ggplot()+
  geom_bar(aes(x=seq_along(all_freq$tags), y = all_freq$fav0), stat="identity", fill='Gold')+
  geom_text(aes(x=seq_along(all_freq$tags),
                y=all_freq$fav0,
                label=all_freq$tags),
            hjust=1.01,
            position=position_dodge(width=0.9) )+
  scale_x_reverse()+
  xlab("tag")+
  ylab("tag frequency")+
  theme(axis.ticks.y=element_blank())+
  theme(axis.text.y=element_blank())+
  coord_flip()

Looks like cabled cardigans for babies are your best bet for knitterly fame !

About Ravelry – API connection

This post is the first of a series investigating the data found on ravelry.com using the R programming language and the Ravelry API. Ravelry is a website functionning as a database, organisationnal tool, and social network for knitting and fiber crafts enthusiasts.

A lot of user-created content is accessible via the Ravelry API. Ravelry hosts a collection of about 300,000 knitting patterns; there are over 9 million knitting projects pages created by the 5 million users, with about 7,000 projects and 65000 forum posts added per day (more Ravelry facts from 2014 here).

The organizational tool is the most relevant for data mining, as it holds a lot of information about patterns, projects, and tools. Each user has a public notebook consisting of their craft projects, their yarn stash, their “favorites” (bookmarks) and other features. Project entries in the notebook have attributes like the name of the pattern, the notes taken by the user, the yarns and needles used … Stash entries have attributes like the name of the company producing the yarn, the color family, the user rating, the weight and so on.

projects

Screenshot of the notebook page on Ravelry, with the list of projects made by the user.

pattern

Pattern page: includes the designer’s name, the pattern category, the recommended yarns, pictures … (“Sockhead hat” by Kelly McClure)

yarn

Yarn stash entry: includes link to yarn in the database, yarn weight, color family … One stash entry can represent several skeins of the same yarn.

project

Project entry: includes name of the project, link to pattern, needle (or hook for crochet) and yarn, user’s notes … (“Lorenz Manifold” by alicialight)

The R code below configures the oauth access to the API using the httr library. Your user access key and secret key provided by Ravelry are assumed to be in the user_rav.txt file in the working directory.

library(httr)

# user_rav.txt contains API username and password 
credentials <- readLines("user_rav.txt")
names(credentials) <- c("user","access_key","secret_key")

OpenConnection <- function(credentials){
  # Args: login info for the Ravelry API
  # Returns oauth token
  # Open connection to Ravelry API and return token
  reqURL <- "https://www.ravelry.com/oauth/request_token"
  accessURL <- "https://www.ravelry.com/oauth/access_token"
  authURL <- "https://www.ravelry.com/oauth/authorize"
  
  ravelry.app <- oauth_app("ravelry", key=credentials["access_key"], 
                           secret=credentials["secret_key"])
  ravelry.urls <- oauth_endpoint(reqURL, authURL, accessURL)
  
  return(oauth1.0_token(ravelry.urls, ravelry.app))
}

# Quick test of API connection by getting connected user info
TestConnection <- function(ravelry.token) {
  # Arg: API token
  # Returns name of the user connected with this token
  test <- GET("https://api.ravelry.com/current_user.json", 
              config=config("token"=ravelry.token)) 
  print(content(test)$user$username)
}

ravelry.token <- OpenConnection(credentials)
TestConnection(ravelry.token)

Once the connection is approved, this command should query and show your user name:

userinfo <- GET("https://api.ravelry.com/current_user.json",
              config=config("token"=ravelry.token))
print(content(userinfo)$user$username)

In the next post we will get to the real data !