Histogram/BarChart data replacement conundrum

Question

I am trying to make a histogram or bar chart for multiple large data sets, with 52 bins where I need to do the following operations:

A) Tally the counts per bin (which I have done reasonably easily using Flatten and Tally, shown below)

B) And the more difficult problem as follows: Say I have a table such as

{{{{{1, 2, 3, 46, 47, 48, 49, 50, 51, 52}, 5.}}, {{{1, 12, 23, 46, 47}, 1.}}, {{{5, 6, 7, 8}, 
20.}}, {{{5, 6, 7, 8, 15, 16, 17}, 34.}}}}

where the first item in each group (1-52) represent the bins and the second item (5 in the first example) represents the value I want to plot.

Taking the first group as an example, I want to insert the number "5" into bins 1,2,3,46,47,48,49,50,51 and 52. As I iterate through my lists I want to keep filling the bins, so the second group has a "1" in bins 1,12,23,46, and 47, so I would want "6" in the bins that overlap. On and on and on through a decent chunk of data.

I've tried many different attempts at a solution using Thread, Collect, Gather, etc. I've tried making more tables or re-indexing, but I'm not closer to a solution than I was when I started. Thanks in advance!

Answer 1

Is this what you want?

rawData = {{{{{1, 2, 3, 46, 47, 48, 49, 50, 51, 52}, 
     5.}}, {{{1, 12, 23, 46, 47}, 1.}}, {{{5, 6, 7, 8}, 
     20.}}, {{{5, 6, 7, 8, 15, 16, 17}, 34.}}}};

I don't like the nesting in the raw data but do not know how you are generating it. Working with it as it is, first step create cleaner data:

data = Sort@
  Flatten[{Map[Thread[Rule[#1[[1, 1]], #1[[1, 2]]]] &, rawData[[1]]], 
    Thread[Range[52] -> 0.]}]

Second step fill the bins by totalling what you have

totals=Values@GroupBy[data, First -> Last, Total]

{6., 5., 5., 0., 54., 54., 54., 54., 0., 0., 0., 1., 0., 0., 34., 34., 34., 0., 0., 0., 0., 0., 1., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 6., 6., 5., 5., 5., 5., 5.}

or just plot:

So two steps which I'd like to think are fairly intuitive.

Answer 2

How about:

collate[data_] := Block[{res=ConstantArray[0,52]},
    res[[#1]] += #2& @@@ Level[data, {-3}];
    res
]

Your example:

data = {{
    {{{1, 2, 3, 46, 47, 48, 49, 50, 51, 52}, 5.}},
    {{{1, 12, 23, 46, 47}, 1.}}, {{{5, 6, 7, 8}, 20.}},
    {{{5, 6, 7, 8, 15, 16, 17}, 34.}}
}};

collate[data]

{6., 5., 5., 0, 54., 54., 54., 54., 0, 0, 0, 1., 0, 0, 34., 34., 34., 0, 0, 0, 0, 0, 1., 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 6., 6., 5., 5., 5., 5., 5.}

Answer 3

f = Function[{x, y}, MapAt[# + y[[2]]&, x, List /@ y[[1]]]];
Fold[f, Array[0 &, 52], data[[1, All, 1]]]

{6., 5., 5., 0, 54., 54., 54., 54., 0, 0, 0, 1., 0, 0, 34., 34., 34., 0, 0, 0, 0, 0, 1., 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 6., 6., 5., 5., 5., 5., 5.}