pBe Challenge : Wcmatch patterns

[pbejse]

Here's a list of filenames:

(setq lst '("1396_000-ERT-LAS-DWG-ST03-00-1001.dwg" "1396_000-ERT-LAS-DWG-ST03-00-1001_recover.dwg"
 	    "1396_000-ERT-IRR-DWG-ST03-00-5002.dwg" "1396_000-ERT-MEP-DWG-ST03-01-8001.dwg" 
 	    "1396_000-ERT-MEP-DWG-ST03-01-8112.dwg" "1396_000-ERT-MEP-DWG-ST03-01-8112_xx.dwg"
 	    "SCOPE OF WORK.dwg" "Third floor.dwg"))

Your challenge if you choose to accept it is to come up with the best pattern for filter to be used as argument for _FilterThisMrRobot sub

(Defun _FilterThisMrRobot (wt l)
  (vl-remove-if-not
    '(lambda (sg)
       (vl-some '(lambda (f)
		   (wcmatch sg f)) wt)
       )
    l
  )
)

Expected pattern would be

'("1396_000-ERT-@@@-DWG-ST03-0#-####.dwg")

(__FilterThisMrRobot '("1396_000-ERT-???-DWG-ST03-0#-####.dwg") LST)
Result:
"1396_000-ERT-LAS-DWG-ST03-00-1001.dwg" 
"1396_000-ERT-IRR-DWG-ST03-00-5002.dwg" 
"1396_000-ERT-MEP-DWG-ST03-01-8001.dwg" 
"1396_000-ERT-MEP-DWG-ST03-01-8112.dwg" 

Here's more samples [ Correction ]

(setq lst '("LEW-SD-YEE-SW-LA-LY-20092.dwg" "LEW-SD-YEE-SW-LA-LY-10092.dwg"
	    "XX_LEW-SD-YEE-SW-LA-LY-10092.dwg" "LEW-SD-YEE-SS-AR-LY-20102.dwg"
	    "LEW-SD-YEE-SS-AR-L1-50092.dwg" "LEW-SD-YEE-SS-AR-L1-50092_recover.dwg"
	    "LEW-SD-YEE-SS-AR-LY-01110.dwg" "From Ground Floor.dwg"
	    "LEW-SD-YEE-SS-AR-LY-01100_latest.dwg"))

Pattern(s): '("LEW-SD-YEE-@@-@@-L?-#####.dwg")
Pattern(s): '("LEW-SD-YEE-S@-@@-LY-#####.dwg")
Results:
"LEW-SD-YEE-SW-LA-LY-20092.dwg" 
"LEW-SD-YEE-SW-LA-LY-10092.dwg" 
"LEW-SD-YEE-SS-AR-LY-20102.dwg" 
"LEW-SD-YEE-SS-AR-L1-50092.dwg" <-- Should not been here as there's only one of these pattern
"LEW-SD-YEE-SS-AR-LY-01110.dwg" 

And to make it a bit more challenging, if  A pattern appears more than 3 times, then it should be included on the list

(setq lst '("300612-22-A-101.dwg" "300612-22-D-312.dwg" "300612-22-D-313.dwg" "300612-22-D-501.dwg"
	    "300612-22-D-313_updated.dwg" "300612-22-X-01.dwg" "300612-22-X-02.dwg""300612-22-X-10.dwg"
	    "300612-22-X-25.dwg" "D-TEMPLATE.dwg"	))
Pattern(s): '("300612-22-@-###.dwg" "300612-22-X-##.dwg")
Results:
"300612-22-0-101.dwg" <-- Should not been here as there's only one of these pattern
"300612-22-A-101.dwg" <---- changed 0 to A for completeness
"300612-22-D-312.dwg" 
"300612-22-D-313.dwg" 
"300612-22-D-501.dwg" 
"300612-22-X-01.dwg" 
"300612-22-X-02.dwg" 
"300612-22-X-10.dwg" 
"300612-22-X-25.dwg"  

Hope you guys like it and have a go at it

EDIT:  Revised the samples and result to comply with the requirements

[marko_ribar]

I haven't tested yet, but like I said, you should be able to use scheme I provided for working with real files instead of list with strings...

Have a look at my adding of argument in (_FilterThisFilesForMe lst n)...

I suppose that this will be good/enough...

(cond
  ( (null x) )
  ( (< (length x) n) )
  ( T (setq Passed (cons (cons a x) passed)) )
)

Here is complete implementation with my prittier formatting style :

;;; USED GENERAL NON COMMAND FUNCTIONS ;;;

;;; pattern matching process between list of strings representing filenames specifications by pBe
;;; https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/pbe-challenge-wcmatch-patterns/td-p/10960223

(Defun _FilterThisFilesForMe ( lst n / nlst a b x c f passed )
  (setq nlst
    (mapcar
      (function
        (lambda ( fn / fn_ )
          (setq fn_ (vl-filename-base fn))
          (foreach ptn '( ("ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"	"@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@")
                          ("0123456789" "##########")
                          (" !$%&'()+/:;<=>^_{|}€ƒ„…†‡ˆ‰Š‹ŒŽ‘’“”•–—˜™š›œžŸ¡¢£¤¥¦§¨©ª«¬­®¯°±²³´µ¶·¸¹º»¼½¾¿ÀÁÂÃÄÅÆÇÈÉÊÌÍÎÏÐÑÒÓÔÕÖ×ØÙÚÛÜÝÞßàáâãäåæçèéêëìíîïðñòóôõö÷øùúûüýþÿ" "????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????")
                        )
            (setq fn_ (vl-string-translate (Car ptn) (cadr ptn) fn_))
          )
          (list  fn_ (vl-filename-base fn))
        )
      )	lst
    )
  )
  (while (setq a (car nlst))
    (setq b (Cdr nlst))
    (Setq x
      (Vl-remove-if-not 
        (function
          (lambda ( d )
            (setq f (= (Car a)(car d)))
            (and (null f) (setq c (Cons d c)))
            f
          )
        ) b
      )
    )
    (setq nlst c c nil)
    (cond
      ( (null x) )
      ( (< (length x) n) )
      ( T (setq Passed (cons (cons a x) passed)) )
    )
  )
  (mapcar (function _GiveMeThePattern) passed)
)

(defun _GiveMeThePattern ( l / a b ThePatterns AllPattern )
  (while (setq a (car l))
    (setq b (cdr l)
          l b
    )
    (setq ThePatterns
      (mapcar 
        (function
          (lambda ( r / Fname w p ps )
            (setq p 0
                  Fname (Cadr a)
            )
            (While
              (<
                (+ p (Setq ps (Vl-string-mismatch (Cadr a) (Cadr r) p p)))
                (strlen Fname)
              )
              (setq Fname (strcat (substr Fname 1 (+ p ps))	(substr (Car a) (+ 1 ps p) 1)	(substr Fname (+ 2 (+ p ps)))))
              (setq p (+ 1 p ps))
            )
            Fname
          )
        )
        b
      )
    )
    (setq AllPattern (cons ThePatterns AllPattern))
  )
  (car (vl-sort (apply (function append) AllPattern) (function <)))
)

;|
(setq lst1 '("1396_000-ERT-LAS-DWG-ST03-00-1001.dwg"
	     "1396_000-ERT-LAS-DWG-ST03-00-1001_recover.dwg"
	     "1396_000-ERT-IRR-DWG-ST03-00-5002.dwg"
	     "1396_000-ERT-MEP-DWG-ST03-01-8001.dwg"
	     "1396_000-ERT-MEP-DWG-ST03-01-8112.dwg"
	     "1396_000-ERT-MEP-DWG-ST03-01-8112_xx.dwg"
	     "SCOPE OF WORK.dwg"
	     "Third floor.dwg"
	    )
)
(_FilterThisFilesForMe lst1 3)--->("1396_000-ERT-@@@-DWG-ST03-0#-####")

(setq lst2 '("LEW-SD-YEE-SW-LA-LY-20092.dwg"
	     "LEW-SD-YEE-SW-LA-LY-10092.dwg"
	     "XX_LEW-SD-YEE-SW-LA-LY-10092.dwg"
	     "LEW-SD-YEE-SS-AR-LY-20102.dwg"
	     "LEW-SD-YEE-SS-AR-L1-50092.dwg"
	     "LEW-SD-YEE-SS-AR-L1-50092_recover.dwg"
	     "LEW-SD-YEE-SS-AR-LY-01110.dwg"
	     "From Ground Floor.dwg"
	     "LEW-SD-YEE-SS-AR-LY-01100_latest.dwg"
	    )
)
(_FilterThisFilesForMe lst2 3)--->("LEW-SD-YEE-S@-@@-LY-#####")

(setq lst3 '("300612-22-A-101.dwg"
	     "300612-22-D-312.dwg"
	     "300612-22-D-313.dwg"
	     "300612-22-D-501.dwg"
	     "300612-22-D-313_updated.dwg"
	     "300612-22-X-01.dwg"
	     "300612-22-X-02.dwg"
	     "300612-22-X-10.dwg"
	     "300612-22-X-25.dwg"
	     "D-TEMPLATE.dwg"
	    )
)
(_FilterThisFilesForMe lst3 3)--->("300612-22-X-##" "300612-22-@-###")
|;

;;; collect list of filenames of all specific files residing in main/parent folder and all its sub/child folders ;;;
;;; libraryrootprefix - main/parent folder string
;;; filenamepattern - pattern describing specific non fungible characteristic to be used for processing/collecting filenames / nil ("*.*")
;;; return - list with filenames strings (full paths included) collected in specific folder tree that satisfy custom specific filter if it was provided and passed to evaluation

(defun _findfiles ( libraryrootprefix filenamepattern / subs processsubfolders folders fl r ) ;;; (_findfiles "F:\\ACAD ADDONS-NEW\\" "profile*.lsp")

  (defun subs ( folder )
    (vl-remove "." (vl-remove ".." (vl-directory-files folder nil -1)))
  )

  (defun processsubfolders ( rootfolder / subfolders )
    (setq subfolders (subs rootfolder))
    (foreach sub subfolders
      (if (= (substr rootfolder (strlen rootfolder)) "\\")
        (setq r (cons (strcat rootfolder sub) (processsubfolders (strcat rootfolder sub))))
        (setq r (cons (strcat rootfolder "\\" sub) (processsubfolders (strcat rootfolder "\\" sub))))
      )
    )
    r
  )

  (setq folders (append (list libraryrootprefix) (processsubfolders libraryrootprefix)))
  (foreach folder folders
    (foreach x (vl-directory-files folder filenamepattern 1)
      (setq fl (cons (strcat folder "\\" x) fl))
    )
  )
  (reverse fl)
)

;; Directory Files  -  Lee Mac
;; Retrieves all files of a specified filetype residing in a directory (and subdirectories)
;; dir - [str] Root directory for which to return filenames
;; typ - [str] Optional filetype filter (DOS pattern)
;; sub - [bol] If T, subdirectories of the root directory are included
;; Returns: [lst] List of files matching the filetype criteria, else nil if none are found

(defun LM:directoryfiles-main ( dir typ sub / LM:directoryfiles l ) ;;; why main function ? - purpose : clearing "l" variable (globals are not desirable in any case...)

  (defun LM:directoryfiles ( dir typ sub )
    (setq dir (vl-string-right-trim "\\" (vl-string-translate "/" "\\" dir)))
    (mapcar
      (function
        (lambda ( x )
          (setq l (append l (list (strcat dir "\\" x))))
        )
      ) (vl-directory-files dir typ 1)
    )
    (if sub
      (mapcar
        (function
          (lambda ( x )
            (if (not (wcmatch x "`.,`.`."))
              (LM:directoryfiles (strcat dir "\\" x) typ sub)
            )
          )
        )
        (vl-directory-files dir nil -1)
      )
    )
  )

  (LM:directoryfiles dir typ sub)
  l
)

;;; MAIN ROUTINE ;;;

;;;------------------------------------------------------------------------------------------------------------------------;;;
;;;                                                                                                                        ;;;
;;; FIND COMMON MATCHING PATTERN STRING OF ALL SPECIFIC FILES RESIDING IN MAIN/PARENT FOLDER AND ALL ITS SUB/CHILD FOLDERS ;;;
;;;                                                                                                                        ;;;
;;; By pBe : 21.02.2022.                                                                                                   ;;;
;;;                                                                                                                        ;;;
;;;------------------------------------------------------------------------------------------------------------------------;;;

(defun c:folder_wcmatch_pattern ( / *error* LM:str->lst LM:editbox editbox_makedcl run_editbox_dcl tmp_dcl_filename dcl_id han filter folder fullfilenames filenames n )

  (vl-load-com) ;;; load AciveX extensions (VLA-functions)...

  ;;; HELPER SUB FUNCTIONS...

  (defun *error* ( m )
    (vl-catch-all-apply 'term_dialog nil)
    (if m
      (prompt m)
    )
    (princ)
  )

  ;; String to List  -  Lee Mac
  ;; Separates a string using a given delimiter
  ;; str - [str] String to process
  ;; del - [str] Delimiter by which to separate the string
  ;; Returns: [lst] List of strings

  (defun LM:str->lst ( str del / len lst pos )
    (setq len (1+ (strlen del)))
    (while (setq pos (vl-string-search del str))
      (setq lst (cons (substr str 1 pos) lst)
            str (substr str (+ pos len))
      )
    )
    (reverse (cons str lst))
  )

  ;; Edit Box  -  Lee Mac
  ;; Displays a DCL Edit Box to obtain a string from the user
  ;; str - [str] Initial value to display ("" for none)
  ;; Returns: [str] Edit box contents if user pressed OK, else nil

  (defun LM:editbox ( str han )
    (if (new_dialog  "acad_txtedit" han)
      (progn
        (set_tile    "text_edit"    str)
        (action_tile "text_edit" "(setq str $value)")
        (if (zerop (start_dialog))
          (setq str nil)
        )
        (if (and han (< 0 han))
          (unload_dialog han)
        )
        str
      )
    )
  )

  (defun editbox_makedcl ( fullfilename / fn )
    (setq fn (open fullfilename "w"))
    (write-line "EditBox : dialog { key = \"Title\"; label = \"\"; initial_focus = \"Edit\"; spacer; : row { fixed_width = true; : column { width = 100; fixed_width = true; spacer; : text { key = \"Text\"; label = \"\"; }} : edit_box { key = \"Edit\"; edit_width = 20; fixed_width = true; is_default = true; }} spacer; ok_cancel; }" fn)
    (close fn)
    t
  )

  (defun run_editbox_dcl ( dcl_id / r )
    (if (new_dialog "EditBox" dcl_id)
      (progn
        (set_tile "Title" "Specific non fungible characteristic of filenames to be processed - considered in pattern matching search")
        (set_tile "Text" "Specify pattern describing specific non fungible characteristic to be used for processing/collecting filenames - ENTER FOR ALL (\"*.*\")")
        (set_tile "Edit" "*.*")
        (action_tile "Edit" "(setq filter $value)") ;;; storing dialog input in variable "filter"...
        (action_tile "accept" "(done_dialog 1)")
        (action_tile "cancel" "(done_dialog 0)")
        (if (setq r (start_dialog))
          (progn
            (unload_dialog dcl_id)
            (if (zerop r)
              (setq filter nil)
              filter
            )
          )
        )
      )
    )
  )

  ;;; MAIN ROUTINE...

  ;;; INPUT DATA...

  (while
    (or
      (initget 6)
      (= (setq n (getint "\nChoose desired matching pattern output option - minimal number of matching strings per single output pattern - must be > 1 <3> : ")) 1)
    )
    (prompt "\nOption must be number greater than 1...")
  )
  (if (not n)
    (setq n 3)
  )

  (or
    (and
      (setq tmp_dcl_filename (vl-filename-mktemp "e_box" (car (LM:str->lst (vla-get-supportpath (vla-get-files (vla-get-preferences (vlax-get-acad-object)))) ";")) ".dcl"))
      (editbox_makedcl tmp_dcl_filename)
      (> (setq dcl_id (load_dialog tmp_dcl_filename)) 0)
      (or (setq filter (run_editbox_dcl dcl_id)) t)
      (or
        (if (findfile tmp_dcl_filename)
          (vl-file-delete tmp_dcl_filename)
        )
        t
      )
      filter
    )
    (and
      (> (setq han (load_dialog "acad")) 0)
      (setq filter (LM:editbox "Specify pattern describing specific non fungible characteristic to be used for processing/collecting filenames - ENTER FOR ALL (\"*.*\")" han))
    )
    (setq filter (dos_editbox "Specific non fungible characteristic of filenames to be processed - considered in pattern matching search" "Specify pattern for processing/collecting filenames - ENTER FOR ALL (\"*.*\")" "*.dwg"))
    (setq filter (getstring t "\nSpecify pattern describing specific non fungible characteristic to be used for processing/collecting filenames - ENTER FOR ALL (\"*.*\")\n\t:"))
  )
  (if (= "" filter)
    (setq filter "*.*")
  )

  (or
    (not filter)
    (setq folder (strcat (acet-ui-pickdir "Select folder tree to process wcmatch_pattern files matching...") "\\"))
    (if (setq folder (getfiled "Select folder tree to process wcmatch_pattern files matching... Then just pick one of files and press OPEN button" "\\" filter 16))
      (setq folder (car (fnsplitl folder)))
    )
    (setq folder (dos_getdir "Browse for folder" "\\" "Select folder tree to process wcmatch_pattern files matching..."))
    (if (setq folder (dos_getfiled "Browse for folder - Select folder tree to process wcmatch_pattern files matching..." "\\" ""))
      (setq folder (car (fnsplitl folder)))
    )
    (setq folder (car (dos_getfilenav "Browse for folder - Select folder tree to process wcmatch_pattern files matching..." "\\" filter 4096))) ;;; 4096 (bit 12) - multiple file seletion enabled
  )

  ;;; MAIN PROCESSING ...

  (if (and folder filter (or (setq fullfilenames (_findfiles folder filter)) (setq fullfilenames (LM:directoryfiles-main folder filter t))))
    (progn
      (setq filenames (mapcar (function (lambda ( x / y ) (setq y (fnsplitl x)) (strcat (cadr y) (caddr y)))) fullfilenames))
      (setq *pattern* (car (_FilterThisFilesForMe filenames n)))
      (prompt "\nSpecified pattern that was used for processing : \"") (prompt filter) (prompt "\"")
      (prompt "\nSpecified folder that was used for processing : \"") (prompt folder) (prompt "\"")
      (prompt "\n")
      (prompt "\nProcessed total : ") (princ (if filenames (length filenames) 0)) (prompt " filenames...")
      (prompt "\n")
      (prompt "\nCOMMON WCMATCH PATTERN / MATCHING STRINGS FILTER SPECIFICATION : \"") (princ *pattern*) (prompt "\"")
      (prompt "\n")
      (prompt "\nPattern is stored in global variable : \"*pattern*\"... You can call it with : !*pattern*...")
    )
    (cond
      ( (and folder filter)
        (prompt "\nSorry, you picked empty folder tree - there are no files matching specified pattern that was used for processing...")
        (prompt "\nSpecified pattern that was used for processing : \"") (prompt filter) (prompt "\"")
        (prompt "\nSpecified folder that was used for processing : \"") (prompt folder) (prompt "\"")
        (prompt "\n\nPossible problem : invalid filenames - used bad code page in naming them (collecting of files not processed - (vl-directory-files) bug...\nEither use differnt pattern, or pick diferent folder tree next time...")
      )
      ( folder
        (prompt "\nSpecified folder that was used for processing : \"") (prompt folder) (prompt "\"")
        (prompt "\n")
        (prompt "\nInvalid input - pattern that is to be used for processing havent been defined sucessfully...")
        (prompt "\n\nTry to fix problem of not invoking DCL dialog box by debugging (load_dialog) function on specified string at beginning of temporary DCL file... \nIf value is positive number, then you should look for next issue that causes not starting edit box input...")
        (prompt "\nAlternatively you can try some differnt method of invoking edit box input : DosLib function (dos_editbox)...")
      )
      ( filter
        (prompt "\nSpecified pattern that was used for processing : \"") (prompt filter) (prompt "\"")
        (prompt "\n")
        (prompt "\nEither (acet-ui-pickdir) haven't initialized properly, or you pressed CANCEL button when dialog box for selecting folder appeared, or you terminated proper way of routine execution...")
        (prompt "\n\nTry to replace (acet-ui-pickdir) method of invoking dialog box for folder selection with some different approach : (getfiled) function; DosLib function (dos_getdir)...")
      )
      ( t
        (prompt "\nNothing processed... And no valid input data...")
        (prompt "\n\nTry to fix problem of not invoking DCL dialog box by debugging (load_dialog) function on specified string at beginning of temporary DCL file... \nIf value is positive number, then you should look for next issue that causes not starting edit box input...")
        (prompt "\nEither (acet-ui-pickdir) haven't initialized properly, or you pressed CANCEL button when dialog box for selecting folder appeared, or you terminated proper way of routine execution...")
        (prompt "\n\nTry to replace (acet-ui-pickdir) method of invoking dialog box for folder selection with some different approach : (getfiled) function; DosLib function (dos_getdir)...")
      )
    )
  )
  (textscr)
  (princ)
)

I suppose that you can work now slightly better...

Maybe we should implement "Elapsed Time" parameter for comparison of efficiency of solutions...

But this is all for now from me...

Regards, M.R.

[pbejse]

---

@marko_ribar wrote:

You are using (vl-string-mismatch) function which I really never used in my carrer...

You are using (while) loop-ing inside (mapcar '(lambda ( ... ) ) ... ) loop-ing, which is pretty unusual...

This at the end :

(vl-sort (apply 'append AllPattern) '<)

---

Hello Marko, thank you for your feedback. really aprpeciate you taking time to participate with the challenge 😄

In my lifetime, I used it twice :), so  you're not really missing out ( I think ) 😄

For what I had in mind, the while function is the only thing that will work, repeat/foreach just wouldn't cut it

[ Maybe i'll come up with somehitng on the 2nd draft, recursion perhaps? ]

The sort thingy is something i threw in for this draft, we could perhaps sort the list with the most number of hits as the final pattern

"LEW-SD-YEE-SS-AR-LY-##1##"
"LEW-SD-YEE-S@-@@-LY-#0##2"
"LEW-SD-YEE-S@-@@-LY-#####"
"LEW-SD-YEE-SW-LA-LY-#0092"
"LEW-SD-YEE-S@-@@-LY-20##2"
"LEW-SD-YEE-S@-@@-LY-#####"

and still end up with this --> "LEW-SD-YEE-S@-@@-LY-#####"

Why are you so condemned on condition : 3 or more matchings produce 1 pattern... Perhaps give a user a choice to choose complexity of processing - I suppose it's just altering that (cond) in first sub... What if you have list with only 2 filenames? Shouldn't you match all patterns finally to get one final resulting pattern...

---

Come to think of it, you may have a point there @marko_ribar.

---

@marko_ribar wrote:

All in all, pretty well done...

---

Thank you for that. I will look into your contribution in a few, not the whole thing though. just the function that produces the pattern.

Now if we can only get more offering from the others 🤔

[Sea-Haven]

2 steps forward 1 step back at moment, lost in repeats.

[pbejse]

---

@Sea-Haven wrote:

2 steps forward 1 step back at moment, lost in repeats.

---

That's the reason why i avoided using it 😉

No worries @Sea-Haven, work on it only when you get a chance.

[john.uhden]

@pbejse 

I am playing with this from time to time with the approach of comparing each character of the list from start to end of string looking for a majority of equals.  Might you have an idea of what a majority should be?  50%? 60%? 70%?

Because if there's no clear majority, then the character becomes "?"

On my first complete attempt, I was looking for all characters (100% majority) to be =, and of course my pattern came up as "????????????????" and just because one or two were totally different (< 100%).

Of course, this method may be totally stupid because a majority for one character may exclude the best matches overall.  But I doubt that I will struggle to do some weird iteration to look for all possibilities.  With about 40 possible characters and each string being like 20 characters long, that's like 20^40 or 40^20 (whatever) combinations.

I'm good with trigonometry, but this is like high end statistics = outta my league.

[john.uhden · Accepted solution]

@pbejse 

I don't know about multiple patterns.

I just decided to play the odds.  You never answered me, but 60% seems to work the best with your LST.

Primarily, it deals with the characters as integers, which I believe Herman Mayfarth told me was much faster.

Here, please try it out:

(defun @findpat (lst / @count #lst counts #s pat)
  ;; v.1e99 (Feb. 2022) John F. Uhden
  (defun @count (#)
    (cons # (length (vl-remove-if-not '(lambda (x)(= x #)) #s)))
  )
  (setq #lst (mapcar 'vl-string->list (mapcar 'strcase lst)))
  (setq counts (mapcar '@count (setq #s (mapcar 'length #lst))))
  (repeat (caar (vl-sort counts '(lambda (a b)(> (cdr a)(cdr b)))))
    (setq #s (vl-remove nil (mapcar 'car #lst)))
    (setq counts (mapcar '@count #s))
    (setq counts (vl-sort counts '(lambda (a b)(> (cdr a)(cdr b)))))
    (if (>= (/ (float (cdar counts))(length counts)) 0.6)
      (setq pat (cons (caar counts) pat))
      (setq pat (cons 63 pat))
    )
    (setq #lst (mapcar 'cdr #lst))
  )
  (vl-list->string (reverse pat))
)

[pbejse]

---

@john.uhden wrote:

 ...Might you have an idea of what a majority should be?  50%? 60%? 70%?

Because if there's no clear majority, then the character becomes "?"

---

Majority is number of hits that complies with the parameters. There are 3 so far.

• Same number of characters
• It counts if the pattern appears over 3 times.
• Needs to work in some way with _FilterThisMrRobot sub

On my first complete attempt, I was looking for all characters (100% majority) to be =, and of course my pattern came up as "????????????????" and ... 

Of course, this method may be totally... like 20 characters long, that's like 20^40 or 40^20 (whatever) combinations.

---

Why of course it is, so dont do it. who wants to go through 13367494538843734067838845976576 possbilites, and that does not include symbols, permutations anyone?

---

@john.uhden wrote:

I don't know about multiple patterns.

I just decided to play the odds.  You never answered me, but 60% seems to work the best with your LST.

Primarily, it deals with the characters as integers,..

---

60%  is good, but we need more John 🙂

(setq lst '("LEW-SD-YEE-SW-LA-LY-20092.dwg" "LEW-SD-YEE-SW-LA-LY-10092.dwg"
	    "XX_LEW-SD-YEE-SW-LA-LY-10092.dwg" "LEW-SD-YEE-SS-AR-LY-20102.dwg"
	    "LEW-SD-YEE-SS-AR-L1-50092.dwg" "LEW-SD-YEE-SS-AR-L1-50092_recover.dwg"
	    "LEW-SD-YEE-SS-AR-LY-01110.dwg" "From Ground Floor.dwg"
	    "LEW-SD-YEE-SS-AR-LY-01100_latest.dwg"))

(@findpat lst)
"LEW-SD-YEE-S?-??-L?-?0??2.DWG";<-- also results should be in a form of a list

(_filterthismrrobot (list (@findpat lst)) lst)
"LEW-SD-YEE-SW-LA-LY-20092.dwg"
"LEW-SD-YEE-SW-LA-LY-10092.dwg"
"LEW-SD-YEE-SS-AR-LY-20102.dwg"
"LEW-SD-YEE-SS-AR-L1-50092.dwg";<-- pattern only appeared once 

But missed this one 

LEW-SD-YEE-SS-AR-LY-01110.dwg"

On other list it shows this

"300612-22-?-??????G";<-- extension is not identifiable

where the desired result is

("300612-22-X-##.dwg" "300612-22-@-###.dwg") ;<-- first pattern passed the conditions

Perhaps a little more tweak would push the numbers higher than 60%

, which I believe Herman Mayfarth told me was much faster.

---

Had to look that up to get it. 😊

[john.uhden]

@pbejse 

How in HE(double hockey sticks) did you give me an acceptance for my piddly code that returns only one pattern?

And I didn't include your robot function at all.  Oh, I know... you have a very sick sense of good vs. bad (I said SICK not SIXTH).

BTW, I think 50% vs. 60% vs. 70% depends greatly on how many items are in the LST.  Looking back at my code, I'm not even sure what I was doing.  Just gambling, I guess.

BTW#2, that Herman Mayfarth thread was a lot of fun, but I was thinking of an earlier one where he chastised me for trying to deal with characters.  I miss some of those guys of yesteryear, not to say that the current inhabitants aren't equally entertaining.  I wonder if @dbroad still remembers those tirades between T.T and Grant & Elaine.

[pbejse]

---

@john.uhden wrote:

@pbejse 

How in HE(double hockey sticks) did you give me an acceptance for my piddly code that returns only one pattern?

---

😄 good one. But of course I accepted it a s a solution, you get paid for the attempt!