How to Replace Part of a List according to its Position?

Question

I want to encode a list of numbers according to the element position. For example, two lists are as following:

list1 = {5069, 5165, 5069, 5068}
list2 = {4519}

If the length of list equals to 1, it should be changed into {4}, i.e.

list2/.len:{single_}/;Length[len]==1:>{4} 
(* output: {4} *)

And if the length of list does not equals to 1, the list should be changed with this rule:

1. the begining of the list should be 1;
2. the end should be 3;
3. all the number in the middle should be 2.

So, list1 should be changed into {1, 2, 2, 3}. But my solution as followed does not produce the expected result:

stateEncodeRule = {len : {single__} /; Length@len == 1 :> 4, {begin_, middle__, end_} :> {1, 2, 3}}
{5069, 5165, 5069, 5068}/.stateEncodeRule
(* output: {1,2,3} *)

I wonder how to produce the expected result, i.e.

{5069, 5165, 5069, 5068} ==> {1, 2, 2, 3}

Thank you.

Answer 1

ClearAll[f]
f[{_}] := {4}
f[l : {_, __}] := Join[{1}, ConstantArray[2, Length[l] - 2], {3}]

f@list1

{1, 2, 2, 3}

f@list2

{4}

You can also use a single definition:

ClearAll[f2]
f2[l : {__}] := If[Length[l] >= 2, Join[{1}, ConstantArray[2, Length[l] - 2], {3}], {4}]

f2 /@ {list1, list2}

{{1, 2, 2, 3}, {4}}

Alternatively,

ClearAll[f3]
f3[l : {__}] := If[Length[l] >= 2, ReplacePart[l, {1 -> 1, -1 -> 3, _ -> 2}], {4}]

f3 /@ {list1, list2}

{{1, 2, 2, 3}, {4}}

To use a replacement rule, you can define a rule and use it with Replace:

rule = {{_} -> {4}, {_, a___, _} :> Join[{1}, ConstantArray[2, Length[{a}]], {3}]};

Replace[{list1, list2}, rule, 1]

{{1, 2, 2, 3}, {4}}

rule2 = {{_} -> {4}, {_, a___, _} :> {1, ## & @@ ConstantArray[2, Length[{a}]], 3}};

Replace[{list1, list2}, rule2, 1]

{{1, 2, 2, 3}, {4}}

rule3 = {{_} -> {4}, a : {_, __} :> ReplacePart[a, {1 -> 1, -1 -> 3, _ -> 2}] };

Replace[{list1, list2}, rule3, 1]

{{1, 2, 2, 3}, {4}}

{{1, 2, 2, 3}, {4}}

Answer 2

For completeness, slightly different style...for the case where the length is greater than 1.

f[lst_] := Flatten@{1, Rest@Most@(2 + 0 lst), 3}

or

f[lst_] := Flatten@{1, Rest@Most@(2 & /@ lst), 3}

or

f[lst_] := Flatten@{1, 2 & /@ lst[[2 ;; -2]], 3}

or etc.

All three take essentially the same amount of time on a dataset with 1,000,000 elements, about $6 \times 10^{-6}$ seconds. @kglr's algorithm takes about $5 \times 10^{-6}$ for the same data.