Задача:

 Написать для построения модели CF функцию, параметром которой являются данные пользователей, а результатом — модель, например, model = buildModel(reviews). Другими словами, нужно написать функцию, которая будет строить модель CF по любому набору данных одинаковой структуры (можно взять, например, данные разных групп, подставить и получить на выходе модель, которую дальше можно использовать для предсказания)

Предыдущий код

 Изначально наша, команды 24, функция коллаборативной фильтрации принимала на входе количество, id пользователя. Датасет уже изначально был туда встроен.

goodread_reviews =goodread_reviews%>% select(book_id, user_id, rating)
user_item = goodread_reviews %>%
  pivot_wider(names_from = book_id,values_from = rating) %>%
  as.data.frame()
rownames(user_item) = user_item$user_id
user_item$user_id = NULL
user_item = as.matrix(user_item)

user_recommendation_col=function(user_ID, quantity, review_matrix=goodread_reviews, n_recom = 20, user_item_matrix = user_item,
                               ratings_matrix = goodread_reviews,
                               n_recommendations = 20,
                               threshold = 1,
                               nearest_neighbors = 20){
  ###################################### 1111
  cos_similarity = function(A,B){
  num = sum(A *B, na.rm = T)
  den = sqrt(sum(A^2, na.rm = T)) * sqrt(sum(B^2, na.rm = T)) 
  result = num/den

  return(result)
if(count(goodread_reviews%>% filter(user_id == user_ID))>10){
  user_index = which(rownames(user_item_matrix) == user_ID)

  
}
  
  similarity = apply(user_item_matrix, 1, FUN = function(y) 
                      cos_similarity(user_item_matrix[user_index,], y))

  similar_users = tibble(user_id = names(similarity), 
                               similarity = similarity) %>%
    filter(user_id != user_ID) %>% 
    arrange(desc(similarity)) %>%
    top_n(nearest_neighbors, similarity)


  readed_books_user = ratings_matrix$book_id[ratings_matrix$user_id == user_ID]

  recommendations = ratings_matrix %>%
    filter(
      user_id %in% similar_users$user_id &
      !(book_id %in% readed_books_user)) %>%
    group_by(book_id) %>%
    summarise(
      count = n(),
      rating = mean(rating)
    ) %>%
    filter(count > threshold) %>%
    arrange(desc(rating), desc(count))
recommendations= recommendations%>% left_join(goodread_comics)%>% select(title, average_rating, book_id)  

######    1.2

  rates = pivot_wider(goodread_reviews, names_from = book_id, values_from = rating)
userNames = rates$user_id
rates = select(rates, -user_id)
rates = as.matrix(rates)
rownames(rates) = userNames
  r = as(rates, "realRatingMatrix")
  
ratings_comics <- r[rowCounts(r) > 5, colCounts(r) > 10] 
set.seed(100)
test_ind <- sample(1:nrow(ratings_comics), size = nrow(ratings_comics)*0.2)
recc_data_train <- ratings_comics[-test_ind, ]
recc_data_test <- ratings_comics[test_ind, ]
recc_model <- Recommender(data = recc_data_train, method = "IBCF")
model_details <- getModel(recc_model)

recc_predicted <- predict(object = recc_model, newdata = recc_data_test, n = 20)
  recc_user <- recc_predicted@items[[user_ID]]
  comics_user <- recc_predicted@itemLabels[recc_user]
  
  comics_user_1 =  data.frame(list(comics_user))
  names(comics_user_1) <- 'book_id'
  comics_user_1$book_id <- as.numeric(comics_user_1$book_id)
  comics_user_1 = comics_user_1%>% left_join(goodread_comics)%>% select(title, book_id, average_rating)%>% arrange(desc(average_rating))
  
v = comics_user_1%>% inner_join(recommendations)
p = comics_user_1%>% full_join(recommendations)%>% arrange(desc(average_rating))%>% select(title, book_id, average_rating)
v = v%>% full_join(p[1:quantity- nrow(v),]) %>% arrange(desc(average_rating))
  
  return(v)}
 
 #########################222222222222222222222222222222
  
  
grades = (goodread_reviews%>% filter(user_id == user_ID))$rating
if((count(goodread_reviews%>% filter(user_id == user_ID))>7   & max(grades)>3) |
   (count(goodread_reviews%>% filter(user_id == user_ID))<=7   & max(grades)>3) ){

item_recommendation = function(book_ID, rating_matrix = user_item, n_recommendations = 5){

  book_index = which(colnames(rating_matrix) == book_ID)

  similarity = apply(rating_matrix, 2, FUN = function(y) 
                      cos_similarity(rating_matrix[,book_index], y))

  recommendations = tibble(book_id = names(similarity), 
                               similarity = similarity) %>%
    filter(book_id != book_ID) %>% 
    top_n(n_recommendations, similarity) %>%
    arrange(desc(similarity)) 
    return(recommendations)}
  
k = goodread_reviews%>% filter(user_id == user_ID)%>%filter(rating>=4)  
m = k$book_id
use = data.frame(matrix(ncol = 2, nrow = 0))
colnames(use) <- c('book_id', 'similarity')
use$book_id= as.character(use$book_id)

for (i in 1:length(k$book_id)){
  print(i)
  recom_cf_item = item_recommendation(m[i])
  use = use%>%full_join(recom_cf_item)
}

uses = use%>%arrange(desc(similarity))%>%filter(similarity>0.2)
#user_watched = goodread_reviews %>% filter(user_id == user_ID)
#user_watched$book_id = as.character(user_watched$book_id)
#uses = uses%>% anti_join(user_watched)
answer= uses
answer=unique(answer)
answer = answer[1:quantity,] 
goodread_comics$book_id = as.character(goodread_comics$book_id)
answer = answer%>%left_join(goodread_comics)%>%select(book_id, average_rating, title)%>% arrange(desc(average_rating))
if (length(answer)<quantity)
   {
   additional_data = goodread_comics%>%arrange(desc(average_rating))%>%filter(ratings_count >1000)%>%select(book_id, average_rating, title)
   add_rows = quantity - length(answer)
   print(add_rows)
   additional_data = additional_data[1:add_rows]
   answer = answer%>% full_join(additional_data)%>% arrange(desc(average_rating))%>% select(book_id, average_rating, title)
   answer =  answer[1:quantity,]
   
 return(answer)} 

if (length(answer)==quantity)
  {
  return(answer)
  }

return(answer)}

 ############################################## 3333
  if (count(goodread_reviews%>% filter(user_id == user_ID))<=10 & max((goodread_reviews%>% filter(user_id == user_ID))$rating)<4 ){
    woon = goodread_comics%>%arrange(desc(average_rating))%>%filter(ratings_count >1000)%>%select(book_id, average_rating, title)
  woon = woon[1:quantity,]
  return(woon)}
}

Решение

 Для выполнения поставленной передо мной задачей необходимо модернизировать функцию таким образом, чтобы она могла работать не на одном комплекте датасетов, состоящем из таблиц с отзывами и информацией о комиксе, а на нескольких, имеющих идентичную структуру внутри. В нашем случае содержать 2 датасета или 1, как будет описано ниже.

 1 датасет: “Номер элемента в системе”, “Пользовательский id”, “Оценка”

 2 датасет: “Название”, “Номер эелемента”, “Средний рейтинг”, “Издатель”, “Автор”

 Так как эти данные могут содержаться и в одном датасете, то мы предварительно соединим оба датасета в один. Важно сделать это правильно при работе с другими датасетами, то есть так, чтобы данные не были утерены.

 Задачи:

 Определение необходимого минимума для входного датасета:

 Все остальные колонки являются опционными и не обязательно должны содержаться в датасетах.

basic_pattern_analysis(good)%>%select(book_id, review_id, user_id, rating, date_added) %>%head() 
##   book_id                        review_id                          user_id
## 1    9999 999a9a9999aa9aaa9a9999a9a99aa9aa 99a999999aa9999a99999a9aaaa9999a
## 2    9999 99a9999999999999aa999aa9a999aaa9 aaaa99aa99a99a9a9999aaaaa99999a9
## 3    9999 a99aaaaaaa9999a999a99aa99aaa9aa9 a99999a9a999aaaa999a9999a9a999a9
## 4    9999 9a9999aaaaaa99a9a999999999999aa9 99a99a9a99a9999aa99a99999a999999
## 5    9999 aa99aa9a99a9a9aaaaaaa9a9a9a99999 a9999aaaa99999999a999aaa99999a99
## 6    9999 a99999a999a9a999999a9a99aa9aa9a9 a9a99aaa9aa9aaa99a9a9999999a9999
##   rating                     date_added
## 1      9 AaawAaaw99w99:99:99w-9999w9999
## 2      9 AaawAaaw99w99:99:99w-9999w9999
## 3      9 AaawAaaw99w99:99:99w-9999w9999
## 4      9 AaawAaaw99w99:99:99w-9999w9999
## 5      9 AaawAaaw99w99:99:99w-9999w9999
## 6      9 AaawAaaw99w99:99:99w-9999w9999

 Как мы видим, паттерны достаточно похожи друг на друга, что не позволит нам на основе паттернов определить принадлежность колонки к какому-то типу.

 Был придуман альтернативный способ, позволяющий перенести сложности определения содержания колонок на человека. Более того, это позволит работать не со строго аналогичным датасетом, а с аналогичными, соответствующими определенным тредованиям. В частности, могут быть поменены названия колонок.

 Данная функция сделана через Shiny Web App. Следовательно, будет прикреплена дополнительным файлам. Такой непривыныц вариант был выбран ввиду того, что сделать опрес пользователя через readline в формате html тоже не возможно.

 Представленная ниже функция предполагает уже прогнанную функцию Shiny. На входе новая фукнция user_common_rec получает датасет и результат приложения Shiny.

 Так как импорт функции в файл rmd мне так и не представился возможным, дополнительные данные, которые мы получаем по итогу работы Shiny будут вставлены сюда изве. Данные приложены в выиде дополнительного файла Excel. Хотелось бы отметить, что при использовании другого датасета, который бы подхотдил по параметрам, нам было бы необходимо запускать код в формате Shiny и rmd, в таком случае, все будет работать, так как итогу выгрузки из Shiny записан в окружении.

 Ниже в виде фото представлен демонстрационный вариант функции Shiny.Рабочий вариант во вложениях.

responses <- read_excel("responses.xlsx")
user_common_rec=function(data_set, app_result){

if(app_result[1,1] == 'отсутствует'| app_result[1,2] == 'отсутствует'| app_result[1,3] == 'отсутствует'| app_result[1,4] == 'отсутствует'){
  print('Данный датасет не соответствует необходимым требованиям')
}
  
  if(app_result[1,5] == 'отсутствует'){
  names(data_set)[names(data_set) == app_result[1,1]] <- "user_id"
  names(data_set)[names(data_set) == app_result[1,2]] <- "title"
  #names(data_set)[names(data_set) == app_result[1,3]] <- "book_id"
  names(data_set)[names(data_set) == app_result[1,4]] <- "rating"
  data_set = data_set%>% select(user_id, title, book_id, rating)
  data = data_set %>% group_by(book_id) %>%  summarise_at(vars(rating), funs(mean(., na.rm=TRUE)))
  names(data)[2]<- 'average_rating'
  data_set = data_set %>% left_join(data)
  
}

if(app_result[1,5] != 'отсутствует'){
  names(data_set)[names(data_set) == app_result[1,1]] <- "user_id"
  names(data_set)[names(data_set) == app_result[1,2]] <- "title"
  names(data_set)[names(data_set) == app_result[1,3]] <- "book_id"
  names(data_set)[names(data_set) == app_result[1,4]] <- "rating"
  names(data_set)[names(data_set) == app_result[1,5]] <- "average_rating"
  data_set = data_set%>% select(user_id, title, book_id, rating, average_rating)
  
}

  review = data_set%>%select(title, user_id,rating)
  user_item_matrix = review  %>%pivot_wider(names_from = title,values_from = rating) %>%as.data.frame()
  rownames(user_item_matrix) = user_item_matrix$user_id
  user_item_matrix$user_id = NULL
  user_item_matrix= as.matrix(user_item_matrix)
  rates = pivot_wider(data_set, names_from = book_id, values_from = rating)
  userNames = rates$user_id
  rates = select(rates, -user_id)
  rates = as.matrix(rates)
  rownames(rates) = userNames
  r = as(rates, "realRatingMatrix")
  ratings_comics <- r[rowCounts(r) > 5, colCounts(r) > 10] 
  set.seed(100)
  test_ind <- sample(1:nrow(ratings_comics), size = nrow(ratings_comics)*0.2)
  recc_data_train <- ratings_comics[-test_ind, ]
  recc_data_test <- ratings_comics[test_ind, ]
  recc_model <- Recommender(data = recc_data_train, method = "IBCF")
  model_details <- getModel(recc_model)
}

Пример

 Как и в прошлой функции, данные не требуют никакой ручной предобработки помимо соединения датасетов, в случае, если необходимые колонки находятся в разных файлах, и, соответственно, запуска приложения Shiny.

## Warning: `funs()` was deprecated in dplyr 0.8.0.
## Please use a list of either functions or lambdas: 
## 
##   # Simple named list: 
##   list(mean = mean, median = median)
## 
##   # Auto named with `tibble::lst()`: 
##   tibble::lst(mean, median)
## 
##   # Using lambdas
##   list(~ mean(., trim = .2), ~ median(., na.rm = TRUE))
## Warning in storage.mode(from) <- "double": NAs introduced by coercion

Выводы

 Таким образом, мне удалось создать систему, которая, получая на входе датасет, сначала просит пользователя ответить на вопросы по содержанию, а затем автоматически выполняет все операции, необходимые для работы системы.

 Примечание: В случае не соответствия имеющегося набора данных, функция сообщает пользователю об этой проблеме: выводит сообщение следующего содержания ‘Данный датасет не соответствует необходимым требованиям’.

 Такой вариант работы позволяет работать с достаточно непохожими функции максимально минимизируя ошибки функции. Более того,этот метод подходит не только для комиксов, но и для других датасетов с похожей структурой (фильмов, книг).