Re: Tree with repeated labels

• To: mathgroup at smc.vnet.net
• Subject: [mg113272] Re: Tree with repeated labels
• From: Bob Hanlon <hanlonr at cox.net>
• Date: Thu, 21 Oct 2010 07:03:34 -0400 (EDT)

```feasible == {2, 3, 5, 6, 7, 8};

squareQ[n_Integer?Positive] :==
IntegerQ[Sqrt[Times @@ IntegerDigits[n]]];

prop[n_Integer?Positive] :==
n -> (10 n + Complement[feasible,
{Last[IntegerDigits[n]]}])]];

Clear[tree];

tree[1] == {prop[2]};

tree[n_Integer?Positive] :== tree[n] ==
Append[tree[n - 1], Flatten[
prop /@ Last /@ Last[tree[n - 1]]]];

With[{n == 3},
TreePlot[Flatten[tree[n]],
Center,
ImageSize -> 225*n,
VertexRenderingFunction ->
({White, EdgeForm[Black],
Disk[#, If[squareQ[#2], 0.075, 0]*{1, 1}],
Black,
Text[If[squareQ[#2] || Log[10, #2] <== n,
Style[Last[IntegerDigits[#2]], Bold], ""], #1]} &)]]

Bob Hanlon

---- "Francisco Javier Garc=C3=ADa Capit=C3=A1n" <garciacapitan at gmail.com> =
wrote:

==========================

I fact, I was working on a sequence of digits that I wanted to show as a
tree.

The sequence is of this form:

{28, 236, 263, 2323, 2383, 2525, 2585, 2626, 2686, 2727, 2787, 23262, \
23268, 23286, 23565, 23767, 23826, 23862, 23868, 25356, 25365, 25635, \
25653, 26232, 26238, 26283, 26535, 26737, 26823, 26832, 26838, 27367, \
27376, 27637, 27673, ...}

without two equal digits together and ending each number when the product of
the current digits make a perfect square.

I have written the code that returns the list above, and I don't know what
is more appropriate: write a code to generate the tree from the list or
writting the code for the tree directly.

Honestly, I dont't know to do any of them. Some idea?

Best regards,

Francisco Javier.

My code giving the sequence above is as follows:

NextLevel[list_] :== Module[{k, newlist, feasible},
feasible == {2, 3, 5, 6, 7, 8};
newlist == {};
For[k == 1, k <== Length[feasible], k++,
If[Last[list] !== feasible[[k]],
newlist == Append[newlist, Append[list, feasible[[k]]]]
]];
newlist
]

GenerateTreeData[seed_, numlevels_] :==
Module[{n, paths, completed, totalcompleted},
paths == seed;
totalcompleted == {};
For[n == 1, n <== numlevels, n++,
paths == Apply[Join, Map[NextLevel, paths]];
completed == Select[paths, IntegerQ[Sqrt[Apply[Times, #]]] &];
paths == Complement[paths, completed];
totalcompleted == Join[totalcompleted, completed]
];
totalcompleted
]

digits == GenerateTreeData[{{2}}, 4]

{{2, 8}, {2, 3, 6}, {2, 6, 3}, {2, 3, 2, 3}, {2, 3, 8, 3}, {2, 5, 2,
5}, {2, 5, 8, 5}, {2, 6, 2, 6}, {2, 6, 8, 6}, {2, 7, 2, 7}, {2, 7,
8, 7}, {2, 3, 2, 6, 2}, {2, 3, 2, 6, 8}, {2, 3, 2, 8, 6}, {2, 3, 5,
6, 5}, {2, 3, 7, 6, 7}, {2, 3, 8, 2, 6}, {2, 3, 8, 6, 2}, {2, 3, 8,
6, 8}, {2, 5, 3, 5, 6}, {2, 5, 3, 6, 5}, {2, 5, 6, 3, 5}, {2, 5, 6,
5, 3}, {2, 6, 2, 3, 2}, {2, 6, 2, 3, 8}, {2, 6, 2, 8, 3}, {2, 6, 5,
3, 5}, {2, 6, 7, 3, 7}, {2, 6, 8, 2, 3}, {2, 6, 8, 3, 2}, {2, 6, 8,
3, 8}, {2, 7, 3, 6, 7}, {2, 7, 3, 7, 6}, {2, 7, 6, 3, 7}, {2, 7, 6,
7, 3}}

Map[FromDigits, digits]

{28, 236, 263, 2323, 2383, 2525, 2585, 2626, 2686, 2727, 2787, 23262, \
23268, 23286, 23565, 23767, 23826, 23862, 23868, 25356, 25365, 25635, \
25653, 26232, 26238, 26283, 26535, 26737, 26823, 26832, 26838, 27367, \
27376, 27637, 27673}

El 20 de octubre de 2010 03:50, Bob Hanlon <hanlonr at cox.net> escribi=C3=B3:

>
> tree[1, nBranches_: 3] :== tree[1, nBranches] ==
>
> tree[n_Integer?Positive, nBranches_: 3] :==
>  tree[n, nBranches] ==
>  Flatten[{tree[n - 1, nBranches],
>    Thread[# -> (10 # + Range[nBranches])] & /@
>
>     Last /@ Take[tree[n - 1, nBranches],
>       -nBranches^(n - 1)]}]
>
> nLevels == 3;
>
> TreePlot[tree[nLevels], Left,
>  VertexRenderingFunction ->
>  ({White, EdgeForm[Black], Disk[#, 0.1],
>     Black,
>     Text[Last[IntegerDigits[#2]], #1]} &),
>  ImageSize -> 85*nLevels]
>
>
> Bob Hanlon
>
> ---- "Francisco Javier Garc=C3=ADa Capit=C3=A1n" <garciacapitan at gmail.com=
> wrote:
>
> ==========================
> I would like (using TreePlot or another way) to display a tree with say
> three levels  such that the root is the symbol 0 and each node having thr=
ee
> daughters labelled 1, 2 and 3
>
> TreePlot[{0->1, 0->2,0->3}]
>
> does the first level, but I don't know how  to continue.
>

```

• Prev by Date: Re: Special permutation pattern ascending groups sum
• Next by Date: Re: := vs = in some function definitions
• Previous by thread: Re: Tree with repeated labels
• Next by thread: Symbolic Manipulation of Matrices [Newbie Question]