permuting a string (was Re: Speed)

[Geoff Canyon]

On Tue, Sep 2, 2014 at 1:45 PM, Beat Cornaz <B.Cornaz at gmx.net> wrote:

> Mon, 1 Sep 2014 19:47:58 -0500
> From: Geoff Canyon <gcanyon at gmail.com>
>
> > I think this is faster for many arguments. It might be slower for others.
>
> Your right. The only thing with this script is, that it sometimes
> generates too many permutations. E.g. 111223 as input is ok. But 1112223
> generates too many permutations. 11122233 is ok again.
>

Gah, I forgot one stinkin' line:

      put isNewElement into wasNewElement


Here's the corrected (I think) version:

function beatPermut ToPermutateOrdered
   -- assumes the paramter is in decreasing order of frequency
   -- "11122334" is fine
   -- "11222" might work
   -- "12213" will probably fail

   put char 1 of ToPermutateOrdered into lastChar

   -- start with the longest string of duplicates possible
   repeat with i = 1 to length(ToPermutateOrdered)
      if char i of ToPermutateOrdered <> lastChar then exit repeat
      put char i of ToPermutateOrdered after TempPerms2
   end repeat
   put length(TempPerms2) into numChars
   put char numChars + 1 to -1 of  ToPermutateOrdered into tInput3
   put true into wasNewElement

   repeat for each char rNewElement in tInput3
      put rNewElement <> lastChar into isNewElement
      -- remove duplicates for each new value after a duplicate
      if isNewElement and not wasNewElement then
         split TempPerms2 using cr as set
         put the keys of TempPerms2 into TempPerms1
      else
         put TempPerms2 into TempPerms1
      end if
      put isNewElement into wasNewElement
      put rNewElement into lastChar
      put empty into TempPerms2


         -- for the first of a duplicate
         -- or for a unique
         -- just distribute it
         repeat for each line rLine in TempPerms1
            put rNewElement & rLine & cr after TempPerms2
            repeat with x = 1 to NumChars - 1
               put (char 1 to x of rLine) & rNewElement & (char x+1 to -1
of rLine) & cr after TempPerms2
            end repeat
            put rLine & rNewElement & cr after TempPerms2
         end repeat
      else
         -- for duplicates after the first
         -- never place before the first
         -- never insert except at the end of a string
         repeat for each line rLine in TempPerms1
            repeat with x = offset(rNewElement,rLine) + 1 to NumChars
               if char x of rLine <> rNewElement then put (char 1 to x-1 of
rLine) & rNewElement & (char x to NumChars of rLine) & cr after TempPerms2
            end repeat
            put rLine & rNewElement & cr after TempPerms2
         end repeat
      end if
      add 1 to NumChars
   end repeat

   -- Final deletion of duplicates, if the last element was a duplicate
   if isNewElement then return TempPerms2
   split TempPerms2 using cr as set
   return the keys of TempPerms2
end beatPermut