-
Notifications
You must be signed in to change notification settings - Fork 0
/
org-roam-similarity.el
168 lines (146 loc) · 7.4 KB
/
org-roam-similarity.el
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
;;; org-roam-similarity.el -- show similar org-roam nodes based on embeddings
;; Copyright (C) 2023 Charl P. Botha
;; Author: Charl P. Botha <[email protected]>
;; Version: 1.0
;; Package-Requires: ((org-roam "2.2.2"))
;; Keywords: org, similarity
;; URL: https://github.com/cpbotha/org-roam-similarity
;; TODO: if region selected, then only search for that region
;; without this, I was getting void-function org-all-archive-files
(require 'org-archive)
(require 'org-roam)
;; this takes less than a second for my 1700 nodes
;; markdown export above takes a few minutes in contrast
;; the price is that we're getting some orgmode cruft as part of the deal
(defun ors--export-node-as-native (node)
"Export the given node as is (md file, org file, org subtree) and save it in a file."
(let* ((file (org-roam-node-file node))
(id (org-roam-node-id node))
(point (org-roam-node-point node))
(title (org-roam-node-title node))
(file-mtime (org-roam-node-file-mtime node))
;; silence "Need absolute ‘org-attach-id-dir’ to attach in buffers without filename" error
(org-attach-directory "/tmp"))
;;(message "%s - %s" file title)
(with-temp-buffer
(insert-file-contents file)
(goto-char point)
;; if source buffer is already md, just copy over the whole thing
;; if not, export the current node, which could be a heading within an org file
(let* ((txt (if (or (string= "md" (file-name-extension file)) (= point 1))
(buffer-string)
(progn
(let* ((element (org-element-at-point))
(begin (org-element-property :begin element))
(end (org-element-property :end element)))
(buffer-substring begin end)) )
)))
(with-temp-file (concat id ".txt")
(insert txt))))))
;;;###autoload
(defun ors-export-org-roam-nodes (target-dir)
(interactive "DSelect org-roam nodes txt export directory: ")
;; the exporter breaks on includes, so here we temporarily blot out that function
(cl-letf (((symbol-function 'org-export-expand-include-keyword) #'(lambda()))
((symbol-function #'run-mode-hooks) #'ignore) ;; for speed
)
(let ((default-directory target-dir)
(node-list (org-roam-node-list)))
(message "======> exporting %d nodes" (length node-list))
(dolist (node node-list)
(ors--export-node-as-native node)
))
(message "DONE.")))
;; add function to org-roam-mode-sections (by default it has two: backlinks and reflinks)
(require 'url)
(require 'json)
(defun ors--get-similar-nodes (text)
"Return list of node,score representing most similar nodes to TEXT."
(let* ((url "http://localhost:3814/similar/")
(url-request-method "POST")
(url-request-extra-headers '(("Content-Type" . "application/json")))
;; have to utf-8 encode json-encode's result
;; see https://lists.gnu.org/archive/html/emacs-devel/2020-06/msg00515.html
(url-request-data (encode-coding-string (json-encode `(("text" . ,text))) 'utf-8))
(response-buffer (url-retrieve-synchronously url nil nil 5))
json-array)
(with-current-buffer response-buffer
(goto-char url-http-end-of-headers)
;; this is a vector of vectors
(setq json-array (json-read))
(kill-buffer))
;; json-array is a vector with nested two-element (id, similarity-value) vectors
;; we mapcar over it, converting the outer vec to list, while we convert each
;; inner 2-element vector to a list with (append v nil)
;; first element extraction from vector would have been: (aref v 0)
(mapcar (lambda (v) (append v nil)) json-array)))
;;;###autoload
(cl-defun org-roam-node-find-similar (&optional other-window initial-input pred &key templates)
"Find and open org-roam nodes that are similar to the current region or buffer.
This is otherwise identical to `org-roam-node-find'."
(interactive current-prefix-arg)
(let* ((region-or-buffer (if (use-region-p)
(buffer-substring-no-properties (region-beginning) (region-end))
(buffer-string)))
(node-ids-scores (ors--get-similar-nodes region-or-buffer))
(sim-node-ids (mapcar #'car node-ids-scores))
(node (org-roam-node-read initial-input
(lambda (node)
;; if node's id is in the list of similar nodes, keep it
(member (org-roam-node-id node) sim-node-ids))
(lambda (completion-a completion-b)
;; sort by similarity score, highest at the top of course
(message "%s" node-ids-scores)
(let* ((node-id-a (org-roam-node-id (cdr completion-a)))
(node-id-b (org-roam-node-id (cdr completion-b)))
(score-a (car (cdr (assoc node-id-a node-ids-scores))))
(score-b (car (cdr (assoc node-id-b node-ids-scores))))
)
(< score-b score-a)
)
))))
(if (org-roam-node-file node)
(org-roam-node-visit node other-window)
(org-roam-capture-
:node node
:templates templates
:props '(:finalize find-file)))))
;;;###autoload
(defun org-roam-similarity-section (node)
"The similarity section for NODE."
;; NOTES:
;; - org-roam-node-marker shows how to find buffer visiting node file
;; get string text of current node
;; send that to the backend to get list of nodes
(let* ((file (org-roam-node-file node))
(id (org-roam-node-id node))
(point (org-roam-node-point node))
(buffer (or (find-buffer-visiting file)
(find-file-noselect file)))
node-text
node-ids)
(with-current-buffer buffer
(save-excursion
(goto-char point)
(setq node-text (if (or (string= "md" (file-name-extension file)) (= point 1))
(buffer-string)
(progn
(let* ((element (org-element-at-point))
(begin (org-element-property :begin element))
(end (org-element-property :end element)))
(buffer-substring begin end)) )
))))
;; obviously the most similar node will be us, so we see ourselves out haha
(when-let ((node-ids-scores (cl-remove-if (lambda (v) (string= (nth 0 v) id)) (ors--get-similar-nodes node-text))))
(magit-insert-section (org-roam-similarity)
(magit-insert-heading "Similar notes:")
(dolist (node-id-score node-ids-scores)
;;
(when-let ((snode (org-roam-node-from-id (car node-id-score))))
(org-roam-node-insert-section
:source-node snode
:point (org-roam-node-point snode)
;; hack: I'm using the outline property to render the scores
:properties `(:outline (,(format "%.3f" (nth 1 node-id-score)))))))
(insert ?\n)))))
(provide 'org-roam-similarity)