我需要以正确的顺序得到结果。它适用于仅少于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)))))))
答案 0 :(得分：2)
问题是你正在反转字符串几次。以下是：
(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)))
或者，使用累加器（tail-recursive）
(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)))))
答案 1 :(得分：1)
正确使用“正确”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)，这就是你从{{1}返回的内容} base8，这是不对的。如果abcde返回首先返回具有最高有效八位字节的列表中的八位字节，则需要将base8和e加入(a b c d)之类的内容，也就是说
(append '(a b c d) (list 'e))这不是特别有效，它会进行大量的列表复制。使用 helper 函数以 reverse 顺序生成八进制列表可能更容易，然后让(append (base8 (truncate n 8))
(list (mod n 8)))
调用该辅助函数，获取八进制列表逆序，反转并返回。这就是我将展示的下一个解决方案，虽然我将使用一些位操作来处理除法，而不是base8和truncate。
由于问题的标题是How do I convert a decimal number to a list of octal digits in Common Lisp?，我认为值得考虑一些不使用mod的选项，因为这可能有点贵（例如，请参阅Improving performance for converting numbers to lists, and base10 to base2 ，并且观察到使用二进制算法而不是truncate和quotient更快。）
数字的前三位对应于基数为8的第一个数字。这意味着remainder给出(ldb (byte 3 0) number)的余数除以8，而number给出的商数为(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的本地函数。如果您愿意，可以使用单独的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))))
答案 2 :(得分：0)
我将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并使用nreverse反转累积列表，然后从loop表单返回。
虽然上面的版本足够清晰，但我更喜欢这个版本的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返回多个值。
答案 3 :(得分：0)
略短的版本：
(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的地方（代替除法）。