如何改进 APL 程序

  )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 个赞

:rofl:第一次见 APL 我还以为是乱码

1 个赞

我记得论坛是有个 apl 的大佬,感觉他写什么代码都一行就行了。。

是ldbeth

就三点

  1. 不会 tacit function 就要学 比如
L2←+/2*⍨-
avg←+⌿÷≢

当然,这么短的函数我个人自用风格是没必要重新定义名字

  1. 你又不是在用 APL/360,除非马上就要开锅先抄个别人的代码再说,不然一开始不要想用 tradfns () 和 goto ()
  2. 不要试图抄别的语言的代码,直接看原版论文,从数学语言里看怎么实现

你这代码给我看,我是懶得去读的,直接网上查了下论文开读https://theory.stanford.edu/~sergei/papers/kMeansPP-soda.pdf

说实话,我不是 CS 出来的,k means 还从没自己写过,所以 k means++ 要现学的。

那么我没看 paper 前有看出什么门道吗? 就是原本的 k means 是把一团输入分成 k 个 cluster 的算法,所以你一开始就把 k 设成全局变量就是有点问题的。那么你写的代码我也就不用谈改进了,重头写就行了。

那么先来看,原版 k-means 要怎么写呢?

  1. Arbitrarily choose k initial centers C= \{c_1, \ldots , c_k \}.

这很简单,就是 centers←c⌷⍨k?≢c,瞄一眼,你没有写这也很好理解,因为这是 k-means++ 和原版的区别

下一步

  1. 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
  1. 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(并非不想用 :sob:

用啥 org-mode,用记事本

org mode及时反馈比较强

;;; 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

靠 REPL 学不了 APL 哲学,我到最后一步化简之前是不开 REPL 的

所以您真的没有能在org mode babel中使用dyalog的workaround吗?这对我真的很重要(写作业必须用啊 :pleading_face:)。

写报告我都是写 HTML 的,从来不用 org 写东西

1 个赞

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 个赞

我之前尝试学 Dyalog 的时候倒是自己写了个 ob-dyalog.el,只在自己 Linux 上测试过,不知道能不能用。(但是我至今还没把常用动词给记下来,属于是差生文具多了。)

(另外好奇什么学校写作业要用 APL)

可以分享一下吗 :pleading_face:,我做了个但不支持ob session功能,有待开发

交作业 :smiley:
实现了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 个赞

以我拙见,在不熟悉所有语法的情况下,写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