1
$\begingroup$

I have asked a question here which was answered. In this question I want to generalise my case to dealwith string of words. Suppose I have the following lists:

l = {"ONIONTOMATO", "BUTTERMILK", "BUTTERWHEAT"};
ll = {{"butter", "cinnamon", "egg", "milk", "starch", "vanilla", 
   "wheat"}, {"bay", "beef", "black_pepper", "cane_molasses", "lamb", 
   "onion", "potato", "tamarind", "tomato", "vegetable_oil", 
   "vinegar", "wheat"}}

I want to look at each l ie l[[1]], l[[2]] and l[[3]] and make a replacement in ll. So that I get 3 lists. For l[[1]]:

{{"butter", "cinnamon", "egg", "milk", "starch", "vanilla", 
   "wheat"}, {"bay", "beef", "black_pepper", "cane_molasses", "lamb", 
   "ONIONTOMATO", "potato", "tamarind", "vegetable_oil", 
   "vinegar", "wheat"}}

For l[[2]]:

{{"BUTTERMILK", "cinnamon", "egg", "starch", "vanilla", 
   "wheat"}, {"bay", "beef", "black_pepper", "cane_molasses", "lamb", 
   "onion", "potato", "tamarind", "tomato", "vegetable_oil", 
   "vinegar", "wheat"}}

And for l[[3]]:

{{"BUTTERWHEAT", "cinnamon", "egg", "milk", "starch", "vanilla", 
   }, {"bay", "beef", "black_pepper", "cane_molasses", "lamb", 
   "onion", "potato", "tamarind", "tomato", "vegetable_oil", 
   "vinegar", "wheat"}}

If words in l were characters, as in the previous question, one could use

replace = Replace[ll, {OrderlessPatternSequence[ a___, ## & @@ ToLowerCase[Characters@#], b___]} :> {a, #, b}, \[Infinity]] &;

But I am not sure how to proceed in this case. I have tried to change Characters to String in definition of replace but this did not work.

Edit: Please note that my original ll size has length of 56498 and my l has length of 72390 this methods seems only work for my example. So naturally I am looking for an answer which can be applied.

$\endgroup$
1
$\begingroup$

function replace produces the lists

replace[x_] := 
Module[  {g = {}, f, s, p}, 
l = {"ONIONTOMATO", "BUTTERMILK", "BUTTERWHEAT"};
ll = {{"butter", "cinnamon", "egg", "milk", "starch", "vanilla", 
 "wheat"}, {"bay", "beef", "black_pepper", "cane_molasses", 
 "lamb", "onion", "potato", "tamarind", "tomato", "vegetable_oil",
  "vinegar", "wheat"}};
s = ToUpperCase["" <> # & /@ Permutations[#, {2}]] & /@ ll;
g = # & @@ Position[s, l[[x]]];
p = Permutations[ll[[g[[1]]]], {2}][[g[[2]]]];
f = First[# & @@ Position[ll[[g[[1]]]], p[[1]]]];
ll[[g[[1]], f]] = l[[x]];
ll[[g[[1]]]] = DeleteCases[ll[[g[[1]]]], p[[2]]];
ll]

here it is

replace[1]    

{{"butter", "cinnamon", "egg", "milk", "starch", "vanilla", "wheat"}, {"bay", "beef", "black_pepper", "cane_molasses", "lamb", "ONIONTOMATO", "potato", "tamarind", "vegetable_oil", "vinegar", "wheat"}}

replace[2]     

{{"BUTTERMILK", "cinnamon", "egg", "starch", "vanilla", "wheat"}, {"bay", "beef", "black_pepper", "cane_molasses", "lamb", "onion", "potato", "tamarind", "tomato", "vegetable_oil", "vinegar", "wheat"}}

replace[3]    

{{"BUTTERWHEAT", "cinnamon", "egg", "milk", "starch", "vanilla"}, {"bay", "beef", "black_pepper", "cane_molasses", "lamb", "onion", "potato", "tamarind", "tomato", "vegetable_oil", "vinegar", "wheat"}}

In a more general sense, if you want ALL the lists from list "l" type

replace /@ Range[Length@l]
$\endgroup$
  • $\begingroup$ Still problematic, I did as you mentioned and get: replace[1] as {{"butter", "cinnamon", "egg", "milk", "starch", "vanilla", "wheat"}, {"bay", "beef", "black_pepper", "cane_molasses", "lamb", "ONIONTOMATO", "potato", "tamarind", "vegetable_oil", "vinegar", "wheat"}} then replace[2] as ``{{"BUTTERMILK", "cinnamon", "egg", "starch", "vanilla", "wheat"}, {"bay", "beef", "black_pepper", "cane_molasses", "lamb", "ONIONTOMATO", "potato", "tamarind", "vegetable_oil", "vinegar", "wheat"}} which has two capitalised words $\endgroup$ – Wiliam Nov 6 '18 at 15:31
  • $\begingroup$ ok. everything is fixed now. try it! $\endgroup$ – J42161217 Nov 6 '18 at 15:32
  • $\begingroup$ Thanks for this, I wonder this can be generalised? my original ll size has length of 56498 and my l has length of 72390 this methods seems only work for my example. $\endgroup$ – Wiliam Nov 6 '18 at 15:47
  • $\begingroup$ I have added this as a note to my question and gave you an up-vote. $\endgroup$ – Wiliam Nov 6 '18 at 15:49
  • $\begingroup$ thanks. you may also remove the above comments about the repeated calls. Yes, a very large list needs a different approach $\endgroup$ – J42161217 Nov 6 '18 at 15:53
0
$\begingroup$

Here is one idea. First, a function that splits a string into two words:

wordSplit[s_] := ToLowerCase @ Flatten @ StringCases[
    s,
    StartOfString~~w1__~~w2__~~EndOfString /; AllTrue[{w1,w2},DictionaryWordQ] :> {w1,w2}
]

For example:

wordSplit["ONIONTOMATO"]

{"onion", "tomato"}

Next, create a function that checks whether both words are present in your list:

compoundQ[list_, {w1_, w2_}] := !FreeQ[list, w1] && !FreeQ[list, w2]

For your example:

compoundQ[ll[[1]], {"butter", "milk"}]

True

If the list contains both words, replace:

ireplace[{w1_, w2_}, compound_, l_] := If[compoundQ[l, {w1, w2}],
    Block[{i = 0},
        Replace[l, w1 | w2 :> If[i++ == 0, compound, Nothing], {1}]
    ],
    l
]

For instance:

ireplace[{"onion", "tomato"}, "ONIONTOMATO", ll[[2]]]

{"bay", "beef", "black_pepper", "cane_molasses", "lamb", "ONIONTOMATO", "potato", "tamarind", "vegetable_oil", "vinegar", "wheat"}

Finally, a function that processes the whole ll list:

replace[list_, compound_] := With[{w = wordSplit[compound]},
    If[MatchQ[w, {_String, _String}],
        ireplace[w, compound, #]& /@ list,
        list
    ]
]

So:

replace[ll, "BUTTERWHEAT"]

{{"BUTTERWHEAT", "cinnamon", "egg", "milk", "starch", "vanilla"}, {"bay", "beef", "black_pepper", "cane_molasses", "lamb", "onion", "potato", "tamarind", "tomato", "vegetable_oil", "vinegar", "wheat"}}

$\endgroup$
  • $\begingroup$ This only works for dictionary words... "vegetable_oil" is in the ll list. Could this code handle "VEGETABLE_OILONION"? $\endgroup$ – J42161217 Nov 6 '18 at 17:09
0
$\begingroup$

Here is a different approach (with the same results) for you to try..

the function you have to call is again "replace"

replace[x_] := 
Module[  {g = {}, f, s, p}, 
l = {"ONIONTOMATO", "BUTTERMILK", "BUTTERWHEAT"};
ll = {{"butter", "cinnamon", "egg", "milk", "starch", "vanilla", 
 "wheat"}, {"bay", "beef", "black_pepper", "cane_molasses", 
 "lamb", "onion", "potato", "tamarind", "tomato", "vegetable_oil",
  "vinegar", "wheat"}};
s = ToLowerCase@l;
t = Boole[StringContainsQ[s[[x]], #] & /@ ll[[#]] & /@ Range@Length@ll];
tot = Total /@ t;
pos = First[# & @@ Position[tot, 2]];
wor = Flatten@Position[t[[pos]], 1];

ll[[pos, wor[[1]]]] = l[[x]];
ll[[pos]] = Delete[ll[[pos]], wor[[2]]];
ll]     

Finally this is a more generalized function in case you have to make replacements in more than one sublists:

replace[x_] := 
Module[  {g = {}, f, s, p}, 
l = {"ONIONTOMATO", "BUTTERMILK", "BUTTERWHEAT"};
ll = {{"butter", "cinnamon", "egg", "milk", "starch", "vanilla", 
 "wheat"}, {"bay", "beef", "black_pepper", "cane_molasses", 
 "lamb", "onion", "potato", "tamarind", "tomato", "butter", 
 "vegetable_oil", "vinegar", "wheat"}};
s = ToLowerCase@l;
t = Boole[
StringContainsQ[s[[x]], #] & /@ ll[[#]] & /@ Range@Length@ll];
tot = Total /@ t;
pos = Flatten@Position[tot, 2];
wor = Partition[Position[t[[pos]], 1], {2}];
worl = Last /@ First /@ wor;
wort = Last /@ Last /@ wor;

Table[ll[[pos[[k]], worl[[k]]]] = l[[x]], {k, Length@pos}];
Table[ll[[pos[[j]]]] = Delete[ll[[pos[[j]]]], wort[[j]]], {j, 
Length@pos}];
ll]
$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.