[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[bug#28452] [PATCH 1/6] ui: Generalize relevance computation.
From: |
Ludovic Courtès |
Subject: |
[bug#28452] [PATCH 1/6] ui: Generalize relevance computation. |
Date: |
Wed, 13 Sep 2017 23:24:18 +0200 |
* 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
- [bug#28452] [PATCH 0/6] On-line doc and search for services, Ludovic Courtès, 2017/09/13
- [bug#28452] [PATCH 1/6] ui: Generalize relevance computation.,
Ludovic Courtès <=
- [bug#28452] [PATCH 2/6] services: Add a description and location for each service type., Ludovic Courtès, 2017/09/13
- [bug#28452] [PATCH 3/6] services: Add 'fold-service-types'., Ludovic Courtès, 2017/09/13
- [bug#28452] [PATCH 5/6] services: base: Add descriptions., Ludovic Courtès, 2017/09/13
- [bug#28452] [PATCH 6/6] services: networking: Add descriptions., Ludovic Courtès, 2017/09/13
- [bug#28452] [PATCH 4/6] guix system: Add 'search' command., Ludovic Courtès, 2017/09/13
- [bug#28452] [PATCH 0/6] On-line doc and search for services, Christopher Baines, 2017/09/14