Randomly replace some letters in words with hyphen

Question

I have a list containing some related words

list = {resident,  occupant,  tenant,  resider,  inhabiter,  habitant,  
        dweller,  citizen,  native,  denizen,  aborigine,  cohabitant};

The list contains words that have at least 4 letters. How can I make a list of the same words with some letters removed randomly and a hyphen placed instead? In each word, at least two 2 letters should be replaced.

desiredlist = {r-s-d-nt,  ---upant,  t-n---,  r-s-der,  -nh-bit-r,  h-bit-nt,  
               -we-ler,  ci--zen,  n-t-ve,  -eni-en,  -bor-gine,  -ohab-t-nt};

Answer 1

You need your list to be actual strings:

list = {"resident", "occupant", "tenant", "resider", "inhabiter", "habitant", "dweller", 
        "citizen", "native", "denizen", "aborigine", "cohabitant"};

Now write a function to do the replacements on a single string:

ElideCharacters[count_Integer, new_String][s_String] :=
  With[
    {indices = RandomSample[Range[StringLength@s], count]},
    StringReplacePart[s, new, Transpose[ArrayReshape[indices, {2, count}, indices]]]]

Example usage:

ElideCharacters[3, "*"]["resident"]
(* "*esid*n*" *)

Now map it over your list.

ElideCharacters[2, "-"] /@ list
(*
  {"res--ent", "oc-up-nt", "--nant", "r--ider", "in-abi-er", "habi-a-t", 
   "-welle-", "cit-ze-", "nat-v-", "den-z-n", "aborig--e", "cohabi-an-"}
 *)

Alternate

Maybe a clearer alternate function:

ElideCharacters[count_Integer, new_String][s_String] :=
  With[
    {indices = RandomSample[Range[StringLength@s], count]},
    StringReplacePart[s, new, Transpose[{indices, indices}]]]

Update

I misread your last sentence. If you want the number of replacements to be randomized (but at least 2), you can use this overload (this assumes the strings will always be long enough):

ElideCharacters[new_String][s_String] :=
  ElideCharacters[RandomInteger[{2, StringLength@s}], new][s]

Answer 2

first write a helper function

replaceStr[s_String] := {StringSplit[s, ""], Join[RandomChoice[{(#&), ("-"&)},StringLength@s-2], {"-"&, "-"&}] // RandomSample} // MapThread[#2[#1]&]  // StringJoin

then map to the words.

list = {"resident",  "occupant",  "tenant",  "resider",  "inhabiter",  "habitant",  "dweller",  "citizen",  "native",  "denizen",  "aborigine",  "cohabitant"};
replaceStr/@list

----den-,-c-----t,t---n-,---i-e-,-nha--t-r,-ab----t,-we----,c-ti-en,-at-ve,d---z--,a---i-i-e,c-habit---

Answer 3

Clear["Global`*"];
SeedRandom[0];
list = {"resident", "occupant", "tenant", "resider", "inhabiter", 
   "habitant", "dweller", "citizen", "native", "denizen", "aborigine",
    "cohabitant"};

elideString[
  s_String] := (Partition[Characters@s, 
     UpTo[RandomChoice[{2, 3}]]] ) /. 
   v_?VectorQ :> ReplacePart[v, RandomChoice@Range@Length@v :>  "_"] //
   StringJoin

{#, elideString@#} & /@ list //
 Grid[Prepend[#, {"Word", "Elided"}]
   , Dividers -> All
   , Alignment -> Center
   , Background -> {None, {Lighter[Blend[{Blue, Green}], .4], {White, 
       Lighter[Blend[{Blue, Green}], .8]}}}
   ] &

---

The idea is to partition the word characters into either twos or threes. Subsequently, a random character is changed from each partition into an underscore before the modified characters in all partitions are rejoined.

Answer 4

Just to participate:

Using:

list = {"resident", "occupant", "tenant", "resider", "inhabiter", 
   "habitant", "dweller", "citizen", "native", "denizen", "aborigine",
    "cohabitant"};

Randomly replacing n letters with symbol sy:

fun[s_, n_, sy_] := Module[{lg = StringLength[s], r, d},
  d = Thread[{StringSplit[s, ""], Table[sy, lg]}];
  r = RandomSample[Range[lg], n];
  StringJoin@
   MapThread[#1[[#2]] &, {d, 
     ReplacePart[ConstantArray[1, lg], Thread[r -> Table[2, n]]]}]
  ]

Testing for n=1,2,3:

Row[Table[
  Grid[{#, fun[#, j, "-"]} & /@ list, Alignment -> Left, 
   Frame -> All], {j, 3}], "   "]