Is there a way to replace only once if possible by trying the rules sequentially in order?

Question

Is there a ReplaceOnce which does only one replacement if possible by trying the rules sequentially in order. Consider the following as an example:

ReplaceOnce[{"May","5","May","5"},{"May"->1,"5"->2}]

should produce:

{1,"5","May","5"}

Similarly,

ReplaceOnce[{"May","5","May","5"},{"5"->2,"May"->1}]

should produce:

{"May",2,"May","5"}

Answer 1

ClearAll[replace1ce]
replace1ce = Block[{$done = False}, 
    Fold[ReplaceAll, #, # :> RuleCondition[$done = True; #2, ! $done] & @@@ #2]] &;

Examples:

replace1ce[{"May", "5", "May", "5"}, {"May" -> 1, "5" -> 2}]

{1, "5", "May", "5"}

replace1ce[{"May", "5", "May", "5"}, {"5" -> 2, "May" -> 1}]

{"May", 2, "May", "5"}

replace1ce[{"May", "5", "May", "5"}, {"blah" -> 10, "5" -> 2, "May" -> 1}]

{"May", 2, "May", "5"}

replace1ce[{"May", "5", "May", "5"}, {"x" -> 10, s_String :> ToUpperCase[s], "5" -> 2}]

{"MAY", "5", "May", "5"}

Answer 2

I believe a better solution exists.

ClearAll[replaceLimitedBack, replaceLimited];
replaceLimitedBack[expr_, rulesRaw_, n_Integer, levelSpec_] := 
 Block[{rules = Association[rulesRaw], one = 0},
  {Replace[expr, 
    a_?(If[one < n && KeyExistsQ[rules, #], one += 1; True, 
         False] &) :> rules[a], levelSpec], n - one}]
replaceLimited[expr_, rulesRaw_List, n_Integer : 1, levelSpec_ : Infinity] := 
 First[Fold[
   replaceLimitedBack[#1[[1]], #2, #1[[2]], levelSpec] &, {expr, n}, 
   rulesRaw]]

In the condition (?), we check how many times we have replaced elements using one + if a replacement exists with KeyExistsQ, then increase the one.

result:

replaceLimited[{"May", "5", "May", "5"}, {"May" -> 1, "5" -> 2}]
(Out: {1, "5", "May", "5"} )
replaceLimited[{"May", "5", "May", "5"}, {"May" -> 1, "5" -> 2}, 2]
(Out: {1, "5", 1, "5"} )
replaceLimited[{"May", "5", "May", "5"}, {"5" -> 2, "May" -> 1}]
(Out: {"May", 2, "May", "5"} )

Notes:

• Rules will be applied one by one, as far as permitted. For example, if the limit is 2 and the first rule occurred 2 times, only the first rule will be applied and the rest of the rules will not be touched (see the second example).
• The third argument (n) is for how many times you want to replace.
• The fourth argument (levelSpec) is for Replace LevelSpec.

Answer 3

There is probably a build in way. Too many commands and too little time :)

But you could always code one yourself.

ClearAll[replaceOnce]
replaceOnce[lis_List, rules_List] := Module[{lisin = lis, n, pos},
  Do[
   pos = FirstPosition[lis, rules[[n, 1]]] ;
   If[Not[Head[pos] === Missing],
    lisin = ReplacePart[lisin, pos -> rules[[n, 2]]];
    If[Not[SameQ[lisin, lis]],
     Return[lisin, Module]
     ]
    ],
   {n, 1, Length[rules]}
   ];
  lis
  ]

And now

lis = {"May", "5", "May", "5"};
rules1 = {"May" -> 1, "5" -> 2};
rules2 = {"5" -> 2, "May" -> 1};
rules3 = {"x" -> 2};
replaceOnce[lis, rules1]
(* {1, "5", "May", "5"} *)
replaceOnce[lis, rules2]
(* {"May",2,"May","5"} *)
replaceOnce[lis, rules3]
(* {"May","5","May","5"} *)

Answer 4

One approach (maybe not suited to your problem) is to use as pattern the whole expression instead of the elements of the expression. For example :

Replace[
{"May","5","May","5"}
,{{a___,"May",b___} :> {a,1,b}}
,{0}]  

returns :

{1, "5", "May", "5"}

With your example, it becomes a bit complex:

Replace[
 {"May","5","May","5"}
 , {
     {a___,"May",b___}:>{a,1,b}
    ,{a___,"5",b___}:>{a,2,b}
   }
 ,{0}] 

{1, "5", "May", "5"}

or the alternative :

Replace[
  {"May","5","May","5"}
  ,{{a___,x:("May"| "5"),b___}:>{a,x /. {"May"-> 1,"5"->2},b}}
  ,{0}]  

{1, "5", "May", "5"}