this repo has no description

feat: Optimized data generation

Signed-off-by: Sona Tau Estrada Rivera <sona@stau.space>

+88 -38
+88 -38
code/generate_data.R
··· 63 63 out 64 64 } 65 65 66 + lgbt_tags <- list("lgbt","lgbtq","sex","identity","gender","orientation","nonbinary") |> as.character() 67 + race_ethnicity_tags <- list("race","ethnicity","african","american","black","hispanic","asian","indigenous","native","latino","latina","latine") |> as.character() 68 + women_tags <- list("woman","women","girl","feminine","femeninity","ms","mrs") |> as.character() 69 + men_tags <- list("man", "men", "boy", "male", "masculine", "masculinity", "mr") |> as.character() 70 + disabilities_tags <- list("disabilities","disabled","disability","handicap","handicapped","neurodivergent") |> as.character() 71 + tags <- c(lgbt_tags, race_ethnicity_tags, women_tags, men_tags, disabilities_tags) 72 + tag_vectors <- w2v_v(tags) 73 + tag_category <- c( 74 + rep("lgbt", length(lgbt)), 75 + rep("race/ethnicity", length(race_ethnicity)), 76 + rep("women", length(women)), 77 + rep("men", length(men)), 78 + rep("disabilities", length(disabilities)) 79 + ) 80 + 66 81 word_category <- function(x, threshold = 0.3) { 67 - lgbt <- list("lgbt","lgbtq","sex","identity","gender","orientation","nonbinary") 68 - race_ethnicity <- list("race","ethnicity","african","american","black","hispanic","asian","indigenous","native","latino","latina","latine") 69 - women <- list("woman","women","girl","feminine","femeninity","ms","mrs") 70 - men <- list("man", "men", "boy", "male", "masculine", "masculinity", "mr") 71 - disabilities <- list("disabilities","disabled","disability","handicap","handicapped","neurodivergent") 72 - all <- c(lgbt, race_ethnicity, women, men, disabilities) 82 + 83 + similarity_vectors <- numeric(length = length(all_vecs[1,])) 84 + for (i in seq_along(all_vecs[1,])) { 85 + w <- tag_vectors[,i] 86 + similarity_vectors[i] <- word2vec_similarity(w2v(x), w, type = "cosine") 87 + } 73 88 74 89 similarities <- data.frame( 75 - sim = sim_v(x, all), 76 - word = as.character(all), 77 - word_category = c( 78 - rep("lgbt", length(lgbt)), 79 - rep("race/ethnicity", length(race_ethnicity)), 80 - rep("women", length(women)), 81 - rep("men", length(men)), 82 - rep("disabilities", length(disabilities)) 83 - ) 90 + sim = similarity_vectors, 91 + tags = tags, 92 + tag_category = tag_category 84 93 ) 94 + 85 95 similarities <- similarities[similarities |> complete.cases(),] 86 96 m <- max(similarities $ sim, na.rm = TRUE) 87 - if (m > threshold) similarities[m == similarities,] |> head(1) else data.frame(sim = NA, word = NA, word_category = NA) 97 + if (m > threshold) similarities[m == similarities,] |> head(1) else data.frame(sim = NA, tag = NA, tag_category = NA) 98 + } 99 + 100 + memo <- new.env(hash = TRUE, parent = emptyenv()) 101 + word_category_m <- function(x, threshold = 0.3) { 102 + if (is.null(memo[[x]])) { 103 + memo[[x]] <- word_category(x, threshold) 104 + } 105 + return(memo[[x]]) 88 106 } 89 107 90 108 word_category_v <- function(x) { 91 - res <- Vectorize(word_category)(x) |> t() 109 + res <- Vectorize(word_category_m)(x) |> t() 92 110 sim <- numeric(length = length(x)) 93 - word <- character(length = length(x)) 94 - word_category <- character(length = length(x)) 111 + tag <- character(length = length(x)) 112 + tag_category <- character(length = length(x)) 95 113 for (i in 1:nrow(res)) { 96 114 sim[i] <- res[,"sim"][[i]] 97 - word[i] <- res[,"word"][[i]] 98 - word_category[i] <- res[,"word_category"][[i]] 115 + tag[i] <- res[,"tag"][[i]] 116 + tag_category[i] <- res[,"tag_category"][[i]] 99 117 } 100 118 data.frame( 101 119 sim = sim, 102 - word = word, 103 - word_category = word_category 120 + tag = tag_category, 121 + tag_category = tag_category 104 122 ) 105 123 } 106 124 ··· 116 134 117 135 data <- data[selection,] 118 136 119 - for (row_idx in 1:nrow(data)) { 120 - raw_txt <- data[row_idx,"variables"] 121 - title <- data[row_idx,"title"] 122 - tib_txt <- tibble(line = seq_along(raw_txt[[1]]), text = raw_txt[[1]]) 123 - tmp <- unnest_tokens(tib_txt, word, text) 124 - clean_txt <- anti_join(tmp[!grepl("\\d", tmp $ word),], stop_words) 137 + clean_text <- function(raw_text) { 138 + tmp <- tibble( 139 + line = seq_along(raw_text), 140 + text = raw_text 141 + ) |> unnest_tokens(word, text) 142 + tmp[!grepl("\\d", tmp $ word),] |> anti_join(stop_words) 143 + } 125 144 126 - stem_txt <- mutate(clean_txt, word_stem = wordStem(word)) 127 - word_categories <- word_category_v(clean_txt $ word) 128 - sema_txt <- mutate(clean_txt, tag = word_categories $ word, word_category = word_categories $ word_category) 145 + # Word stems analysis 146 + 147 + for (row_idx in 1:nrow(data)) { 148 + stem_txt <- clean_text(data[row_idx,"variables"][[1]]) |> 149 + mutate(word_stem = wordStem(word)) 129 150 130 151 stem_count <- stem_txt |> 131 152 inner_join(count(stem_txt, word_stem)) |> 132 153 filter(n > 5) |> 133 154 distinct(word_stem, .keep_all = TRUE) 134 155 135 - sema_count <- sema_txt |> 136 - inner_join(count(sema_txt, tag)) |> 137 - distinct(tag, .keep_all = TRUE) 156 + title <- data[row_idx,"title"] 157 + save(sema_count, file = paste("data/stem_", title, ".Rda", sep = "")) 158 + } 159 + 160 + 161 + # Word semantics analysis 162 + 163 + word_semantic_analysis <- function(emb, data, model_name, threshold = 0.3) { 164 + for (row_idx in 1:nrow(data)) { 165 + word_categories <- word_category_v(clean_txt $ word, threshold) 138 166 139 - title <- data[row_idx,"title"] 140 - save(stem_count, file = paste("data/stem_", title, ".Rda", sep = "")) 141 - save(sema_count, file = paste("data/google_sema_", title, ".Rda", sep = "")) 167 + sema_txt <- clean_text(data[row_idx,"variables"][[1]]) |> 168 + mutate(tag = word_categories $ tag, word_category = word_categories $ tag_category) 169 + 170 + sema_count <- sema_txt |> 171 + inner_join(count(sema_txt, tag)) |> 172 + distinct(tag, .keep_all = TRUE) 173 + 174 + title <- data[row_idx,"title"] 175 + save(sema_count, file = paste("data/", model_name, "_", threshold, "_", title, ".Rda", sep = "")) 176 + } 142 177 } 178 + 179 + read.wordvectors("google_vecs.bin", type = "bin") |> 180 + word_semantic_analysis(data = data, model_name = "google_news", threshold = 0.216) 181 + 182 + read.wordvectors("glove.6B.300d.txt", type = "txt") |> 183 + word_semantic_analysis(data = data, model_name = "glove_300d", threshold = 0.154) 184 + 185 + read.wordvectors("glove.6B.200d.txt", type = "txt") |> 186 + word_semantic_analysis(data = data, model_name = "glove_200d", threshold = 0.182) 187 + 188 + read.wordvectors("glove.6B.100d.txt", type = "txt") |> 189 + word_semantic_analysis(data = data, model_name = "glove_100d", threshold = 0.227) 190 + 191 + read.wordvectors("glove.6B.50d.txt", type = "txt") |> 192 + word_semantic_analysis(data = data, model_name = "glove_50d", threshold = 0.270)