Mathematica 9 is now available
Services & Resources / Wolfram Forums
-----
 /
MathGroup Archive
2007
*January
*February
*March
*April
*May
*June
*July
*August
*September
*October
*Archive Index
*Ask about this page
*Print this page
*Give us feedback
*Sign up for the Wolfram Insider

MathGroup Archive 2007

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

Search the Archive

What is the problem?

  • To: mathgroup at smc.vnet.net
  • Subject: [mg77786] What is the problem?
  • From: blueoceanally at gmail.com
  • Date: Sat, 16 Jun 2007 04:02:58 -0400 (EDT)

I wanna generate a tree,but what is the problem?

<< Graphics`Arrow`;
SetOptions[Arrow, HeadScaling -> Relative, HeadCenter ->
    1, HeadWidth -> 0.5, HeadLength -> 0.5];

trans[this_] := Which[this == 1, n = {2, 3}, this == 2, n = {=
3, 4},
this ==
    3, n = {4, 0}, this == 4, n = {1, 0}];

xx = Table[0, {i, 1, 10}, {j, 1, 30}];(*=B4=E6=BA=E1=D7=F8=B1=EA*)
tempx = Table[0, {i, 1, 30}, {j, 1, 2}];(*=B4=E6=D6=D0=BC=E4=D6=B5*)
tempn = Table[0, {i, 1, 30}, {j, 1, 2}];(*=B4=E6=D6=D0=BC=E4=D6=B5*)
n = Table[0, {i, 1, 10}, {j, 1, 30}];

n[[1, 1]] = 1;

For[i = 1, i =A1=DC 9, i = i + 1,
  {
    For[j = 1, j =A1=DC 30, j = j + 1,
      {
        If[n[[i, j]] =A1=D9 0, {
            Which[
              n[[i, j]] == 1,
              tempn[[j]] = trans[1];
              tempx[[j, 1]] = xx[[i, j]] - 1/(2i); tempx[[j, 2]] =
     xx[[i, j]] + 1/(2i); Show[Graphics[{Hue[0.1], Arrow[{xx[[i, j]],
i}, {tempx[[j, 1]], i + 1}],
                                                Hue[
0=2E8], Arrow[{tempx[[j, 2]], i}, {tempx[[j, 2]], i + 1}]}],
   AspectRatio -> Automatic],(*=BB=AD=BC=FD=CD=B7*)

              n[[i, j]] == 2,
              tempn[[j]] = trans[2];
              tempx[[j, 1]] = xx[[i,
              j]] - 1/(2i); tempx[[j, 2]] = xx[[i,
                 j]] + 1/(2i); Show[Graphics[{Hue[0.6],
              Arrow[{xx[[i, j]], i}, {tempx[[j, 1]], i + 1}],


                           Hue[1],
                   Arrow[{tempx[[j, 2]],
                     i}, {tempx[[j, 2]], i + 1}]}], AspectRatio ->
                       Automatic],

              n[[i, j]] == 3,
              tempn[[j]] = trans[3];
              tempx[[j, 1]] = xx[[i, j]]; Show[Graphics[{
                      Hue[0.9], Arrow[{xx[[i, j]], i}, {tempx[[j,
1]],
                        i + 1}]}], AspectRatio -> Automatic],

              n[[i, j]] == 4,
              tempn[[j]] = trans[4];
              tempx[[j, 1]] = xx[[i, j]]; Show[Graphics[{
              Hue[0.2], Arrow[{xx[[i, j]], i}, {tempx[[j, 1]], i +
1}]}],
              AspectRatio -> Automatic]
              ];

            For[x = 1, x =A1=DC 30, x = x + 1, Print[n[[2, 1]]]; {For[y=
 =
1, y
              =A1=DC 2, y = y + 1, {If[tempx[[x,
                   y]] =A1=D9 0, xx[[i + 1, x]] = tempx[[x, y]]]}]}];

            For[x = 1, x =A1=DC 30, x = x + 1,
              {
              For[y = 1, y =A1=DC 2, y = y + 1, {If[tempn [[x, y]] =A1=
=D9 0,
n[[i +
                  1, x]] = tempn[[x, y]]]}]}];

            }]
        }]
    }]



  • Prev by Date: Re: Re: v6: still no multiple undo?
  • Next by Date: Re: Re: Re: Fast interactive graphics
  • Previous by thread: Re: 3D plot with one logarithmic axes (II)
  • Next by thread: Re: What is the problem?