Shuffled words

if 0 {Richard Suchenwirth 2003-09-19} set about {According to a study of Cambridge University, the order of letters inside a word does not matter much for readability, as long as the first and last letters of the word are correct. Here is Tcl code to test this:}

 proc shuffleText string {
   set res ""
   foreach part [regexp -inline -all {[-A-Za-z]+|[^A-Za-z]} $string] {
      if {[regexp {[A-Za-z-]} $part] && [string length $part]>3} {
         set part [shuffleWord $part]
      }
      append res $part
   }
   set res
 }
 proc shuffleWord string {
     set list [split $string ""]
     join [concat [lindex $list 0] [shuffle6 [lrange $list 1 end-1]] [lindex $list end]] ""
 }
 proc shuffle6 { list } {
     set n [llength $list]
     for { set i 1 } { $i < $n } { incr i } {
         set j [expr { int( rand() * $n ) }]
         set temp [lindex $list $i]
         lset list $i [lindex $list $j]
         lset list $j $temp
     }
     return $list
 }

#----- Testing:

 % shuffleText $about

Acidncrog to a sduty of Cabmgidre Unreisvity, the order of lrteets iidsne a wrod deos not mtetar mcuh for rdiietbaaly, as long as the fisrt and last letetrs of the word are correct. Here is Tcl cdoe to test this:

#------- Incredible! I've tried it in french... and it's true! JPT

jcw - To make it shuffle more, i.e. retry if there was no effect, change the line

         set part [shuffleWord $part]

to

         while {[set mix [shuffleWord $part]] eq $part} {}
         set part $mix

#------- daveg - Nedes mroe wrok: The above change isn't good with words like good...


RS 2003-09-22: removed redundant grouping in regexp


Stu - It's fun, but the Cambridge study does not exist. [L1 ]


FW: shuffleText could be simplified further (in part by using my break_text from Bag of Algorithms) as:

 proc shuffleText2 string {
   set res ""
   foreach {word punc} [break_text $string] {
     append res [shuffleWord $word] $punc
   }
   return $res
 }

See also Can you read this?.