Services & ResourcesWolfram ForumsMathGroup Archive

[Date Index] [Thread Index] [Author Index]

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] :==
  If[squareQ[n], {}, Thread[
    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:

==========================
Thank you for your answer,

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, ...}

In this case we start with 2 and we are adding digits from {2,3,5,6,7,8}
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] ==
>   Thread[0 -> Range[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.
>