Commit dd5a6697 authored by Ricardo J. Mendez's avatar Ricardo J. Mendez

Taking into account root-times for sort order (#5)

Significant changes in order calculation, see the issue for details.
parent 314168c5
......@@ -4,9 +4,9 @@ Relevance is a smart tab organizer for Chrome, written in ClojureScript.
It’ll create a natural arrangement where the tabs you have spent the longest on, which are expected to be the most relevant, are placed first, and the ones you haven’t read at all are shunted to the end of your list.
[You can read more about it here](https://numergent.com/relevance/).
[You can read more about it here](https://numergent.com/relevance/), which includes a changelog.
This is Relevance 1.0.11-SNAPSHOT.
This is Relevance 1.1.0-SNAPSHOT.
# Building
......
(defproject relevance-chrome "1.0.11-SNAPSHOT"
(defproject relevance-chrome "1.1.0-SNAPSHOT"
:license {:name "MIT License"
:url "https://tldrlegal.com/license/mit-license"}
:dependencies [[org.clojure/clojure "1.8.0"]
......
......@@ -4,7 +4,7 @@
[relevance.data :as data]
[relevance.io :as io]
[relevance.migrations :as migrations]
[relevance.order :refer [time-score score-tabs]]
[relevance.order :refer [time-score sort-by-root]]
[relevance.utils :refer [on-channel url-key host-key hostname is-http? ms-day]]
[relevance.settings :refer [default-settings]]
[khroma.alarms :as alarms]
......@@ -101,10 +101,10 @@
(go
(let [{:keys [settings data]} app-state
{:keys [url-times site-times]} data
tabs (score-tabs (:tabs (<! (windows/get window-id)))
url-times
site-times
settings)]
tabs (sort-by-root (:tabs (<! (windows/get window-id)))
url-times
site-times
settings)]
(doseq [tab tabs]
(tabs/move (:id tab) {:index (:index tab)})))))
......
(ns relevance.order
(:require [relevance.utils :refer [on-channel url-key host-key hostname is-http? ms-day]]))
(:require [relevance.utils :refer [on-channel url-key host-key hostname root is-http? ms-day]]
[relevance.data :refer [accumulate-root-times]]))
;;;;------------------------------------
......@@ -15,44 +16,77 @@
;;;;------------------------------------
(defn time-score
"Returns a score for a tab based on the total time spent at both a URL and
the site the URL belongs to."
"Returns map containing a score for a tab based on the total time spent at
both a URL and the site the URL belongs to, as well as a flag indicating
if it's a priority tab."
[tab url-times site-times settings]
(let [url (:url tab)
idx (:index tab)
url-time (or (:time (get url-times (url-key url)))
0)
is-priority? (and (:sound-to-left? settings)
(:audible tab))
is-penalized? (and (not (is-http? url))
(not is-priority?))
tab-time (cond
;; Add an extra score if it's a priority URL
is-priority? (+ sound-extra-score idx)
;; If a URL is penalized, we want it to at least have a
;; value of 1, otherwise the tab time gets ignored and
;; we'd default to using the raw site time
is-penalized? (max url-time 1)
;; ... otherwise we just go with the raw URL time
:else url-time)
host-time (or (:time (get site-times (host-key (hostname url)))) 0)
total (+ tab-time host-time)
score (if is-penalized? (* total non-http-penalty) total)]
(or (when (pos? tab-time) score)
(- host-time idx))))
(defn score-tabs
"Returns a hashmap of the new tab ids and their indexes, based on a tab list and
the score function for time spent on urls and sites."
[tabs url-times site-times settings]
(->> tabs
(map #(assoc % :time (time-score % url-times site-times settings)))
(sort-by #(* -1 (:time %)))
(map-indexed #(hash-map :index %1
:id (:id %2)))))
(let [url (:url tab)
idx (:index tab)
url-time (or (:time (get url-times (url-key url)))
0)
priority? (and (:sound-to-left? settings)
(:audible tab))
penalized? (and (not (is-http? url))
(not priority?))
tab-time (cond
;; Add an extra score if it's a priority URL
priority? (+ sound-extra-score idx)
;; If a URL is penalized, disregard the time
;; and use its index (it'll get penalized later)
penalized? idx
;; ... otherwise we just go with the raw URL time
:else url-time)
host-time (or (:time (get site-times (host-key (hostname url)))) 0)
total (+ tab-time host-time)
score (if penalized? (* total non-http-penalty) total)]
;; A tab without positive time in it will use its index as a small
;; offset to the host time. That way pages from the same host are
;; lumped together, and new tabs are sorted by index.
{:score (or (when (pos? tab-time) score)
(+ host-time (* 0.1 idx)))
:priority? (not (or (nil? priority?)
(false? priority?)))}))
(defn score-and-sort-simple
"Expects a group of tabs and associates a time score with each."
[tabs url-times site-times settings]
(->> tabs
(map #(merge % (time-score % url-times site-times settings)))
(sort-by #(- (:score %)))))
(defn sort-by-root
"Returns a hashmap of the new tab ids and their indexes, based on a tab list and
the score function for time spent on urls and sites."
[tabs url-times site-times settings]
(let [root-times (accumulate-root-times site-times)]
; (cljs.pprint/pprint tabs)
; (cljs.pprint/pprint root-times)
(->> tabs
;; We first group them by root hostname, sort the tab subgroups,
;; and then sort the groups by the time spend on the root.
(group-by #(root (hostname (:url %))))
(map (fn [[k v]]
(let [scored (score-and-sort-simple v url-times site-times settings)
root-time (get root-times k)
;; We may get a bunch of pages where the root time is 0.
;; In that case, let's sort them by their accumulated score.
idx (if (pos? root-time)
root-time
(apply + (map :score scored)))]
[(- idx)
scored])))
(sort-by first)
;; Discard the root names and just flatten the list
(map second)
flatten
;; Once we have done this, we will need to take priority tabs into
;; account. Those will break from their main group and appear first.
(map-indexed #(assoc %2 :index %1))
(sort-by #(if (:priority? %)
(- (:score %))
(:index %)))
;; Ready!
(map-indexed #(hash-map :index %1
:id (:id %2))))))
\ No newline at end of file
......@@ -522,9 +522,7 @@
(testing "Accumulate root times takes into lumps together pages on the same root"
(is (= {"numergent.com" 39
"kitco.com" 7}
root-times))))
)
root-times)))))
(deftest test-accumulate-after-clean-up
......
This diff is collapsed.
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment