Replace random words in a string of text with asterisks

[leprechau]

I'm not sure exactly who it was, and I can't find the exact post now, but hopefully whoever needed it will find it here. This was a topic I read awhile ago and just thought I would post something I threw together in TCLSH this evening. Hope it helps someone.

Code: Select all

proc wordMask {text {num {1}}} {
	set txtl [expr {[llength $text] -1}]; set rlist [list]
	if {$num > [llength $text]} {set num [llength $text]}
	while {[llength $rlist] < $num} {
		set x [expr {round(rand()*$txtl)}]
		lappend rlist $x; set rlist [lsort -unique $rlist]
	}
	set outs [split $text]; foreach idx $rlist {
		set outs [lreplace $outs $idx $idx [regsub -all -- {[[:alnum:]]} [set rep [lindex $outs $idx]] {*}]]
		lappend reps [regsub -all -- {[\!\.\?\;\:\"]} $rep {}]
	}; return [list [join $outs] [join $reps]]
}

Usage example:

Code: Select all

foreach {mask reps} [wordMask $text 5] {}

This gives you two variables you can use later on as follows....

Code: Select all

puts "Masked Text -> $mask"

Will give you: Masked Text -> Hello **** *'** ** **** ****!

Code: Select all

puts "Replaced Words -> $reps"

Will give you: Replaced Words -> dear I'll be home soon

That's it...pretty simple and if you read the code in the proc declaration you can see the script will default to replacing 1 word in the passed text, but any other number can be specified if desired.

[TCL_no_TK]

MC_8's More Tools dose this, read the script for more information on the syntax.