Re: Reducing binary representation

*To*: mathgroup at smc.vnet.net*Subject*: [mg57184] Re: Reducing binary representation*From*: Paul Abbott <paul at physics.uwa.edu.au>*Date*: Fri, 20 May 2005 04:43:16 -0400 (EDT)*Organization*: The University of Western Australia*References*: <d6heg9$d24$1@smc.vnet.net>*Sender*: owner-wri-mathgroup at wolfram.com

In article <d6heg9$d24$1 at smc.vnet.net>, Torsten Coym <torsten.coym at eas.iis.fraunhofer.de> wrote: > I want to reduce the number of coefficients in the binary representation > of arbitrary integer numbers. I managed to convert an integer number > into a sum of powers of two in the following way: > > In[7]:= > ToBinary[x_, n_] := Plus @@ > Sequence[MapThread[Times, > {Table[(HoldForm[2^#1] & )[i], {i, n - 1, 0, -1}], > IntegerDigits[x, 2, n]}]] I don't think that n is required here. Here is simpler code for doing what you want: PowerSum[x_] := Reverse[x] . 2^HoldForm /@ (Range[Length[x]] - 1) ToBinary[x_] := PowerSum[IntegerDigits[x, 2]] > The sum of adjacent powers of two can be reduced as follows: > > In[9]:= > Sum[2^i, {i, k, j}] > > Out[9]= > 2^(1 + j) - 2^k > > I now want to apply that to the binary number representation, so that > 121 will become > > 2^7-2^3+2^0 > > but I cannont figure out how to do this. If I release the Hold[] > Mathematica just evaluates all the terms containing "2" to get "121", > which is not what I want ;) > > Unfortunately I have no idea how to tackle this kind of problem. Any > suggestion would be appreciated. One approach is to use pattern-matching: ReducedSum[x_] := PowerSum[IntegerDigits[x, 2] /. {1, 1, b___} :> {1, 0, -1, b} //. {{a___, c_, d_, b___} :> {a, 0, c, b} /; c == -d != 0, {a___, 0, c_, d_, b___} :> {a, c, 0, -c, b} /; c == d != 0}] For example, ToBinary[123451] 2^HoldForm[0] + 2^HoldForm[1] + 2^HoldForm[3] + 2^HoldForm[4] + 2^HoldForm[5] + 2^HoldForm[9] + 2^HoldForm[13] + 2^HoldForm[14] + 2^HoldForm[15] + 2^HoldForm[16] ReleaseHold[%] 123451 ReducedSum[123451] -2^HoldForm[0] - 2^HoldForm[2] + 2^HoldForm[6] + 2^HoldForm[9] - 2^HoldForm[13] + 2^HoldForm[17] ReleaseHold[%] 123451 Cheers, Paul -- Paul Abbott Phone: +61 8 6488 2734 School of Physics, M013 Fax: +61 8 6488 1014 The University of Western Australia (CRICOS Provider No 00126G) AUSTRALIA http://physics.uwa.edu.au/~paul http://InternationalMathematicaSymposium.org/IMS2005/