unofficial mirror of guix-patches@gnu.org 
 help / color / mirror / code / Atom feed
From: "Ludovic Courtès" <ludo@gnu.org>
To: 28452@debbugs.gnu.org
Subject: [bug#28452] [PATCH 1/6] ui: Generalize relevance computation.
Date: Wed, 13 Sep 2017 23:24:18 +0200	[thread overview]
Message-ID: <20170913212423.5037-1-ludo@gnu.org> (raw)
In-Reply-To: <20170913211756.4843-1-ludo@gnu.org>

* guix/ui.scm (relevance, package-relevance): New procedures.
(%package-metrics): New variable.
* guix/scripts/package.scm (find-packages-by-description)[score]
[package-score]: Remove.  Use 'package-relevance' instead.
---
 guix/scripts/package.scm | 21 +--------------------
 guix/ui.scm              | 43 +++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 44 insertions(+), 20 deletions(-)

diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm
index 9ec6950c4..4adc70522 100644
--- a/guix/scripts/package.scm
+++ b/guix/scripts/package.scm
@@ -246,27 +246,8 @@ specified in MANIFEST, a manifest object."
   "Return two values: the list of packages whose name, synopsis, or
 description matches at least one of REGEXPS sorted by relevance, and the list
 of relevance scores."
-  (define (score str)
-    (let ((counts (filter-map (lambda (regexp)
-                                (match (regexp-exec regexp str)
-                                  (#f #f)
-                                  (m  (match:count m))))
-                              regexps)))
-      ;; Compute a score that's proportional to the number of regexps matched
-      ;; and to the number of matches for each regexp.
-      (* (length counts) (reduce + 0 counts))))
-
-  (define (package-score package)
-    (+ (* 3 (score (package-name package)))
-       (* 2 (match (package-synopsis package)
-              ((? string? str) (score (P_ str)))
-              (#f              0)))
-       (match (package-description package)
-         ((? string? str) (score (P_ str)))
-         (#f              0))))
-
   (let ((matches (fold-packages (lambda (package result)
-                                  (match (package-score package)
+                                  (match (package-relevance package regexps)
                                     ((? zero?)
                                      result)
                                     (score
diff --git a/guix/ui.scm b/guix/ui.scm
index b0108d070..a51877c04 100644
--- a/guix/ui.scm
+++ b/guix/ui.scm
@@ -85,6 +85,8 @@
             string->recutils
             package->recutils
             package-specification->name+version+output
+            relevance
+            package-relevance
             string->generations
             string->duration
             matching-generations
@@ -1024,6 +1026,47 @@ WIDTH columns.  EXTRA-FIELDS is a list of symbol/value pairs to emit."
             extra-fields)
   (newline port))
 
+(define (relevance obj regexps metrics)
+  "Compute a \"relevance score\" for OBJ as a function of its number of
+matches of REGEXPS and accordingly to METRICS.  METRICS is list of
+field/weight pairs, where FIELD is a procedure that returns a string
+describing OBJ, and WEIGHT is a positive integer denoting the 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)
+    (let ((counts (filter-map (lambda (regexp)
+                                (match (regexp-exec regexp str)
+                                  (#f #f)
+                                  (m  (match:count m))))
+                              regexps)))
+      ;; Compute a score that's proportional to the number of regexps matched
+      ;; and to the number of matches for each regexp.
+      (* (length counts) (reduce + 0 counts))))
+
+  (fold (lambda (metric relevance)
+          (match metric
+            ((field . weight)
+             (match (field obj)
+               (#f  relevance)
+               (str (+ relevance
+                       (* (score str) weight)))))))
+        0
+        metrics))
+
+(define %package-metrics
+  ;; Metrics used to compute the "relevance score" of a package against a set
+  ;; of regexps.
+  `((,package-name . 3)
+    (,package-synopsis-string . 2)
+    (,package-description-string . 1)))
+
+(define (package-relevance package regexps)
+  "Return a score denoting the relevance of PACKAGE for REGEXPS.  A score of
+zero means that PACKAGE does not match any of REGEXPS."
+  (relevance package regexps %package-metrics))
+
 (define (string->generations str)
   "Return the list of generations matching a pattern in STR.  This function
 accepts the following patterns: \"1\", \"1,2,3\", \"1..9\", \"1..\", \"..9\"."
-- 
2.14.1

  reply	other threads:[~2017-09-13 21:25 UTC|newest]

Thread overview: 9+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
2017-09-13 21:17 [bug#28452] [PATCH 0/6] On-line doc and search for services Ludovic Courtès
2017-09-13 21:24 ` Ludovic Courtès [this message]
2017-09-13 21:24   ` [bug#28452] [PATCH 2/6] services: Add a description and location for each service type Ludovic Courtès
2017-09-13 21:24   ` [bug#28452] [PATCH 3/6] services: Add 'fold-service-types' Ludovic Courtès
2017-09-13 21:24   ` [bug#28452] [PATCH 4/6] guix system: Add 'search' command Ludovic Courtès
2017-09-13 21:24   ` [bug#28452] [PATCH 5/6] services: base: Add descriptions Ludovic Courtès
2017-09-13 21:24   ` [bug#28452] [PATCH 6/6] services: networking: " Ludovic Courtès
2017-09-14  7:37 ` [bug#28452] [PATCH 0/6] On-line doc and search for services Christopher Baines
2017-09-16 16:13   ` bug#28452: " Ludovic Courtès

Reply instructions:

You may reply publicly to this message via plain-text email
using any one of the following methods:

* Save the following mbox file, import it into your mail client,
  and reply-to-all from there: mbox

  Avoid top-posting and favor interleaved quoting:
  https://en.wikipedia.org/wiki/Posting_style#Interleaved_style

  List information: https://guix.gnu.org/

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to=20170913212423.5037-1-ludo@gnu.org \
    --to=ludo@gnu.org \
    --cc=28452@debbugs.gnu.org \
    /path/to/YOUR_REPLY

  https://kernel.org/pub/software/scm/git/docs/git-send-email.html

* If your mail client supports setting the In-Reply-To header
  via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line before the message body.
Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/guix.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).