)clear
⍝ 中心选择
MAX←2*32
K←2
L2←{+/(⍺-⍵)*2}
∇C←R KINI X;D;P;T
C←R
→(K>⍴C)↓0,Loop
⍝(⊂[2]X) ∘.- (⊂[2]R)
Loop:
P←+\D[T←⍸D]÷+/D←⌊/X∘.L2 C ⍝P is a list of [0,1] probability intervals.
C←C,X[T[{P⍸MAX÷⍨?MAX⊣⍵}⍣{⍺≠0}0]]
→(K>⍴C)/Loop
∇
∇C←R KM X;K;aver;iter
C←R⋄K←⍴R
⍝(⊂[2]X) ∘.- (⊂[2]R)
aver←{(+/⍵)÷⍴⍵}
iter←{⎕←,⊃aver¨(,/(⍳K)∘.=↑¨⍋¨,/X∘.L2 ⍵)/¨⊂X}
C←iter⍣≡C ⍝ use identical!
∇
这是我写的K-Means++,iter 过于冗长,如何更apl的写出该程序呢?更一般的,如何找到任意程序最符合apl哲学的写法
1 个赞
rua
2025 年11 月 5 日 03:09
3
我记得论坛是有个 apl 的大佬,感觉他写什么代码都一行就行了。。
就三点
不会 tacit function 就要学
比如
L2←+/2*⍨-
avg←+⌿÷≢
当然,这么短的函数我个人自用风格是没必要重新定义名字
你又不是在用 APL/360,除非马上就要开锅先抄个别人的代码再说,不然一开始不要想用 tradfns (∇) 和 goto (→)
不要试图抄别的语言的代码,直接看原版论文,从数学语言里看怎么实现
你这代码给我看,我是懶得去读的,直接网上查了下论文开读https://theory.stanford.edu/~sergei/papers/kMeansPP-soda.pdf
说实话,我不是 CS 出来的,k means 还从没自己写过,所以 k means++ 要现学的。
那么我没看 paper 前有看出什么门道吗?
就是原本的 k means 是把一团输入分成 k 个 cluster 的算法,所以你一开始就把 k 设成全局变量就是有点问题的。那么你写的代码我也就不用谈改进了,重头写就行了。
那么先来看,原版 k-means 要怎么写呢?
Arbitrarily choose k initial centers C= \{c_1, \ldots , c_k \} .
这很简单,就是 centers←c⌷⍨k?≢c,瞄一眼,你没有写这也很好理解,因为这是 k-means++ 和原版的区别
下一步
For each i \in \{1, \ldots, k\} , set the cluster C_i to be the set of points in \chi that are closer to c_i than they are to c_j for all j\neq i .
这里我大概看出来你也想过了 outer product,但我觉得作为一个 prototype,你抽象用少了
distances←centers∘.(+/2*⍨-)⍥↓c
clustering←(⊃⍋)⍤1⊢distances
For each i \in \{1, \ldots, k\} , set c_i to be the center of mass of all points in C_i
这里要能想到用 ⌸ 就会赢了
newcenters←clustering{(+⌿⍵)÷≢⍵}⌸c
最后给出优化之前的 k-means
kmeans←{
pad1←⍳⍺ ⋄ pad2←(⍺,2)⍴0
{(pad2⍪ds){(+⌿⍵)÷≢⍵}⌸⍨pad1,(⊃⍋)⍤1⊢ds∘.(+/2*⍨-)⍥↓⍵}⍣≡⍵⌷⍨⊂⍺?≢ds←⍵
}
简化一下(再修个 bug)
kmeans←{
i←⍳⍺ ⋄ p←⍵⍪⍨0⍴⍨⍺,2
{p{(+⌿⍵)÷¯1+≢⍵}⌸⍨i,(⊃⍋)⍤1⊢d∘.(+/2*⍨-)⍥↓⍵}⍣≡⍵⌷⍨⊂⍺?≢d←⍵
}
tacit 化
kmeans←{((⍵↑⍨-⍺+≢⍵)(1(+⌿÷≢)⍤↓⊢)⌸⍨(⍳⍺),(⊃⍋)⍤1⍤(⍵∘.(+/2*⍨-)⍥↓⊢))⍣≡⍵⌷⍨⊂⍺?≢⍵}
2 个赞
需求是输入给定初始中心点(作业要求),然后本地gnu-apl可以集成org-mode,但dyalog不太会集成,所以用不了Key 和tacit(并非不想用 )
;;; ob-gnu-apl.el --- Minimal Org Babel support for GNU APL -*- lexical-binding: t; -*-
(require 'ob)
(defvar org-babel-gnu-apl-command "apl -s"
"Command used to start GNU APL interpreter.")
(defvar org-babel-gnu-apl-results "value"
"Results form of GNU APL.")
(defvar org-babel-gnu-apl--sessions (make-hash-table :test 'equal)
"Persistent GNU APL process for reuse.")
(defun org-babel-gnu-apl--get-session (&optional name cmd)
"Return a running GNU APL process, starting one if needed.
If command is given, use it insteand of org-babel-gnu-apl-command."
(let* ((session-name (or name "default"))
(process (gethash session-name org-babel-gnu-apl--sessions)))
(unless (and process (process-live-p process))
(setq process
(start-process
(format "gnu-apl-%s" session-name)
(format "*gnu-apl-%s*" session-name)
shell-file-name shell-command-switch
(or cmd org-babel-gnu-apl-command)))
(puthash session-name process org-babel-gnu-apl--sessions)
(sleep-for 0.1))
process)
)
(defun org-babel-gnu-apl-format-results (str results)
"Format STR (raw APL output) according to RESULTS type for Org Babel."
(let* ((clean (string-trim str))
(result-type (downcase (if (stringp results) results "value"))))
(cond
;; 1. 输出模式,直接返回原文
((string-match-p "\\bverbatim\\b" result-type)
clean)
;; 2. 表格输出:尝试按空格/换行拆分
((string-match-p "\\btable\\b" result-type)
(mapcar (lambda (row)
(split-string (string-trim row)))
(split-string clean "\n" t)))
;; 3. 标量输出(单个值)
((string-match-p "\\bscalar\\b" result-type)
(if (string-match-p "^[0-9.eE+¯]+$" clean)
(string-to-number clean)
clean))
;; 4. 默认是 “value”:尝试猜测结构
((string-match-p "\\bvalue\\b" result-type)
(condition-case nil
(if (string-match-p "\n" clean)
;; 多行 ⇒ 矩阵形式
(mapcar (lambda (row) (split-string (string-trim row)))
(split-string clean "\n" t))
;; 单值
(if (string-match-p "^[0-9.eE+¯]+$" clean)
(string-to-number clean)
clean))
(error clean)))
;; 5. 兜底:返回原始字符串
(t clean))))
(defun org-babel-execute:gnu-apl (body params)
"Execute APL code in BODY using GNU APL. Reuses a persistent process."
(let* ((session-name (cdr (assq :session params)))
(cmd (or (cdr (assq :cmd params)) org-babel-gnu-apl-command))
(results (or (cdr (assq :results params)) org-babel-gnu-apl-results))
(session (org-babel-gnu-apl--get-session session-name cmd))
(marker (format "__END_%d__" (random 100000)))
(code (concat body "\n⎕←'" marker "'\n"))
(output ""))
(with-current-buffer (process-buffer session)
(erase-buffer))
(process-send-string session code)
(while (not (string-match marker (with-current-buffer (process-buffer session)
(buffer-string))))
(sleep-for 0.05))
(setq output
(replace-regexp-in-string "CLEAR WS\n?" "" (replace-regexp-in-string (concat "\n?" marker ".*") "" (with-current-buffer (process-buffer session)
(buffer-string))))
)
(org-babel-gnu-apl-format-results output results)
)
)
(provide 'ob-gnu-apl)
;;; ob-gnu-apl.el ends here
自己搓的gnu-apl 照理只要改改就能上dyalog
LdBeth
2025 年11 月 5 日 10:54
10
靠 REPL 学不了 APL 哲学,我到最后一步化简之前是不开 REPL 的
所以您真的没有能在org mode babel中使用dyalog的workaround吗?这对我真的很重要(写作业必须用啊 )。
LdBeth
2025 年11 月 5 日 14:05
12
写报告我都是写 HTML 的,从来不用 org 写东西
1 个赞
LdBeth
2025 年11 月 5 日 14:16
13
k-means++ 选中心点的方法
kinit←{
⎕io←0
m←(≢⍵)↑(⍸⍣¯1)1?≢⍵
a←m⌿⍵ ⋄ b←(~m)⌿⍵
loop←{
d←⌊⌿a∘.(+/2*⍨-)⍥↓b
a⍪←b⌷⍨+/m←(?0)>+\d÷+/d
b⊢←(~⌽<\⌽m)⌿b
a
}
loop⍣(⍺-1)⊢a
}
最后 k-means++
kmpp←{
⎕io←0
b←⍵⌿⍨~m←(≢⍵)↑(⍸⍣¯1)1?≢⍵ ⋄ a←m⌿⍵ ⋄ d←∘.(+/2*⍨-)⍥↓
loop←{a⊣b⊢←b⌿⍨~⌽<\⌽m⊣a⍪←b⌷⍨+/m←(?0)>+\(⊢÷+/)⌊⌿a d b}
((⍵↑⍨-⍺+≢⍵)(1(+⌿÷≢)⍤↓⊢)⌸⍨(⍳⍺),(⊃⍋)⍤1⍤(⍵d⊢))⍣≡loop⍣(⍺-1)⊢a
}
1 个赞
Kana
2025 年11 月 5 日 14:24
14
我之前尝试学 Dyalog 的时候倒是自己写了个 ob-dyalog.el ,只在自己 Linux 上测试过,不知道能不能用。(但是我至今还没把常用动词给记下来,属于是差生文具多了。)
(另外好奇什么学校写作业要用 APL)
可以分享一下吗 ,我做了个但不支持ob session功能,有待开发
交作业
实现了kernel kmeans 算法
算法描述
L2(\phi(x), \mu_{i}) = L2(\phi (x), \text{average} \{...,\phi(x_{i,j}),...\}) = K(x,x) - 2\times\text{average}K(x,x_{i}) + \text{average}K(x_{i_{j}},x_{i_{k}})
thus ITER(N,i) = \text{arg i min} -2\times\text{average}K(x_{N},x_{i}) + \text{average}K(x_{i_{j}},x_{i_{k}})
这样的L2 便只跟K 与上一次的分类结果有关。
代码实现
kkm←{
M←∘.⍺⍺⍨↓⍵⋄N←≢⍵⋄K←⍺⋄aver←+/÷(0⊥⍴)
{{⊂⍵}⌸⊣/∘⍋¨↓⍉↑{(aver(⍣2)M[∘.,⍨⍵])-2×(aver M[(⍳N)(∘.,)⍵])}¨⍵}⍣≡1⍴¨K?N
}
⍝ X←↑(1 1) (1 2)(¯2 ¯1) (¯2 ¯2) (10 10) (10 11) (11 10) (11 11) (¯10 ¯10) (¯10 ¯11) (¯11 ¯10) (¯11 ¯11) (10 ¯10) (10 ¯11) (11 ¯10) (11 ¯11) (¯10 10) (¯10 11) (¯11 10) (¯11 11 ) (2 1) (2 2) (¯1 ¯1) (¯1 ¯2)
X←↑(5.00 0.00) (4.80 0.30) (4.70 0.50) (4.50 1.00) (3.50 3.00) (0.00 5.00) (-2.50 4.50) (-4.00 3.00) (-5.00 0.00) (-4.50 -2.50) (-3.00 -4.00) (0.00 -5.00) (3.00 -4.00) (4.00 -3.00) (4.50 -2.00) (4.70 -1.00) (4.90 0.10) (4.80 0.30) (4.60 0.50) (4.50 0.70) (0.00 20.00) (1.00 20.20) (2.00 20.50) (3.00 21.00) (4.00 21.50) (5.00 22.00) (6.00 22.50) (7.00 23.00) (8.00 23.50) (9.00 24.00) (10.00 24.50) (11.00 25.00) (12.00 25.50) (13.00 26.00) (14.00 26.50) (15.00 27.00) (16.00 27.50) (17.00 28.00) (18.00 28.50) (19.00 29.00)
⍝k←1(*⍨)(+.×)
k←{*(-(+/(⍺-⍵)*2))}
⎕←{X[⍵;]}¨2 (k kkm) X
1 个赞
uiu007
2025 年11 月 12 日 03:47
17
以我拙见,在不熟悉所有语法的情况下,写apl不能太过自信,每个分块写完一定要测试一下,一开始最好把动词写开,组合时才能看得清楚。写算法可以多看原型数学表达,这种翻译成apl才算舒适区。
此外,在写apl时,确实不应该老想着goto,想写得漂亮些得用些不一样的写法。不过我个人其实把apl常常写成纯函数式,也不能多建议什么了。
请教阁下,动态规划算法用apl怎么写漂亮 如下是 EM 算法 隐马尔科夫链的一部分 E step。我写了个尾递归但很奇怪
alpha←(0 2⍴⍬) {OB VA←⍵[⍳2]
0=≢OB:⍺
al←B[;⊃OB]×VA
(⍺⍪al)∇(1↓OB)(al+.×A)} O pi