7
$\begingroup$

I need to modify expressions that such as f[w, w, a, y, x, a, x, a] into f[w1, w2, a1, y, x1, a2, x2, a3].

In short, I have expressions like head[args__], and I want to modify args in such a way so as to have the arguments that appear multiple times in the argument list enumerate themselves sequentially and return the modified expression.

My code so far feels a bit clunky but it works on the test cases I considered relevant.

Here are some examples:

h[o,i,o,s,d] -> h[o1,i,o2,s,d]
h[o,i,s,o,d] -> h[o1,i,s,o2,d]
h[o,i,s,d,o] -> h[o1,i,s,d,o2]
h[i,o,s,o,d] -> h[i,o1,s,o2,d]
h[i,o,s,d,o] -> h[i,o1,s,d,o2]
h[i,s,o,d,o] -> h[i,s,o1,d,o2]
h[o,i,o,s,o,d] -> h[o1,i,o2,s,o3,d]
h[o,i,o,s,d,o] -> h[o1,i,o2,s,d,o3]
h[o,i,s,o,d,o] -> h[o1,i,s,o2,d,o3]
h[i,o,s,o,d,o] -> h[i,o1,s,o2,d,o3]
h[o,i,o,s,o,d,o] -> h[o1,i,o2,s,o3,d,o4]

And here's how the previous result was obtained:

{h[o, i, o, s, d], h[o, i, s, o, d], h[o, i, s, d, o], h[i, o, s, o, d], h[i, o, s, d, o], 
 h[i, s, o, d, o], h[o, i, o, s, o, d], h[o, i, o, s, d, o], h[o, i, s, o, d, o], 
 h[i, o, s, o, d, o], h[o, i, o, s, o, d, o]} /. h[args__] :> h @@ enumArgs[args]

Is there a better way to achieve the same result?

An extension I'm considering is

SetAttributes[modArgs, HoldAll]

modArgs[h_[args__]] := h @@ enumArgs[args]

without having to rely on ReplaceAll, but I was wondering if enumArgs — or something similar — can be coded otherwise.

Things I think could use some improvement:

  1. enumArg makes use of ToString and Symbol. In the context, I'm using enumArgs there doesn't seem to be any obvious way for things to go wrong, since I'm making sure I'm using atomic arguments for the heads and arguments of heads. But that may not always be the case.
  2. enumArg and enumArgs to some extent feel more procedural than I'd be comfortable with.
  3. enumArgs plows through the argument list and does what it's supposed to do. I think it should be more 'discrete'.
  4. Also in enumArgs, using the magic in Part to perform in-place assignments is a fast way to do what you need to do, but feels a bit sloppy.

Would you agree with some/any of the points I raise above? Do you think it could have been done better?

If you disagree or think otherwise, please let me know.


Code

Process single argument:

(* process a single argument *)
enumArg[argument_, count_, index_] := Module[{res, id = index},

  If[
   count > 1,
   
   (* more than one instances *)
   res = Symbol@StringJoin[ToString[argument], ToString[count - index + 1]];
   id = index - 1,
   
   (* single instance *)
   res = argument
  ];
  
  {res, id}
  
]

Process function arguments:

(* process arguments *)
enumArgs[args__] := Module[{tally, count, pos, junk, bag = {}, res, id, argument, index},

  (* count individual instances of arguments *)
  tally = Tally[{args}];

  count = tally[[All, -1]];

  (
     {{pos, junk}} = Position[tally, #];
 
     {argument, index} = tally[[pos]];
 
     {res, id} = enumArg[argument, count[[pos]], index];
 
     bag = Flatten[{bag, res}];
 
     tally[[pos, -1]] = id;
 
     ) & /@ {args};

  bag
]
$\endgroup$
5
+100
$\begingroup$

This works for me:

modArgs[res : h_[args__]] := Module[{pos, sym, tl},
   tl = Tally[{args}];
   pos = Table[Position[{args}, id, 1], {id, tl[[All, 1]]}];
   sym = Function[{n, c}, If[c > 1, 
                             Array[Symbol[ToString[n] <> IntegerString[#1]] &, c],
                             {n}]] @@@ tl;
   ReplacePart[res, Flatten[MapThread[Thread@*Rule, {pos, sym}, 1]]]]

For example,

modArgs[f[w, w, a, y, x, a, x, a]]
   f[w1, w2, a1, y, x1, a2, x2, a3]

modArgs[h[o, i, o, s, o, d, o]]
   h[o1, i, o2, s, o3, d, o4]
| improve this answer | |
$\endgroup$
3
$\begingroup$
ClearAll[indexArgs]

indexArgs = Module[{counts = Counts[List @@ #], assoc}, 
    assoc = 1 & /@ counts;
    Replace[ #,  x_Symbol /; counts[x] > 1 :> 
      Symbol[SymbolName[x] <> ToString[assoc[x]++]], All, Heads -> False]] &;

Examples:

Grid[{#, indexArgs @ #} & /@ {h[o, i, o, s, d], h[o, i, s, o, d], 
    h[o, i, s, d, o], h[i, o, s, o, d], h[i, o, s, d, o], 
    h[i, s, o, d, o], h[o, i, o, s, o, d], h[o, i, o, s, d, o], 
    h[o, i, s, o, d, o], h[i, o, s, o, d, o], h[o, i, o, s, o, d, o], 
    h[w, w, a, y, x, a, x, a]} // Prepend[#, {"expr", "indexArgs @ expr"}] &,
  Dividers -> All]

enter image description here

| improve this answer | |
$\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.