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 $aboutAcidncrog 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! JPTjcw - 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. [1]
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?.

