发个“字符串递增”函数

nzl1116 · 发表于 2011-12-23 12:00

;;;*********************************************************;;;
;;;------------------- getFirstChar 函数 -------------------;;;
;;;(getFirstChar char case appList List0 List1 List2 List3) ;;;
;;;获取所有能参与运算操作的第一个字符 ;;;
;;;因为要考虑到字母不区分大小写的情况 ;;;
;;;参数 ;;;
;;;char-----相关的字符 ;;;
;;;case-----字母是否区分大小写 ;;;
;;;appList--所有能参与运算的字符的总表 ;;;
;;;List0----符号的表 ;;;
;;;List1----数字的表 ;;;
;;;List2----大写字母的表 ;;;
;;;List3----小写字母的表 ;;;
;;;---------------------------------------------------------;;;
(defun getFirstChar (char case appList List0 List1 List2 List3)
(if (and (not case)
(not List0)
(not List1)
List2
List3
(member char List3)
)
"a"
(car appList)
)
)
;;;--------------- getLastChar 函数 ---------------;;;
;;;(getLastChar char case appList list1 list2) ;;;
;;;获取所有能参与运算操作的最后一个字符 ;;;
;;;参数 ;;;
;;;char------相关的字符 ;;;
;;;case------字母是否区分大小写 ;;;
;;;appList---总表 ;;;
;;;list1-----表示大写字母的表 ;;;
;;;list2-----表示小写字母的表 ;;;
;;;------------------------------------------------;;;
(defun getLastChar (char case appList list1 list2)
(if (and (not case)
list1
list2
(member char list1)
)
"Z"
(last appList)
)
)
;;;---------------incStr 函数 ---------------;;;
;;; 语法: (incStr preStr bit case) ;;;
;;; 参数: 1. preStr----字符串 ;;;
;;; 2. bit-------位码值 ;;;
;;;位码1：表示符号，不包括几个特殊的符号； ;;;
;;;位码2：表示数字； ;;;
;;;位码4：表示大写字母； ;;;
;;;位码8：表示小写字母。 ;;;
;;;位码值范围是：0<bit<16之间的整数。 ;;;
;;; 3. case------是否区分大小写 ;;;
;;;T--表示区分大小写；nil--表示不区分大小写。;;;
;;; 返回值: 字符串递增一位后的新字符串 ;;;
;;;------------------------------------------;;;
;;;样例 ;;;
;;;(incStr "9" 0 T) rv=nil ;;;
;;;(incStr "9" 1 T) rv="9!" ;;;
;;;(incStr "9" 2 T) rv="10" ;;;
;;;(incStr "9" 3 T) rv="!!" ;;;
;;;(incStr "9" 4 T) rv="9A" ;;;
;;;(incStr "9" 8 T) rv="9a" ;;;
;;;(incStr "Zz" 12 T) rv="aA" ;;;
;;;(incStr "Zz" 12 nil) rv="AAa" ;;;
;;;------------------------------------------;;;
(defun incStr (preStr bit case / optList0
optList1 optList2 optList3 appList mStrLen
sinStr0 sinStrn oldSS reVal posit
newSS n TorNil
)
(if (and (> bit 0) (< bit 16))
(progn
(setq optList0 '("!" "#" "$" "%" "&" "'" "*" "+"
"," "-" "." "/" ":" ";" "<" "="
">" "?" "@" "[" "]" "^" "_" "`"
"{" "|" "}" "~"
)
optList1 '("0" "1" "2" "3" "4" "5" "6" "7" "8" "9")
optList2 '("A" "B" "C" "D" "E" "F" "G" "H"
"I" "J" "K" "L" "M" "N" "O" "P"
"Q" "R" "S" "T" "U" "V" "W" "X"
"Y" "Z"
)
optList3 '("a" "b" "c" "d" "e" "f" "g" "h"
"i" "j" "k" "l" "m" "n" "o" "p"
"q" "r" "s" "t" "u" "v" "w" "x"
"y" "z"
)
)
(if (= (logand bit 1) 0)
(setq optList0 nil)
)
(if (= (logand bit 2) 0)
(setq optList1 nil)
)
(if (= (logand bit 4) 0)
(setq optList2 nil)
)
(if (= (logand bit 8) 0)
(setq optList3 nil)
)
(setq appList (append optList0 optList1 optList2 optList3)
; 购建所有能参与运算的字符的表
reVal (strcat " " preStr) ; 给原字符串添加一个无效的字符，它的作用是：始终使n>0
mStrLen (strlen reVal) ; 字符串的长度
n mStrLen
oldSS (substr reVal n 1) ; 提取最后一个字符
TorNil T ; 初始化进位开关
)
;; 循环的作用是从字符串后面开始提取字符，然后比较字符和表中
;; 最后一个字符是否相等
(while (and TorNil (member oldSS appList))
;; 获取组合表里的最后一个元素
(setq sinStrn (getLastChar oldSS case appList optList2 optList3))
(if (equal oldSS sinStrn)
;; 如果字符串中提取的字符和表里的最后一个元素相同
;; 那么，递增就是要将表里的第一个元素来代替最后一个元素
;; 于是要提取总表里的第一元素，考虑到字母不区分大小写的情况
;; 所以不能用简单的 car 函数。
(setq sinStr0 (getFirstChar oldSS case appList optList0 optList1 optList2 optList3)
n (1- n)
reVal (vl-string-subst sinStr0 oldSS reVal n)
oldSS (substr reVal n 1)
)
;; 如果字符串中提取的字符和表里的最后一个元素不相同
;; 那么，递增运算就是将表里的后一个元素取代前一个元素
;; 因为不用进位，所以要把进位开关关掉。
(progn
(if (and (not case) (equal oldSS "Z") optList3)
(setq oldSS "z")
)
(setq posit (vl-position oldSS appList)
newSS (nth (1+ posit) appList)
reVal (vl-string-subst newSS oldSS reVal (1- n))
TorNil nil
)
)
)
) ;_ end while
;; 退出循环有两种可能：
;; 1 进位开关被关闭；
;; 2 oldSS 所指的字符不能参与递增运算。
;; 接下来所要做的工作就是，如果进位开关没关闭，那么就需要更改返回值
;; 但是，存在两种可能，经过循环和没经过循环。经过循环要添加进位字符
;; 没经过循环要添加第一个字符。
;; 进位字符和第一个字符的区别在于"1"和"0"，其他都一样。
(if TorNil
(if (= n mStrLen)
;; 没经过循环，要在原字符串的后面添加第一个字符
(setq reVal (strcat reVal (getFirstChar oldSS case appList optList0 optList1 optList2 optList3)))
;; 经过循环，要在无效运算字符的后面和有效运算字符的前面增加进位字符
(progn
(setq oldSS (substr reVal (1+ n) 1)
sinStr0 (getFirstChar oldSS case appList optList0 optList1 optList2 optList3)
)
(if (equal sinStr0 "0")
(setq sinStr0 "1")
)
(setq reVal (strcat (substr reVal 1 n) sinStr0 (substr reVal (1+ n))))
)
)
)
(substr reVal 2);_ 将添加的" "空格字符去掉
) ;_ progn
) ;_ end if
) ;_ end defun

;;;*********************************************************;;; 
;;;------------------- getFirstChar 函数 -------------------;;; 
;;;(getFirstChar char case appList List0 List1 List2 List3) ;;; 
;;;获取所有能参与运算操作的第一个字符                       ;;; 
;;;因为要考虑到字母不区分大小写的情况                       ;;; 
;;;参数                                                     ;;; 
;;;char-----相关的字符                                      ;;; 
;;;case-----字母是否区分大小写                              ;;; 
;;;appList--所有能参与运算的字符的总表                      ;;; 
;;;List0----符号的表                                        ;;; 
;;;List1----数字的表                                        ;;; 
;;;List2----大写字母的表                                    ;;; 
;;;List3----小写字母的表                                    ;;; 
;;;---------------------------------------------------------;;; 
(defun getFirstChar (char case appList List0 List1 List2 List3) 
  (if (and (not case) 
           (not List0) 
           (not List1) 
           List2 
           List3 
           (member char List3) 
      ) 
    "a" 
    (car appList) 
  ) 
) 
;;;--------------- getLastChar 函数 ---------------;;; 
;;;(getLastChar char case appList list1 list2)     ;;; 
;;;获取所有能参与运算操作的最后一个字符            ;;; 
;;;参数                                            ;;; 
;;;char------相关的字符                            ;;; 
;;;case------字母是否区分大小写                    ;;; 
;;;appList---总表                                  ;;; 
;;;list1-----表示大写字母的表                      ;;; 
;;;list2-----表示小写字母的表                      ;;; 
;;;------------------------------------------------;;; 
(defun getLastChar (char case appList list1 list2) 
  (if (and (not case) 
           list1 
           list2 
           (member char list1) 
      ) 
    "Z" 
    (last appList) 
  ) 
) 
;;;---------------incStr 函数 ---------------;;; 
;;; 语法: (incStr preStr bit case)           ;;; 
;;; 参数: 1. preStr----字符串                ;;; 
;;;       2. bit-------位码值                ;;; 
;;;位码1：表示符号，不包括几个特殊的符号；   ;;; 
;;;位码2：表示数字；                         ;;; 
;;;位码4：表示大写字母；                     ;;; 
;;;位码8：表示小写字母。                     ;;; 
;;;位码值范围是：0<bit<16之间的整数。        ;;; 
;;;       3. case------是否区分大小写        ;;; 
;;;T--表示区分大小写；nil--表示不区分大小写。;;; 
;;; 返回值: 字符串递增一位后的新字符串       ;;; 
;;;------------------------------------------;;; 
;;;样例                                      ;;; 
;;;(incStr "9" 0 T) rv=nil                   ;;; 
;;;(incStr "9" 1 T) rv="9!"                  ;;; 
;;;(incStr "9" 2 T) rv="10"                  ;;; 
;;;(incStr "9" 3 T) rv="!!"                  ;;; 
;;;(incStr "9" 4 T) rv="9A"                  ;;; 
;;;(incStr "9" 8 T)     rv="9a"              ;;; 
;;;(incStr "Zz" 12 T)   rv="aA"              ;;; 
;;;(incStr "Zz" 12 nil) rv="AAa"             ;;; 
;;;------------------------------------------;;; 
(defun incStr (preStr         bit           case             /               optList0 
               optList1         optList2  optList3  appList   mStrLen 
               sinStr0         sinStrn   oldSS     reVal     posit 
               newSS         n           TorNil 
              ) 
  (if (and (> bit 0) (< bit 16)) 
    (progn 
      (setq optList0 '("!"   "#"   "$"         "%"   "&"   "'"   "*"         "+" 
                       ","   "-"   "."         "/"   ":"   ";"   "<"         "=" 
                       ">"   "?"   "@"         "["   "]"   "^"   "_"         "`" 
                       "{"   "|"   "}"         "~" 
                      ) 
            optList1 '("0" "1" "2" "3" "4" "5" "6" "7" "8" "9") 
            optList2 '("A"   "B"   "C"         "D"   "E"   "F"   "G"         "H" 
                       "I"   "J"   "K"         "L"   "M"   "N"   "O"         "P" 
                       "Q"   "R"   "S"         "T"   "U"   "V"   "W"         "X" 
                       "Y"   "Z" 
                      ) 
            optList3 '("a"   "b"   "c"         "d"   "e"   "f"   "g"         "h" 
                       "i"   "j"   "k"         "l"   "m"   "n"   "o"         "p" 
                       "q"   "r"   "s"         "t"   "u"   "v"   "w"         "x" 
                       "y"   "z" 
                      ) 
      ) 
      (if (= (logand bit 1) 0) 
        (setq optList0 nil) 
      ) 
      (if (= (logand bit 2) 0) 
        (setq optList1 nil) 
      ) 
      (if (= (logand bit 4) 0) 
        (setq optList2 nil) 
      ) 
      (if (= (logand bit 8) 0) 
        (setq optList3 nil) 
      ) 
      (setq appList (append optList0 optList1 optList2 optList3) 
                                        ; 购建所有能参与运算的字符的表 
            reVal   (strcat " " preStr)        ; 给原字符串添加一个无效的字符，它的作用是：始终使n>0 
            mStrLen (strlen reVal)        ; 字符串的长度 
            n            mStrLen 
            oldSS   (substr reVal n 1)        ; 提取最后一个字符 
            TorNil  T                        ; 初始化进位开关 
      ) 
      ;; 循环的作用是从字符串后面开始提取字符，然后比较字符和表中 
      ;; 最后一个字符是否相等 
      (while (and TorNil (member oldSS appList)) 
        ;; 获取组合表里的最后一个元素 
        (setq sinStrn (getLastChar oldSS case appList optList2 optList3)) 
        (if (equal oldSS sinStrn) 
          ;; 如果字符串中提取的字符和表里的最后一个元素相同 
          ;; 那么，递增就是要将表里的第一个元素来代替最后一个元素 
          ;; 于是要提取总表里的第一元素，考虑到字母不区分大小写的情况 
          ;; 所以不能用简单的 car 函数。 
          (setq        sinStr0        (getFirstChar oldSS case appList optList0 optList1 optList2 optList3) 
                n        (1- n) 
                reVal        (vl-string-subst sinStr0 oldSS reVal n) 
                oldSS        (substr reVal n 1) 
          ) 
          ;; 如果字符串中提取的字符和表里的最后一个元素不相同 
          ;; 那么，递增运算就是将表里的后一个元素取代前一个元素 
          ;; 因为不用进位，所以要把进位开关关掉。 
          (progn 
            (if        (and (not case) (equal oldSS "Z") optList3) 
              (setq oldSS "z") 
            ) 
            (setq posit         (vl-position oldSS appList) 
                  newSS         (nth (1+ posit) appList) 
                  reVal         (vl-string-subst newSS oldSS reVal (1- n)) 
                  TorNil nil 
            ) 
          ) 
        ) 
      ) ;_ end while 
      ;; 退出循环有两种可能： 
      ;; 1 进位开关被关闭； 
      ;; 2 oldSS 所指的字符不能参与递增运算。 
      ;; 接下来所要做的工作就是，如果进位开关没关闭，那么就需要更改返回值 
      ;; 但是，存在两种可能，经过循环和没经过循环。经过循环要添加进位字符 
      ;; 没经过循环要添加第一个字符。 
      ;; 进位字符和第一个字符的区别在于"1"和"0"，其他都一样。 
      (if TorNil 
        (if (= n mStrLen) 
          ;; 没经过循环，要在原字符串的后面添加第一个字符 
          (setq        reVal (strcat reVal (getFirstChar oldSS        case appList optList0 optList1 optList2 optList3))) 
          ;; 经过循环，要在无效运算字符的后面和有效运算字符的前面增加进位字符 
          (progn 
            (setq oldSS          (substr reVal (1+ n) 1) 
                  sinStr0 (getFirstChar oldSS case appList optList0 optList1 optList2 optList3) 
            ) 
            (if        (equal sinStr0 "0") 
              (setq sinStr0 "1") 
            ) 
            (setq reVal        (strcat        (substr reVal 1 n) sinStr0 (substr reVal (1+ n)))) 
          ) 
        ) 
      ) 
      (substr reVal 2);_ 将添加的" "空格字符去掉 
    ) ;_ progn 
  ) ;_ end if 
) ;_ end defun

qfkxc · 发表于 2011-12-23 12:19

+程序很复杂，下载后仔细研究研究

tjuzkj · 发表于 2011-12-23 13:12

不错，挺详细的！

注册 · 发表于 2011-12-26 10:09

杨如迁 · 发表于 2012-6-29 09:24

怎么用O(∩_∩)O

SunSpring · 发表于 2013-12-28 09:42

不错,正好用到,谢谢.

账号		自动登录	找回密码
密码			注册

发个“字符串递增”函数

本帖被以下淘专辑推荐: