我需要以正确的顺序得到结果。它仅适用于小于 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)))))))
问题是您正在反转字符串几次。以下将做：
(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)))))
稍短的版本：
(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被调用的地方（它被替换为除法）。
Uselpa 正确地指出，您给出的代码中的问题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)返回 octits 的列表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。当你 conse并(a b c d)在一起时，你会得到(e a b c d)，当你反转它时，你会得到(d c b a e)，这就是你从base8for返回的东西abcde，这是不对的。如果base8returns首先返回列表中最重要的八位位组中的八位位组，你需要加入e和(a b c d)类似的东西(append '(a b c d) (list 'e))，也就是说
(append (base8 (truncate n 8))
(list (mod n 8)))
这不是特别有效，而且它做了很多列表复制。使用辅助函数以相反的顺序生成八进制列表可能更容易，然后调用该辅助函数，以相反的顺序获取八进制列表，然后反转并返回它。这就是我将展示的下一个解决方案所做的，尽管我将使用一些位运算来处理除以 8 而不是and 。base8truncatemod
由于问题的标题是如何将十进制数转换为 Common Lisp 中的八进制数字列表？，我认为值得考虑一些不使用的选项truncate，因为这可能有点昂贵（例如，请参阅提高将数字转换为列表和 base10 到 base2 的性能quotient，以及使用二进制算术而不是andremainder更快的观察）。
数字的前三位对应于其以 8 为底的第一个数字。这意味着(ldb (byte 3 0) number)给出number除以 8 的余数，并(ash number -3)给出除以 8 的商number。您可以按从最低有效八位字节到最高有效八位字节的顺序收集八位字节通过收集(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只是建立了一个名为. 如果您愿意，可以单独定义它并从以下位置调用它：b8defunbase8
(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来喂累积子句是丑陋的。nconcing或者，您可以在从表单返回之前使用collect into和反转累积列表。nreverseloop
虽然上面的版本足够清晰，但我更喜欢这个版本的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返回多个值的优势。