我需要以正确的顺序获得结果。它仅适用于小于 100 的数字。
(base8 8) 给(1 0)，
(base8 20) 给(2 4)，
但是
(base8 100) 提供 (414) 而不是 (144)。
我试了2天，找不到问题。请帮我。
(defun base8(n)
(cond
((zerop (truncate n 8)) (cons n nil))
(t (reverse (cons (mod n 8)
(base8 (truncate n 8)))))))
【问题讨论】：
reverse 问题。
标签： common-lisp octal
问题是您将字符串反转了几次。以下将做：
(defun base8 (n)
(let ((t8 (truncate n 8)) (m8 (mod n 8)))
(if (= t8 0)
(list m8)
(append (base8 t8) (list m8)))))
编辑
这是一个没有append 的解决方案，使用辅助函数。您会清楚地看到 一个 反向就足够了：
(defun base8-helper (n)
(let ((t8 (truncate n 8)) (m8 (mod n 8)))
(cons m8 (if (= t8 0)
nil
(base8-helper t8)))))
(defun base8 (n)
(reverse (base8-helper n)))
或者，使用累加器（尾递归）
(defun base8 (n &optional (acc '()))
(let ((t8 (truncate n 8)) (m8 (mod n 8)))
(if (= t8 0)
(cons m8 acc)
(base8 t8 (cons m8 acc)))))
【讨论】：
append 的递归版本。
truncate 和 mod，如果你可以使用floor，只划分一次而不是两次？
truncate 和 mod。
略短的版本：
(defun number->list (number &key (radix 10))
(loop
:with result := nil
:until (zerop number) :do
(multiple-value-bind (whole remainder)
(floor number radix)
(push remainder result)
(setf number whole))
:finally (return result)))
甚至更短，使用iterate：
(ql:quickload :iterate)
(use-package :iterate)
(defun number->list (number &key (radix 10))
(iter (until (zerop number))
(multiple-value-bind (whole remainder)
(floor number radix)
(setf number whole)
(collect remainder at start))))
我知道优化编译器可能会更改代码以用（无）符号移位替换成本更高的除法，等等。事实上，SBCL 生成的代码与 Joshua Tailor 发布的代码非常相似，但是，只有在提供必要的类型声明和编译声明时才能得到：
(declaim (inline number->list)
(ftype (function (fixnum &key (radix fixnum)) list)))
(defun number->list (number &key (radix 10))
(iter (until (zerop number))
(multiple-value-bind (whole reminder)
(floor number radix)
(setf number whole)
(collect reminder at start))))
(defun test-optimize () (number->list 64 :radix 8))
这反汇编成：
; disassembly for TEST-OPTIMIZE
; 05B02F28: 48C745F080000000 MOV QWORD PTR [RBP-16], 128 ; no-arg-parsing entry point
; 2F30: 48C745E817001020 MOV QWORD PTR [RBP-24], 537919511
; 2F38: E913010000 JMP L6
; 2F3D: 0F1F00 NOP
; 2F40: L0: 488B4DF0 MOV RCX, [RBP-16]
; 2F44: 48894DF8 MOV [RBP-8], RCX
; 2F48: 488B55F0 MOV RDX, [RBP-16]
; 2F4C: 31FF XOR EDI, EDI
; 2F4E: 488D0C25E5030020 LEA RCX, [#x200003E5] ; GENERIC-<
; 2F56: FFD1 CALL RCX
; 2F58: 0F8D2B010000 JNL L8
; 2F5E: 488B55F0 MOV RDX, [RBP-16]
; 2F62: 4C8D1C2581030020 LEA R11, [#x20000381] ; GENERIC-NEGATE
; 2F6A: 41FFD3 CALL R11
; 2F6D: 480F42E3 CMOVB RSP, RBX
; 2F71: 488D5C24F0 LEA RBX, [RSP-16]
; 2F76: 4883EC18 SUB RSP, 24
; 2F7A: 48C7C7FAFFFFFF MOV RDI, -6
; 2F81: 488B0548FFFFFF MOV RAX, [RIP-184] ; #<FDEFINITION object for ASH>
; 2F88: B904000000 MOV ECX, 4
; 2F8D: 48892B MOV [RBX], RBP
; 2F90: 488BEB MOV RBP, RBX
; 2F93: FF5009 CALL QWORD PTR [RAX+9]
; 2F96: 4C8D1C2581030020 LEA R11, [#x20000381] ; GENERIC-NEGATE
; 2F9E: 41FFD3 CALL R11
; 2FA1: 480F42E3 CMOVB RSP, RBX
; 2FA5: 488955F8 MOV [RBP-8], RDX
; 2FA9: 488B55F0 MOV RDX, [RBP-16]
; 2FAD: 4C8D1C2581030020 LEA R11, [#x20000381] ; GENERIC-NEGATE
; 2FB5: 41FFD3 CALL R11
; 2FB8: 480F42E3 CMOVB RSP, RBX
; 2FBC: BF0E000000 MOV EDI, 14
; 2FC1: 4883EC18 SUB RSP, 24
; 2FC5: 48896C2408 MOV [RSP+8], RBP
; 2FCA: 488D6C2408 LEA RBP, [RSP+8]
; 2FCF: B904000000 MOV ECX, 4
; 2FD4: 488B0425580F1020 MOV RAX, [#x20100F58]
; 2FDC: FFD0 CALL RAX
; 2FDE: 48F7DA NEG RDX
; 2FE1: 488B5DF8 MOV RBX, [RBP-8]
; 2FE5: 488955F8 MOV [RBP-8], RDX
; 2FE9: L1: 48837DF800 CMP QWORD PTR [RBP-8], 0
; 2FEE: 741A JEQ L2
; 2FF0: 48895DE0 MOV [RBP-32], RBX
; 2FF4: 488B55F0 MOV RDX, [RBP-16]
; 2FF8: 31FF XOR EDI, EDI
; 2FFA: 488D0C25E5030020 LEA RCX, [#x200003E5] ; GENERIC-<
; 3002: FFD1 CALL RCX
; 3004: 488B5DE0 MOV RBX, [RBP-32]
; 3008: 7C5B JL L7
; 300A: L2: 488BCB MOV RCX, RBX
; 300D: 488B55F8 MOV RDX, [RBP-8]
; 3011: L3: 48894DF0 MOV [RBP-16], RCX
; 3015: 49896C2440 MOV [R12+64], RBP
; 301A: 4D8B5C2418 MOV R11, [R12+24]
; 301F: 498D4B10 LEA RCX, [R11+16]
; 3023: 49394C2420 CMP [R12+32], RCX
; 3028: 0F86C0000000 JBE L9
; 302E: 49894C2418 MOV [R12+24], RCX
; 3033: 498D4B07 LEA RCX, [R11+7]
; 3037: L4: 49316C2440 XOR [R12+64], RBP
; 303C: 7402 JEQ L5
; 303E: CC09 BREAK 9 ; pending interrupt trap
; 3040: L5: 488951F9 MOV [RCX-7], RDX
; 3044: 488B55E8 MOV RDX, [RBP-24]
; 3048: 48895101 MOV [RCX+1], RDX
; 304C: 48894DE8 MOV [RBP-24], RCX
; 3050: L6: 48837DF000 CMP QWORD PTR [RBP-16], 0
; 3055: 0F85E5FEFFFF JNE L0
; 305B: 488B55E8 MOV RDX, [RBP-24]
; 305F: 488BE5 MOV RSP, RBP
; 3062: F8 CLC
; 3063: 5D POP RBP
; 3064: C3 RET
; 3065: L7: BF02000000 MOV EDI, 2
; 306A: 488BD3 MOV RDX, RBX
; 306D: 4C8D1C254C020020 LEA R11, [#x2000024C] ; GENERIC--
; 3075: 41FFD3 CALL R11
; 3078: 480F42E3 CMOVB RSP, RBX
; 307C: 488BCA MOV RCX, RDX
; 307F: 488B55F8 MOV RDX, [RBP-8]
; 3083: 4883C210 ADD RDX, 16
; 3087: EB88 JMP L3
; 3089: L8: 488D5C24F0 LEA RBX, [RSP-16]
; 308E: 4883EC18 SUB RSP, 24
; 3092: 488B55F8 MOV RDX, [RBP-8]
; 3096: 48C7C7FAFFFFFF MOV RDI, -6
; 309D: 488B052CFEFFFF MOV RAX, [RIP-468] ; #<FDEFINITION object for ASH>
; 30A4: B904000000 MOV ECX, 4
; 30A9: 48892B MOV [RBX], RBP
; 30AC: 488BEB MOV RBP, RBX
; 30AF: FF5009 CALL QWORD PTR [RAX+9]
; 30B2: 488955F8 MOV [RBP-8], RDX
; 30B6: 488B55F0 MOV RDX, [RBP-16]
; 30BA: BF0E000000 MOV EDI, 14
; 30BF: 4883EC18 SUB RSP, 24
; 30C3: 48896C2408 MOV [RSP+8], RBP
; 30C8: 488D6C2408 LEA RBP, [RSP+8]
; 30CD: B904000000 MOV ECX, 4
; 30D2: 488B0425580F1020 MOV RAX, [#x20100F58]
; 30DA: FFD0 CALL RAX
; 30DC: 488B5DF8 MOV RBX, [RBP-8]
; 30E0: 488955F8 MOV [RBP-8], RDX
; 30E4: E900FFFFFF JMP L1
; 30E9: CC0A BREAK 10 ; error trap
; 30EB: 02 BYTE #X02
; 30EC: 18 BYTE #X18 ; INVALID-ARG-COUNT-ERROR
; 30ED: 54 BYTE #X54 ; RCX
; 30EE: L9: 6A10 PUSH 16
; 30F0: 4C8D1C2590FF4100 LEA R11, [#x41FF90] ; alloc_tramp
; 30F8: 41FFD3 CALL R11
; 30FB: 59 POP RCX
; 30FC: 488D4907 LEA RCX, [RCX+7]
; 3100: E932FFFFFF JMP L4
注意这一行：2F81，它是函数ash 被调用的地方（它被替换为除法）。
【讨论】：
正确使用pointed out，您给出的代码中的问题是reverse 被调用了太多次。退一步思考这里的定义而不考虑 Lisp 代码可能会很有用。首先，代码是：
(defun base8 (n)
(cond
((zerop (truncate n 8)) (cons n nil))
(t (reverse (cons (mod n 8)
(base8 (truncate n 8)))))))
想法是(base8 n) 返回n 的八位字节列表。
第一种情况，n < 8（您正在使用 (zerop (truncate n 8)) 检查）是正确的。如果n < 8 那么结果应该只是一个包含n 的列表。您可以使用(cons n nil) 来做到这一点（就像您所做的那样），尽管(list n) 可能会更惯用。无论哪种情况，它都是正确的。
虽然递归的情况有点棘手。让我们考虑一个数字n，用八进制写成有五个八进制：abcde。有一个递归调用，(base8 (truncate n 8))。如果我们假设base8 在子情况下正常工作，那么这意味着
(base8 (truncate abcde 8)) ===
(base8 abcd) ===
'(a b c d)
现在，(mod n 8) 返回e。当你将e 和(a b c d) 组合在一起时，你会得到(e a b c d)，当你反转它时，你会得到(d c b a e)，这就是你从base8 返回的abcde，这不是对。如果base8 返回列表中的八位字节，最重要的八位字节在前，你需要将e 和(a b c d) 加入(append '(a b c d) (list 'e)) 之类的东西，也就是说
(append (base8 (truncate n 8))
(list (mod n 8)))
这不是特别有效，而且它会进行大量的列表复制。使用 helper 函数以 reverse 顺序生成八进制列表可能更容易，然后让base8 调用该辅助函数，以相反的顺序获取八进制列表, 并反转并返回它。这就是我将展示的下一个解决方案所做的，尽管我将使用一些位运算来处理除以 8 而不是 truncate 和 mod。
由于问题的标题是How do I convert a decimal number to a list of octal digits in Common Lisp?，我认为值得考虑一些不使用truncate 的选项，因为这可能有点贵（例如，请参阅Improving performance for converting numbers to lists, and base10 to base2，以及观察到使用二进制算术而不是 quotient 和 remainder 更快）。
数字的前三位对应其以 8 为基数的第一个数字。这意味着 (ldb (byte 3 0) number) 给出了 number 除以 8 的余数，(ash number -3) 给出了 number 除以 8 的商. 您可以通过收集(ldb (byte 3 0) number) 并将number 更新为(ash number -3)，按照从最低到最高有效八位字节的顺序收集八位字节。如果您希望数字中最不重要的八位字节排在列表的首位，您可以返回 (nreverse octits) 而不是 octits。
(defun base8 (number)
(do ((octits '() (cons (ldb (byte 3 0) number) octits))
(number number (ash number -3)))
((zerop number) octits)))
CL-USER> (base8 123)
(1 7 3)
CL-USER> (base8 11)
(1 3)
CL-USER> (base8 83)
(1 2 3)
前面代码的结构是迭代的，但是直接对应一个递归的版本。如果您更喜欢递归版本，那就是：
(defun base8 (number)
(labels ((b8 (number octits)
(if (zerop number)
octits
(b8 (ash number -3)
(cons (ldb (byte 3 0) number)
octits)))))
(b8 number '())))
该代码中的labels 只是建立了一个名为b8 的本地 函数。如果您愿意，可以使用单独的 defun 定义它并从 base8 调用它：
(defun base8 (number)
(b8 number '()))
(defun b8 (number octits)
(if (zerop number)
octits
(b8 (ash number -3)
(cons (ldb (byte 3 0) number)
octits))))
这是一个愚蠢的解决方案，将数字写入八进制，然后将每个数字字符转换为相应的数字：
(defun base8 (number)
(map 'list #'(lambda (x)
(position x "01234567" :test 'char=))
(write-to-string number :base 8)))
【讨论】：
我会使用loop 来做这个：
(defun as-base-n-list (n base)
(check-type n (integer 0) "a nonnegative integer")
(check-type base (integer 1) "a positive integer")
(loop for x = n then (floor x base)
nconcing (list (mod x base))
while (>= x base)))
(defun base8 (n)
(as-base-n-list n 8))
需要使用list 来喂the nconcing accumulation clause 是丑陋的。或者，您可以使用collect into 并在从loop 表单返回之前使用nreverse 反转累积列表。
虽然上面的版本已经足够清晰了，但我更喜欢as-base-n-list这个版本，它消除了上面对mod的冗余调用：
(defun as-base-n-list (n base)
(check-type n (integer 0) "a nonnegative integer")
(check-type base (integer 1) "a positive integer")
(loop with remainder
do (multiple-value-setq (n remainder) (floor n base))
nconcing (list remainder)
until (zerop n)))
这个利用floor返回多个值。
【讨论】：
n 的商衰减为零。