问题
I need to have the result in correct order. It works for numbers less than 100 only.
(base8 8) gives (1 0),
(base8 20) gives (2 4),
but
(base8 100) gives (414) instead of (144).
I tried for 2 days and can not find the problem. Please help me.
(defun base8(n)
(cond
((zerop (truncate n 8)) (cons n nil))
(t (reverse (cons (mod n 8)
(base8 (truncate n 8)))))))
回答1:
The problem is that you are reversing the string a few times. The following will do:
(defun base8 (n)
(let ((t8 (truncate n 8)) (m8 (mod n 8)))
(if (= t8 0)
(list m8)
(append (base8 t8) (list m8)))))
EDIT
Here's a solution without append, using a helper function. You'll see clearly that one reverse is enough:
(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)))
or, with an accumulator (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)))))
回答2:
A slightly shorter version:
(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)))
And even shorter, using 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))))
I knew that optimizing compilers could potentially change the code to replace more costly division with (un-)signed shifts and what not. And indeed SBCL generates the code that does something very similar to what Joshua Tailor posted, however, you get this only if you provide necessary type declaration and compilation declarations:
(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))
This disassembles into:
; 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
Note the line: 2F81, it is where the function ash is called (which was substituted for division).
回答3:
The problem with your current code
Uselpa correctly pointed out that the problem in the code you've given is that reverse is called too many times. It may be useful to take a step back and think of the definition here without thinking about Lisp code. First, the code was:
(defun base8 (n)
(cond
((zerop (truncate n 8)) (cons n nil))
(t (reverse (cons (mod n 8)
(base8 (truncate n 8)))))))
The idea is that (base8 n) returns the list of octits of n.
The first case, where n < 8 (which you're checking with (zerop (truncate n 8))) is right. If n < 8 then the result should simply be a list containing n. You can do that (as you did) with (cons n nil), though (list n) would probably be more idiomatic. In either case, it's right.
The recursive case is a bit trickier though. Let's consider a number n which, written in octal has five octits: abcde. There's a recursive call, (base8 (truncate n 8)). If we assume that base8 works correctly for the subcase, then this means that
(base8 (truncate abcde 8)) ===
(base8 abcd) ===
'(a b c d)
Now, (mod n 8) returns e. When you cons e and (a b c d) together, you get (e a b c d), and when you reverse that, you get (d c b a e), and that's what you're returning from base8 for abcde, and this isn't right. If base8 returns returns the octits in a list with the most significant octit first, you'd need to join e and (a b c d) with something like (append '(a b c d) (list 'e)), which is to say
(append (base8 (truncate n 8))
(list (mod n 8)))
That's not particularly efficient, and it does a lot of list copying. It's probably easier to generate the list of octits in reverse order with a helper function, and then have base8 call that helper function, get the list of octits in reverse order, and reverse and return it. That's what the next solutions I'll show do, although I'll be using some bit-operations to handle the division by eight rather than truncate and mod.
Efficient solutions with binary operations
Since the title of the question is How do I convert a decimal number to a list of octal digits in Common Lisp?, I think it's worth considering some options that don't use truncate, since that might be sort of expensive (e.g., see Improving performance for converting numbers to lists, and base10 to base2, and the observation that using binary arithmetic instead of quotient and remainder is faster).
The the first three bits of number correspond to its first numeral in base 8. This means that (ldb (byte 3 0) number) gives the remainder of number divided by 8, and (ash number -3)gives the quotient of number divided by 8. You can collect the octits in order from least to most significant significant octit by collecting (ldb (byte 3 0) number) and updating number to (ash number -3). If you want the least significant octit of the number to be first in the list, you could return (nreverse octits) instead of 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)
The structure of the previous code is iterative, but corresponds directly to a recursive version. If you prefer the recursive version, it's this:
(defun base8 (number)
(labels ((b8 (number octits)
(if (zerop number)
octits
(b8 (ash number -3)
(cons (ldb (byte 3 0) number)
octits)))))
(b8 number '())))
The labels in that code simply establishes a local function called b8. You could define it with a separate defun if you wanted to and call it from 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))))
An unorthodox (and probably inefficient) solution
Here's a silly solution that writes the number in octal, and then converts each digit character to the corresponding number:
(defun base8 (number)
(map 'list #'(lambda (x)
(position x "01234567" :test 'char=))
(write-to-string number :base 8)))
回答4:
I'd use loop for this one:
(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))
Needing to use list to feed the nconcing accumulation clause is ugly. Alternately, you could use collect into and reverse the accumulated list with nreverse before returning from the loop form.
While the version above is clear enough, I like this version of as-base-n-list better, which eliminates the redundant call to mod above:
(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)))
This one takes advantage of floor returning multiple values.
来源：https://stackoverflow.com/questions/19892507/how-do-i-convert-a-decimal-number-to-a-list-of-octal-digits-in-common-lisp