[bug#37448] ui: 'relevance' connects regexps with a logical and.
diff mbox series

Message ID 20190918155757.4198-1-zimon.toutoune@gmail.com
State New
Headers show
Series
  • [bug#37448] ui: 'relevance' connects regexps with a logical and.
Related show

Commit Message

zimoun Sept. 18, 2019, 3:57 p.m. UTC
Fixes <https://bugs.gnu.org/36763>.
Previously, the logical and connecting the regexps did not output the expected
results (introduced in 8874faaaac665100a095ef25e39c9a389f5a397f).

* guix/ui.scm (relevance)
[score]: Change its arguments.
[regexp->score]: New procedure.
* tests/ui.scm ("package-relevance"): Add test.
---
 guix/ui.scm  | 48 ++++++++++++++++++++++++------------------------
 tests/ui.scm |  5 ++++-
 2 files changed, 28 insertions(+), 25 deletions(-)

Comments

Ludovic Courtès Sept. 19, 2019, 7:54 p.m. UTC | #1
Hey ho,

zimoun <zimon.toutoune@gmail.com> skribis:

> Fixes <https://bugs.gnu.org/36763>.
> Previously, the logical and connecting the regexps did not output the expected
> results (introduced in 8874faaaac665100a095ef25e39c9a389f5a397f).
>
> * guix/ui.scm (relevance)
> [score]: Change its arguments.
> [regexp->score]: New procedure.
> * tests/ui.scm ("package-relevance"): Add test.

Perfect, applied.

Thanks!

Ludo’.

Patch
diff mbox series

diff --git a/guix/ui.scm b/guix/ui.scm
index 7920335928..4be31db047 100644
--- a/guix/ui.scm
+++ b/guix/ui.scm
@@ -13,6 +13,7 @@ 
 ;;; Copyright © 2018 Ricardo Wurmus <rekado@elephly.net>
 ;;; Copyright © 2019 Chris Marusich <cmmarusich@gmail.com>
 ;;; Copyright © 2019 Tobias Geerinckx-Rice <me@tobias.gr>
+;;; Copyright © 2019 Simon Tournier <zimon.toutoune@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -1281,33 +1282,32 @@  weight of this field in the final score.
 
 A score of zero means that OBJ does not match any of REGEXPS.  The higher the
 score, the more relevant OBJ is to REGEXPS."
-  (define (score str)
-    (define scores
-      (map (lambda (regexp)
-             (fold-matches regexp str 0
-                           (lambda (m score)
-                             (+ score
-                                (if (string=? (match:substring m) str)
-                                    5             ;exact match
-                                    1)))))
-           regexps))
-
+  (define (score regexp str)
+    (fold-matches regexp str 0
+                  (lambda (m score)
+                    (+ score
+                       (if (string=? (match:substring m) str)
+                           5             ;exact match
+                           1)))))
+
+  (define (regexp->score regexp)
+    (let ((score-regexp (lambda (str) (score regexp str))))
+      (fold (lambda (metric relevance)
+              (match metric
+                ((field . weight)
+                 (match (field obj)
+                   (#f  relevance)
+                   ((? string? str)
+                    (+ relevance (* (score-regexp str) weight)))
+                   ((lst ...)
+                    (+ relevance (* weight (apply + (map score-regexp lst)))))))))
+            0 metrics)))
+
+  (let ((scores (map regexp->score regexps)))
     ;; Return zero if one of REGEXPS doesn't match.
     (if (any zero? scores)
         0
-        (reduce + 0 scores)))
-
-  (fold (lambda (metric relevance)
-          (match metric
-            ((field . weight)
-             (match (field obj)
-               (#f  relevance)
-               ((? string? str)
-                (+ relevance (* (score str) weight)))
-               ((lst ...)
-                (+ relevance (* weight (apply + (map score lst)))))))))
-        0
-        metrics))
+        (reduce + 0 scores))))
 
 (define %package-metrics
   ;; Metrics used to compute the "relevance score" of a package against a set
diff --git a/tests/ui.scm b/tests/ui.scm
index 2138e23369..d8573e88d8 100644
--- a/tests/ui.scm
+++ b/tests/ui.scm
@@ -267,6 +267,7 @@  Second line" 24))
         (gcrypt (specification->package "guile-gcrypt"))
         (go     (specification->package "go"))
         (gnugo  (specification->package "gnugo"))
+        (libb2  (specification->package "libb2"))
         (rx     (cut make-regexp <> regexp/icase))
         (>0     (cut > <> 0))
         (=0     zero?))
@@ -283,6 +284,8 @@  Second line" 24))
          (=0 (package-relevance go
                                 (map rx '("go" "game"))))
          (>0 (package-relevance gnugo
-                                (map rx '("go" "game")))))))
+                                (map rx '("go" "game"))))
+         (>0 (package-relevance libb2
+                                (map rx '("crypto" "library")))))))
 
 (test-end "ui")