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?.

