基于64进制升位法以最短字串描述最多信息量

dcl1214

①为了方便人的记忆或者是单元格写不下等原因，发现基于36进制或者是64进制来生成的字串只需要4位就能描述百万级数据量
②cad的图元句柄也是类似原理，上不封顶的升位法

1. (DEFUN $sheng-wei$ (str LST / a as s s-new str-new to zz zz-mw)
   
2.                                         ;进制升位
   
3.                                         ;示例($sheng-wei$ "ZzZ" nil)
   
4.   (SETQ        ZZ (list "0"   "1"   "2"   "3"         "4"   "5"   "6"   "7"         "8"
   
5.                  "9"   "A"   "B"   "C"         "D"   "E"   "F"   "G"         "H"
   
6.                  "I"   "J"   "K"   "L"         "M"   "N"   "O"   "P"         "Q"
   
7.                  "R"   "S"   "T"   "U"         "V"   "W"   "X"   "Y"         "Z"
   
8.                  "a"   "b"   "c"   "d"         "e"   "f"   "g"   "h"         "i"
   
9.                  "j"   "k"   "l"   "m"         "n"   "o"   "p"   "q"         "r"
   
10.                  "s"   "t"   "u"   "v"         "w"   "x"   "y"   "z"         "+"
    
11.                  "-"
    
12.                 )
    
13.   )
    
14.   (if (AND str
    
15.            (= (TYPE str) 'str)
    
16.            (SETQ S (MAPCAR 'CHR (vl-string->list str))) ;列表
    
17.            (SETQ S (vl-remove-if-not
    
18.                      (FUNCTION (LAMBDA (A) (CAR (MEMBER A ZZ))))
    
19.                      S
    
20.                    )
    
21.            )
    
22.                                         ;传入进来的字串必须在ZZ列表中能找到
    
23.       )
    
24.     (progn
    
25.       (SETQ zz-mw (last zz))                ;列表末尾那位
    
26.       (setq ZZ (reverse (cons (car zz) (reverse zz))))
    
27.                                         ;将列表中第一个字串追加到列表的尾巴上，便于member搜索
    
28.       (setq As nil)
    
29.       (SETQ S (REVERSE S))                ;倒置
    
30.       (IF (eval (cons '= (cons zz-mw S))) ;如果已经是最大数了
    
31.         (setq S (cons (car ZZ) S))        ;直接升位
    
32.         (PROGN
    
33.           (setq to t)
    
34.           (while (and to (setq a (car s))) ;满足条件            
    
35.             (if        (= a zz-mw)                ;如果当前字串已经是列表中最后一个字串了
    
36.               ()                        ;不执行任何动作
    
37.               (setq to nil)                ;结束while循环
    
38.             )
    
39.             (setq a (CADR (member a ZZ))) ;查找下一个字串
    
40.             (setq As (cons a As))        ;追加到变量as的记录里面
    
41.             (setq s (cdr s))                ;S列表移除第一个便于while循环
    
42.           )
    
43.         )
    
44.       )
    
45.       (setq As (reverse As))                ;倒置回去
    
46.       (setq s-new (reverse (append As s)))
    
47.                                         ;while还没有循环完的部分和已经升位后的部分合并
    
48.       (setq str-new (APPLY 'strCAT s-new)) ;拼接新字串
    
49.     )
    
50.   )
    
51.   str-new                                ;返回新字串
    
52. )

(DEFUN $sheng-wei$ (str LST / a as s s-new str-new to zz zz-mw)<br />                                         ;进制升位<br />                                         ;示例($sheng-wei$ "ZzZ" nil)<br />   (SETQ        ZZ (list "0"   "1"   "2"   "3"         "4"   "5"   "6"   "7"         "8"<br />                  "9"   "A"   "B"   "C"         "D"   "E"   "F"   "G"         "H"<br />                  "I"   "J"   "K"   "L"         "M"   "N"   "O"   "P"         "Q"<br />                  "R"   "S"   "T"   "U"         "V"   "W"   "X"   "Y"         "Z"<br />                  "a"   "b"   "c"   "d"         "e"   "f"   "g"   "h"         "i"<br />                  "j"   "k"   "l"   "m"         "n"   "o"   "p"   "q"         "r"<br />                  "s"   "t"   "u"   "v"         "w"   "x"   "y"   "z"         "+"<br />                  "-"<br />                 )<br />   )<br />   (if (AND str<br />            (= (TYPE str) 'str)<br />            (SETQ S (MAPCAR 'CHR (vl-string->list str))) ;列表<br />            (SETQ S (vl-remove-if-not<br />                      (FUNCTION (LAMBDA (A) (CAR (MEMBER A ZZ))))<br />                      S<br />                    )<br />            )<br />                                         ;传入进来的字串必须在ZZ列表中能找到<br />       )<br />     (progn<br />       (SETQ zz-mw (last zz))                ;列表末尾那位<br />       (setq ZZ (reverse (cons (car zz) (reverse zz))))<br />                                         ;将列表中第一个字串追加到列表的尾巴上，便于member搜索<br />       (setq As nil)<br />       (SETQ S (REVERSE S))                ;倒置<br />       (IF (eval (cons '= (cons zz-mw S))) ;如果已经是最大数了<br />         (setq S (cons (car ZZ) S))        ;直接升位<br />         (PROGN<br />           (setq to t)<br />           (while (and to (setq a (car s))) ;满足条件            <br />             (if        (= a zz-mw)                ;如果当前字串已经是列表中最后一个字串了<br />               ()                        ;不执行任何动作<br />               (setq to nil)                ;结束while循环<br />             )<br />             (setq a (CADR (member a ZZ))) ;查找下一个字串<br />             (setq As (cons a As))        ;追加到变量as的记录里面<br />             (setq s (cdr s))                ;S列表移除第一个便于while循环<br />           )<br />         )<br />       )<br />       (setq As (reverse As))                ;倒置回去<br />       (setq s-new (reverse (append As s)))<br />                                         ;while还没有循环完的部分和已经升位后的部分合并<br />       (setq str-new (APPLY 'strCAT s-new)) ;拼接新字串<br />     )<br />   )<br />   str-new                                ;返回新字串<br /> )

guosheyang

Bao_lai 发表于 2024-4-19 08:49
数字列转Excel列有木有？

;将数字转为Excel表的字母列号（数字转字母）
;; Number to Column  -  Lee Mac           
;; n - [int] positive non-zero integer   
;(LM:num->col 800) "ABC"
(defun LM:num->col( n )
    (if (< n 27)
        (chr (+ 64 n))
        (strcat (LM:num->col(/ (1- n) 26)) (LM:num->col (1+ (rem (1- n) 26))))
    )
)

自贡黄明儒

楼主不是要推广汉语吗，那就加上汉字的“一” “壹”呀

edsion24

sTR LST 这两个代表什么呢

Bao_lai

数字列转Excel列有木有？

guosheyang

感谢杜总的分享！

magicheno

感谢大佬分享