如何在 Racket 中提取词干后总结词频?

How to sum up the word frequencies after stemming in Racket?

作为背景,我正在尝试在 Racket 中制作一个 NLP 应用程序,我到达了必须阻止单词的部分(我也获得了它们的频率)。

我正在使用 (planet dyoo/porter-stemmer) 包来阻止,作为示例我们可以这样写:

(map (λ(x) (list (stem (first x)) (second x)))
     '(("cryed" 1)
       ("racketeer" 2)
       ("crying" 3)
       ("playing" 4)
       ("racketing" 5)
       ("plays" 6)
       ("Racket" 7)))

产生:'(("cry" 1) ("racket" 2) ("cry" 3) ("plai" 4) ("racket" 5) ("plai" 6) ("racket" 7))

现在我的目标是总结每个术语的频率,也就是得出:'(("cry" 4) ("racket" 14) ("plai" 10))

我想出了一个办法,但我不喜欢我的解决方案:

(define (frequency string)
  (map (λ(x) (list (first x) (length x)))
       (group-by (λ(x) x) (string-split string))))

(define (recalculate lst)
  (frequency
   (string-join
    (flatten
     (map (λ(x) (make-list (second x) (first x))) lst)))))

基本上我重新输入每个单词的次数与它的频率一样多,然后制作一个包含所有单词的字符串,最后再次计算频率。有没有更简单(更快)的方法来实现这个?

也许我应该补充一点,顺序无关紧要(“plai”可以在“cry”之前出现,等等)。此外,我正在寻找一个更简单的解决方案,因为我将不得不使用更大的数据集,并且我想让它更快(即使 frequency 函数可以更快,我也会很高兴)。

您可以创建一个 add-count 过程,它将一个计数列表和一个新计数作为参数,如果列表中没有类似标记的计数,则将计数添加到列表中,或者将现有计数的新计数。

#lang racket

(define (get-tag c) (first c))

(define (get-val c) (second c))

(define (add-count cs c)
  (let* ((k (get-tag c))
         (v (get-val c))
         (old-count (assoc k cs)))
    (if old-count
        (cons (list k (+ v (get-val old-count)))
              (remove old-count cs))
        (cons c cs))))

此处get-tagget-val只是访问存储在计数中的标记和值的便利程序。 assoc 过程用于提取 cs 中第一个计数的副本,匹配要添加的新计数 c。此计数存储在 old-count 中,其值用于创建新计数,在从原始列表 cs.

中删除 old-count 后添加到列表中

定义了 add-count 过程后,可以定义一个过程 reduce-counts,它遍历所有计数并使用 add-count 将它们累积到一个空列表中。结果列表将合并计数。

(define (reduce-counts cs (acc '()))
  (if (null? cs)
      acc
      (reduce-counts (rest cs) (add-count acc (first cs)))))

这是一个测试运行:

reduce-counts.rkt> (define test-counts '(("cry" 1) ("racket" 2) ("cry" 3) ("play" 4) ("racket" 5) ("play" 6) ("racket" 7)))
reduce-counts.rkt> (reduce-counts test-counts)
'(("racket" 14) ("play" 10) ("cry" 4))

作为替代方法,您可以使用 filter 来收集列表中具有相似标签的计数,并在对值求和后将它们组合成一个新的计数。在过滤输入以删除刚刚组合的标签之前,可以在累加器中收集组合计数。可以递归地重复此过程,直到所有计数都已合并、删除和收集。

;;; An alternate solution
(define (combine-like-counts cs)
  (list (get-tag (first cs))
        (foldl (lambda (c x) (+ x (get-val c))) 0 cs)))

(define (reduce-counts cs (acc '()))
  (if (null? cs)
      acc
      (let* ((k (get-tag (first cs)))
             (k-tag? (lambda (c) (equal? k (get-tag c))))
             (like (filter k-tag? cs))
             (remaining (filter (negate k-tag?) cs)))
        (reduce-counts remaining
                       (cons (combine-like-counts like) acc)))))

此处combine-like-counts程序假定输入列表中的所有计数共享相同的标签,因此通过将标签和所有值的总和放入列表中形成一个新的计数。

新的reduce-counts过程returns当输入为空列表时,无论什么都放在累加器中,否则保存第一个计数的标签并用于创建k-tag? 谓词,然后与 filter 一起使用以创建匹配计数列表和删除所有匹配计数的剩余计数列表。匹配计数列表用 combine-like-counts 组合成一个计数并添加到累加器,累加器与 remaining 一起递归传递给 reduce-counts.

这和以前一样工作,尽管顺序发生了变化:

reduce-counts.rkt> (define test-counts '(("cry" 1) ("racket" 2) ("cry" 3) ("play" 4) ("racket" 5) ("play" 6) ("racket" 7)))
reduce-counts.rkt> (reduce-counts test-counts)
'(("play" 10) ("racket" 14) ("cry" 4))

我怀疑这两种实现会根据输入数据的具体情况而具有不同的性能特征。我的直觉是,对于包含大量每个标签的大输入,第二种方法会更好,但真正的答案将来自对一些代表性数据样本的测试。

如果您真的很关心大量数据的性能,您可以考虑将数据转换为 hash table and using some of the built-in dictionary procedures 以获得类似的解决方案。