6
$\begingroup$

I am trying to write a function which operates on an array with subscripted elements.

As an example i have the array a={$1_3$,$2_2$,$4_1$}, which means i have 3 amounts of value 1, 2 amounts of value 2 and 1 amount of value 4. If the subscripted amount reaches 0, then the element has to be dropped from the array.

Now i need a function

edit[a_,lower_,raise_]:=...

with lower_ being an array of elements which shall be decreased by 1 and raise_ being the array of elements which should be increased by 1. These two arrays have to contain the value and not the position of the element which should be changed.

So if i would call the function with

edit[{Subscript[1, 3], Subscript[2, 2], Subscript[4, 1]}, {1, 1, 4}, {2, 5}]

the output should be

{Subscript[1, 1],Subscript[2, 3], Subscript[5, 1]}

because

  • the value 1 has to be decreased 2 times, leaving it with the amount 1
  • the value 4 has to be decreased once, thus the amount reaches 0 and it has to be dropped
  • the value 2 has to be increased once, increasing the amount to a total of 3
  • the value 5 has to be increased once, and since its not in the list yet, it has to be added

I want to use subscript because it makes it easy to read and seems to behave like a normal 2 dimensional array, but i am open to good alternatives.

$\endgroup$
4
$\begingroup$

You can do it with "classic" functions Tally and GatherBy

edit[a_, lower_, raise_] := 
 DeleteCases[#, _[_, 0]] &[
  Subscript[#[[1, 1]], Total@#[[All, 2]]] & /@ GatherBy[#, First] &@
   Join[a, Subscript @@@ (-Tally[-lower]), Subscript @@@ Tally@raise]]

edit[{Subscript[1, 3], Subscript[2, 2], Subscript[4, 1]}, {1, 1, 4}, {2, 5}]
(* {Subscript[1, 1], Subscript[2, 3], Subscript[5, 1]} *)
$\endgroup$
  • $\begingroup$ @RunnyKine I thought that it is invalid input. Anyway, one can add c_ /; c <= 0 instead of 0 in DeleteCases. $\endgroup$ – ybeltukov Oct 5 '14 at 12:10
  • $\begingroup$ You're probably right that it's invalid input. +1 $\endgroup$ – RunnyKine Oct 5 '14 at 12:11
  • $\begingroup$ all 3 answers were pretty good, thanks a lot $\endgroup$ – kon Oct 8 '14 at 7:51
  • $\begingroup$ @ybeltukov Is it possible to return an empty array when invalid input is made? Invalid Input would also be raising a value lower then 1. ex: edit[{Subscript[1, 1], Subscript[3, 1]},{1,1,2},{0}] $\endgroup$ – kon Oct 12 '14 at 13:21
8
$\begingroup$

Here is an approach using Association for Version 10+.

edit[a_, lower_, raise_] := Subscript @@@ Normal@DeleteCases[#, 0] &@
         Merge[{#, #2, #3}, Total] &[<|Rule @@@ a|>, -Counts[lower], Counts[raise]]

Use:

edit[{Subscript[1, 3], Subscript[2, 2], Subscript[4, 1]}, {1, 1, 4}, {2, 5}]

$\left\{1_1,2_3,5_1\right\}$

$\endgroup$
  • $\begingroup$ Is Association already implemented in Mathematica 8.0? Or which Version do i need to run it? $\endgroup$ – kon Oct 5 '14 at 11:33
  • $\begingroup$ @kon. This is for Version 10 and above. Sorry, I didn't know you were on Version 8. $\endgroup$ – RunnyKine Oct 5 '14 at 11:33
  • $\begingroup$ Actually its my fault for not mentioning it, but unfortunately i cant use it and i dont think i can convince my university to upgrade to version 10 for me. $\endgroup$ – kon Oct 5 '14 at 11:37
  • $\begingroup$ @kon. You can download a trial version which is free for 30 days and try it out or use the Wolfram programming cloud. $\endgroup$ – RunnyKine Oct 5 '14 at 11:39
  • 1
    $\begingroup$ Very nice code! I also thought to use associations but my code is not nearly as good. (I forgot entirely about Counts for one thing.) $\endgroup$ – Mr.Wizard Oct 5 '14 at 22:46
3
$\begingroup$
lst = {Subscript[1, 3], Subscript[2, 2], Subscript[4, 1]};

$\left\{1_3,2_2,4_1\right\}$

ClearAll[foo, editFX];
foo = Flatten[GatherBy[Join[#1, Subscript @@@ Tally[#2] ], First] /.
     {Subscript[x_, a_], Subscript[x_, b_]} :>
                  (Subscript[x, a + #3 b] /. Subscript[_, 0] :> Sequence[])] &;
editFX[lst_, arg1 : {___}, arg2 : {___}] := With[{t = foo[lst, arg1, -1]}, foo[t, arg2, 1]];

editFX[lst, {1, 1, 4}, {2, 5}]

$\left\{1_1,2_3,5_1\right\}$

Or

ClearAll[editFX2];
editFX2 = Fold[foo[#1, First@#2, Last@#2] &, #, {{#2, -1}, {#3, 1}}] &;
editFX2[lst, {1, 1, 4}, {2, 5}]

$\left\{1_1,2_3,5_1\right\}$

$\endgroup$
  • $\begingroup$ Nice. I like it. +1 $\endgroup$ – RunnyKine Oct 5 '14 at 12:44
  • $\begingroup$ Thank you @RunnyKine. $\endgroup$ – kglr Oct 5 '14 at 12:46

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.