Trying to quickly split lists at the point of maximum variance reduction

*To*: mathgroup at smc.vnet.net*Subject*: [mg127593] Trying to quickly split lists at the point of maximum variance reduction*From*: Earl Mitchell <earl.j.mitchell at gmail.com>*Date*: Sun, 5 Aug 2012 14:59:54 -0400 (EDT)*Delivered-to*: l-mathgroup@mail-archive0.wolfram.com*Delivered-to*: l-mathgroup@wolfram.com*Delivered-to*: mathgroup-newout@smc.vnet.net*Delivered-to*: mathgroup-newsend@smc.vnet.net

Hi all, I've got a list of 42,000 lists of 233 variables (integers from 1 to 250), each with a response in the last position (integer from 0 to 9). I want to find the variable and split point in that variable at which the weighted average variance in the response will be minimized. As a trivial example say the original variance in the response for the whole set is 100. Imagine that there is some variable, say at position 220, which has Tally'd values of {{0,40,000},{1,2000}} and, if we split the corresponding responses along this break point the weighted average variance of the two lists is 80, which happens to be the lowest possible resulting variance for any single split, on any single variable. How can I find this point quickly? This description might be confusing - let me know if something is not clear. Thanks ahead of time for the help! Mitch PS. Currently this job can be done in with this code: FindMaxVarianceReductionSplit[data_List] := Module[{transdata, splitvarreductionpairs, withoutputs, testsplits, split, endvar, maxvarreduction}, transdata = Transpose[data]; splitvarreductionpairs = With[{outputs = transdata[[-1]]}, ParallelTable[ With[{inputs = transdata[[i]], startvar = N@NewVariance[outputs]}, withoutputs = Thread[{inputs, outputs}]; testsplits = Union[inputs]; Table[ With[{splitval = testsplits[[j]]}, split = GatherBy[withoutputs, #[[1]] > splitval &]; endvar = Total[(N@Length[#]*NewVariance[#[[All, -1]]] & /@ split)/ Length[withoutputs]]; {splitval, startvar - endvar} ] , {j, Length[testsplits]}]], {i, Length[Most[transdata]]}] ]; maxvarreduction = Max[Flatten[splitvarreductionpairs, 1][[All, -1]]]; Position[splitvarreductionpairs, maxvarreduction] ] ... on my brand spanking new MBP it completes in just under 1,000 seconds being parallelized. I need this to run much faster to have any practical applications. Thanks again!