3
$\begingroup$

I have been using the function HistogramList to generate frequency tables off a data set. The code looks like this:

frequencytable=HistogramList[dataA,{-0.5, 6.5, 1},"PDF"][[2]]

with a numerical output of:

0.0152, 0.0937, 0.0234, 0.2969, 0.2500, 0.0781, 0.0312

Here is my question. I would like to add the three numbers at the right hand side to one another. Next, I would like to add the three numbers at the left hand side to one another. Last, I would like to subtract the sum of the three numbers on the left from the sum of the three numbers on the right. How do I do that?

$\endgroup$
1
  • 1
    $\begingroup$ If you want to to this in place you should see: (3069) $\endgroup$
    – Mr.Wizard
    Aug 13 '13 at 16:34
4
$\begingroup$

You should have a look at Take and Total in the documentation. Here's the code:

list = {0.0152, 0.0937, 0.0234, 0.2969, 0.2500, 0.0781, 0.0312};
Total@Take[list, -3] - Total@Take[list, 3]

0.227

$\endgroup$
4
  • $\begingroup$ "Total@Take" seems to work. But the answer I got was 0.0156625, not 0.227. (I verified the result on a pocket calculator) Am I missing something? @Anon $\endgroup$
    – Joel Mayer
    Aug 13 '13 at 19:52
  • $\begingroup$ @JoelMayer There are plenty of people who got the same result as I. Perhaps we all misunderstood what it was you wanted to do. $\endgroup$
    – C. E.
    Aug 13 '13 at 20:03
  • $\begingroup$ @JoelMayer Is this not what you want to do: sum of last three digits minus the sum of the first three digits? $\endgroup$
    – C. E.
    Aug 13 '13 at 20:14
  • $\begingroup$ A thousand (1x10^3) pardons my lords and masters. I transcribed 0.234 when I should have transcribed 0.0234. @anon $\endgroup$
    – Joel Mayer
    Aug 13 '13 at 22:17
4
$\begingroup$

Okay, since this has turned into a fun-fest here's mine:

Range@12 /. {a:_ .. {3}, ___, z:_ .. {3}} :> +z - +a

27

Keen eyes may have spotted something unusual. ;^) This uses my own Notation package syntax for Repeated; here is the InputForm of the LHS of the rule:

{a:_ .. {3}, ___, z:_ .. {3}} // InputForm
{a:Repeated[_, {3}], ___, z:Repeated[_, {3}]}

Personally I just hate typing out Repeated now. If anyone else is crazy enough to play by my rules ask me for the code or implement it yourself.

$\endgroup$
5
  • $\begingroup$ I think this is the first time I've seen patt .. {n} for the second argument of Repeated. Never knew about that and never would've thought a postfix operator would also serve as an infix one. +! $\endgroup$
    – rm -rf
    Aug 13 '13 at 18:52
  • $\begingroup$ Oh wait a minute... your own Notation package. Rats! I thought this was an undocumented gem in the syntax :( $\endgroup$
    – rm -rf
    Aug 13 '13 at 18:53
  • $\begingroup$ @rm-rf Now who's having the heart attack? :o) $\endgroup$
    – Mr.Wizard
    Aug 13 '13 at 18:59
  • $\begingroup$ It does look neat, but nowadays I mostly write code for the long term or one that someone else might use, so I've long abandoned any desire for custom notations and focus more on clarity of code (I mean, code written only with the default language syntax. I'll admit, this is much nicer if it were part of the syntax). I genuinely thought this was in the docs! $\endgroup$
    – rm -rf
    Aug 13 '13 at 19:15
  • $\begingroup$ @rm-rf I fully understand (see: "crazy"). I do also wish this were real syntax. $\endgroup$
    – Mr.Wizard
    Aug 13 '13 at 19:20
4
$\begingroup$

After the nonsense here is a serious answer inspired by Kuba's:

x = Range @ 12;

PadLeft[x, 6, x, 3].{1, 1, 1, -1, -1, -1}

27

It's quite fast:

r = RandomInteger[999, {5000}];
Do[Tr@Take[r, -3] - Tr@Take[r, 3], {500000}] // Timing // First
Do[PadLeft[r, 6, r, 3].{1, 1, 1, -1, -1, -1}, {500000}] // Timing // First

0.639

0.656

Of course the more direct x[[{-1, -2, -3, 1, 2, 3}]].{1, 1, 1, -1, -1, -1} is better, but less fun IMHO.

Do[r[[{-1, -2, -3, 1, 2, 3}]].{1, 1, 1, -1, -1, -1}, {500000}] // Timing // First

0.421

$\endgroup$
4
$\begingroup$

Just another way to do the same thing:

list = {0.0152, 0.0937, 0.0234, 0.2969, 0.2500, 0.0781, 0.0312};
Tr[#[[-3 ;;]] - #[[;; 3]]] &@list

0.227

Edit:

Just answering comments:

Total@{0.2500, 0.0781, 0.0312} - Total@{0.0152, 0.0937, 0.0234}

0.227

$\endgroup$
4
  • $\begingroup$ "Total@Take" seems to work. But the answer I got was 0.015625, not 0.227. (I verified the result on a pocket calculator). Am I missing something? @belisarius $\endgroup$
    – Joel Mayer
    Aug 13 '13 at 19:54
  • 1
    $\begingroup$ @JoelMayer Probably a new pair of batteries :). see edit $\endgroup$ Aug 13 '13 at 20:18
  • $\begingroup$ A thousand (1x10^3) pardons my lords and masters. I transcribed 0.234 when I should have transcribed 0.0234. @belisarius $\endgroup$
    – Joel Mayer
    Aug 13 '13 at 22:20
  • $\begingroup$ @JoelMayer Easier here than in a peer reviewed paper :) $\endgroup$ Aug 13 '13 at 22:40
4
$\begingroup$
data = {0.0152, 0.0937, 0.0234, 0.2969, 0.2500, 0.0781, 0.0312};

Somehow this seems too boring, but all the good answers seem taken:

 data[[-1]] + data[[-2]] + data[[-3]] - data[[1]] - data[[2]] - data[[3]]

Some find American baseball boring. Well, at least we can speed up an "inning":

threeUPthreeDOWN = Compile[{{data, _Integer, 1}}, 
  data[[-1]] + data[[-2]] + data[[-3]] - data[[1]] - data[[2]] - data[[3]]
  ]

Then we don't have to wait long for it to be over:

r = RandomInteger[999, {5000}];
Do[threeUPthreeDOWN[r], {500000}] // Timing // First
(* 0.214847 *)

Compared to Mr.Wizard's less fun method:

Do[r[[{-1, -2, -3, 1, 2, 3}]].{1, 1, 1, -1, -1, -1}, {500000}] // Timing // First
(* 0.604915 *)

Boring rules! :)


Horses that know how to count know the following method as an order 3 farrier transform filter:

farrier3[data_List] := Module[{list, n, m, ker},
  list = If[EvenQ[n = Length@#], Insert[#, 0, 1 + n++/2], #] &@data;
  m = (n - 1)/2;
  ker = Sum[Sin[(m - k + 1) x], {k, 3}];
  1/(Pi I)
     Integrate[list . Table[Exp[I (k - m - 1) x] * ker, {k, n}], {x, -Pi, Pi}] // Re
  ]

farrier3[data]
(* 0.227 *)

farrier3[Range@12]
(* 27 *)

Clearly this is a lot more fun, but even I get tired of it after a while:

r = RandomInteger[999, {5000}];
farrier3[r] // Timing // First

Hmm...if it ever finishes, I'll update the time. Ah...finally

(* 10371.737221 *)
$\endgroup$
2
  • $\begingroup$ That last timing has to be fake. Please tell me it is fake. :-p (+1) $\endgroup$
    – Mr.Wizard
    Aug 14 '13 at 5:40
  • 1
    $\begingroup$ @Mr.Wizard No, it's not fake. I let it run while we were making dinner. But I'm glad you didn't object that I didn't do 500,000 runs. :D $\endgroup$
    – Michael E2
    Aug 14 '13 at 11:00
3
$\begingroup$

Ok, so if we are having fun:

{-1, -1, -1, 0, 1, 1, 1}.list
0.227

@Mr.Wizard - I don't know how to do this neatly :)

SparseArray[{1, 2, 3, -3, -2, -1} -> {-1, -1, -1, 1, 1, 1}, Length@list, 0].list
0.227
$\endgroup$
14
  • $\begingroup$ Add a second line where you generate the number of zeros based on the length of the list and you'll have my vote. $\endgroup$
    – Mr.Wizard
    Aug 13 '13 at 18:34
  • $\begingroup$ Go for ListConvolve and you shall have mine. $\endgroup$
    – Yves Klett
    Aug 13 '13 at 18:35
  • $\begingroup$ Actually I like that. :-) $\endgroup$
    – Mr.Wizard
    Aug 13 '13 at 18:41
  • $\begingroup$ @Mr.Wizard I'm glad you do :) $\endgroup$
    – Kuba
    Aug 13 '13 at 18:41
  • $\begingroup$ @Kuba I deleted it since it fails for lists shorter than 7 elements $\endgroup$ Aug 13 '13 at 18:44
3
$\begingroup$

If you're late to a party, you end up using a bazooka to kill a fly:

bazooka[list_] := ListCorrelate[{1, 1, 1, -1, -1, -1}, list, {1, 1}][[-3]]
bazooka[Range@12]
(* 27 *)
$\endgroup$
2
  • $\begingroup$ Let's make this competitive: bazooka2[list_] := ListCorrelate[{1, 1, 1, -1, -1, -1}, list, {-3 - Length@list, 3}] $\endgroup$
    – Mr.Wizard
    Aug 13 '13 at 19:29
  • $\begingroup$ @Mr.Wizard Hehe, I was too lazy to bother with the third argument. bazooka3[list_] := With[{p1 = # - 5, p2 = # - 2}, SlotSequence[p1] - 2 SlotSequence[p2] & @@ RotateLeft[list, 3]] &@ Length@list Your move :D $\endgroup$
    – rm -rf
    Aug 13 '13 at 19:48
3
$\begingroup$
rule =  {firstNumber_, secondNumber_, thirdNumber_, middleNumbers___, 
    antePenultimateNumber_, penultimateNumber_, lastNumber_} :> 
   Total[{antePenultimateNumber, penultimateNumber, lastNumber}] - 
    Total[{firstNumber, secondNumber, thirdNumber}];

list /. rule

0.227

$\endgroup$
11
  • $\begingroup$ What's the opposite of Code Golf? $\endgroup$
    – cormullion
    Aug 13 '13 at 17:56
  • $\begingroup$ +1 for taking your time to write all that $\endgroup$ Aug 13 '13 at 17:56
  • 1
    $\begingroup$ @Yves I've always held that a question is what you make of it. :-) $\endgroup$
    – Mr.Wizard
    Aug 13 '13 at 18:31
  • 1
    $\begingroup$ @Mr.Wizard Ah. On reflection, though, I'm going for 'self-documenting code'... :) $\endgroup$
    – cormullion
    Aug 13 '13 at 19:14
  • 1
    $\begingroup$ rule name does not fit, did you think about sumofthefirstthreeandlastthreeelementsrule? $\endgroup$
    – Kuba
    Aug 14 '13 at 6:28

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.