忘记密码   免费注册 查看新帖 | 论坛精华区

ChinaUnix.net

  平台 论坛 博客 认证专区 大话IT 视频 徽章 文库 沙龙 自测 下载 频道自动化运维 虚拟化 储存备份 C/C++ PHP MySQL 嵌入式 Linux系统
12
最近访问板块 发新帖
楼主: hztj2005

哪位大侠有树的实例代码 [复制链接]

论坛徽章:
7
戌狗
日期:2013-12-15 20:43:38技术图书徽章
日期:2014-03-05 01:33:12技术图书徽章
日期:2014-03-15 20:31:17未羊
日期:2014-03-25 23:48:20丑牛
日期:2014-04-07 22:37:44巳蛇
日期:2014-04-11 21:58:0915-16赛季CBA联赛之青岛
日期:2016-03-17 20:36:13
发表于 2017-05-18 01:50 |显示全部楼层
本帖最后由 rubyish 于 2017-05-19 21:27 编辑

1 ge Gtk3

tree:
  1. [ Sophia
  2.     Emma
  3.     Olivia
  4.     [ Ava
  5.         Mia
  6.         [ Isabella
  7.             Riley
  8.             Aria
  9.             [ Zoe
  10.                 Charlotte
  11.                 Lily
  12.                 [ Layla
  13.                     Amelia
  14.                 ]
  15.             ]
  16.         ]
  17.         Emily
  18.         Madelyn
  19.     ]
  20.     [ Aubrey
  21.         Adalyn
  22.         Madison
  23.         [ Chloe
  24.             [ Harper
  25.                 Abigail
  26.                 [ Aaliyah
  27.                     Avery
  28.                 ]
  29.             ]
  30.             Evelyn
  31.         ]
  32.     ]
  33.     [ Nora
  34.         Kaylee
  35.         Ella
  36.         [ Ellie
  37.             [ Scarlett
  38.                 [ Arianna
  39.                     Hailey
  40.                 ]
  41.             ]
  42.         ]
  43.             
  44.     ]
  45. ]
复制代码

editor2.jpg

tu:
mexp3ok.jpg

code: v1a

  1. #!/usr/bin/perl -w
  2. use 5.010;
  3. use Gtk3 '-init';

  4. sub give;
  5. sub me;
  6. sub that;

  7. my $nor = new Pango::FontDescription;
  8. my $big = new Pango::FontDescription;
  9. $nor->set_size(12000);    # font size
  10. $big->set_size(14000);

  11. my ( $KELAS, @X, @KELAS, @POS ) = 0;
  12. # @POS = ( 50, 100 );       # set @POS or mouse position

  13. my $TREE = 'tree';
  14. give me that $TREE;

  15. #____________________SUB____________________

  16. sub that {
  17.     open my $DATA, shift;
  18.     local $_ = do { local $/; <$DATA> };
  19.     s/(\w+)/'$1',/g, s/\]/],/g;
  20.     eval;
  21. }

  22. sub give {
  23.     local $_ = shift;
  24.     @POS ? $_->move(@POS) : $_->set_position('mouse');
  25.     $_->set_skip_taskbar_hint(0);
  26.     $_->set_title( $TREE // 'tree' );
  27.     $_->show_all;
  28.     Gtk3->main;
  29. }

  30. sub me {
  31.     state $iD = 0;
  32.     my ( $tree, $kelas ) = ( @_, 0 );
  33.     my $win = new Gtk3::Window;
  34.     my $box = new Gtk3::Box( 'vertical', 0 );
  35.     my $i   = $KELAS[$kelas] = 0;

  36.     for (@$tree) {
  37.         my $but = new Gtk3::Button;

  38.         if (ref) {
  39.             $but->set_label("  $_->[0]  >");
  40.             $but->signal_connect(
  41.                 enter_notify_event => \&enter_notify_A,
  42.                 [ $win, $_, $kelas, $i, ++$iD, ~~@$tree ]
  43.             );
  44.         }
  45.         else {
  46.             $but->set_label("  $_   ");
  47.             $but->signal_connect(
  48.                 enter_notify_event => \&enter_notify_B,
  49.                 [$kelas]
  50.             );
  51.         }

  52.         $but->set_alignment( 1, 0 );
  53.         $but->modify_font($nor);
  54.         $box->add($but);
  55.         $i++;
  56.     }

  57.     $win->set_decorated(0);
  58.     $win->set_skip_taskbar_hint(1);
  59.     $win->add($box);
  60.     my ($but) = $box->get_children;
  61.     $but->set_label( $but->get_label . 'x' );
  62.     $but->signal_connect( clicked => sub { Gtk3::main_quit } );
  63.     $but->modify_font($big);
  64.     $win;
  65. }

  66. sub enter_notify_A {
  67.     my $args = pop;
  68.     my ( $win, $tree, $kelas, $i, $id, $size ) = @$args;
  69.     $X[ $KELAS[$_] ]->hide, $KELAS[$_] &&= 0 for $kelas + 1 .. $KELAS;
  70.     $KELAS = $kelas;

  71.     return if $id == $KELAS[$kelas];
  72.     $X[ $KELAS[$kelas] ]->hide if $KELAS[$kelas];
  73.     $X[$id] //= me( $tree, $kelas + 1 );
  74.     $KELAS[$kelas] = $id;
  75.     my ( $x, $y ) = $win->get_position;
  76.     my ( $w, $h ) = $win->get_size;

  77.     $i -= @$tree / 2;
  78.     $X[$id]->move( $x + $w + 1, $y + $h / $size * $i );
  79.     $X[$id]->show_all;
  80. }

  81. sub enter_notify_B {
  82.     my $kelas = pop->[0];
  83.     $KELAS[$_] && $X[ $KELAS[$_] ]->hide, $KELAS[$_] &&= 0 for $kelas .. $KELAS;
  84.     $KELAS = $kelas - 1;
  85. }
  86. __DATA__
  87. $_



复制代码


评分

参与人数 1信誉积分 +10 收起 理由
hztj2005 + 10 很给力!

查看全部评分

论坛徽章:
7
戌狗
日期:2013-12-15 20:43:38技术图书徽章
日期:2014-03-05 01:33:12技术图书徽章
日期:2014-03-15 20:31:17未羊
日期:2014-03-25 23:48:20丑牛
日期:2014-04-07 22:37:44巳蛇
日期:2014-04-11 21:58:0915-16赛季CBA联赛之青岛
日期:2016-03-17 20:36:13
发表于 2017-05-18 01:54 |显示全部楼层
本帖最后由 rubyish 于 2017-05-17 21:59 编辑

d . e . l  ~ ~

论坛徽章:
2
综合交流区版块每日发帖之星
日期:2016-07-06 06:20:00综合交流区版块每日发帖之星
日期:2016-08-16 06:20:00
发表于 2017-05-18 11:20 |显示全部楼层
回复 5# 523066680

论坛徽章:
0
发表于 2017-05-19 23:33 |显示全部楼层
本帖最后由 hztj2005 于 2017-05-19 23:42 编辑



谢谢大侠出手!
请教一下,上面图中第一层中Sophia是父节点,有5个子节点,对吧?
    Emma
    Olivia
    Ava
    Aubrey
    Nora

论坛徽章:
7
戌狗
日期:2013-12-15 20:43:38技术图书徽章
日期:2014-03-05 01:33:12技术图书徽章
日期:2014-03-15 20:31:17未羊
日期:2014-03-25 23:48:20丑牛
日期:2014-04-07 22:37:44巳蛇
日期:2014-04-11 21:58:0915-16赛季CBA联赛之青岛
日期:2016-03-17 20:36:13
发表于 2017-05-20 01:54 |显示全部楼层
本帖最后由 rubyish 于 2017-05-19 21:59 编辑

回复 14# hztj2005

shide~~

print:

  1. #!/usr/bin/perl -w

  2. use 5.010;
  3. sub save;
  4. sub load;
  5. sub draw;

  6. my $tree = load 'tree';
  7. draw $tree;

  8. save $tree, 'test.3';

  9. #____________________SUB____________________

  10. sub draw { D_( $_[0], [], 1 ) }

  11. sub save {
  12.     my ( $config, $file ) = @_;
  13.     open my $save, '>', $file;
  14.     say $save '[', S_( $config, 1 ), ']';
  15.     close $save;
  16. }

  17. sub load {
  18.     open my $DATA, shift;
  19.     local $_ = do { local $/; <$DATA> };
  20.     s/(\w+)/'$1',/g, s/\]/],/g;
  21.     eval;
  22. }

  23. sub S_ {
  24.     my ( $A, $L ) = @_;
  25.     my $first;
  26.     my $TAB = '    ' x $L;

  27.     join '', map {
  28.         ref ? "${TAB}[" . S_( $_, $L + 1 ) . "$TAB]\n"
  29.             : ($first++ ? $TAB : ' ' ) . "$_\n"
  30.     } @$A;
  31. }

  32. sub D_ {
  33.       state $his = [];
  34.       my ( $do, $mo, $x ) = @_;
  35.       if ( !ref $do ) {
  36.           push @$mo, $do;
  37.           for ( my $i = 0 ; $i <= $#$mo ; $i += 2 ) {
  38.               if ( !defined $his->[$i] || $mo->[$i] ne $his->[$i] ) {
  39.                   print "|- $mo->[$i] ";
  40.               }
  41.               else {
  42.                   my $tab = $mo->[ $i + 1 ] ? ' ' : '|';
  43.                   print $tab . ' ' x ( length( $his->[$i] ) + 3 );
  44.               }
  45.           }
  46.           print "\n";
  47.           $his = $mo;
  48.           return;
  49.       }

  50.       D_( $do->[$_], [ @$mo, $do->[0], $x ], 0 ) for 1 .. $#$do - 1;
  51.       D_( $do->[-1], [ @$mo, $do->[0], $x ], 1 );
  52. }

  53. # tree

  54. __DATA__
  55. [ Sophia
  56.     Emma
  57.     Olivia
  58.     [ Ava
  59.         Mia
  60.         [ Isabella
  61.             Riley
  62.             Aria
  63.             [ Zoe
  64.                 Charlotte
  65.                 Lily
  66.                 [ Layla
  67.                     Amelia
  68.                 ]
  69.             ]
  70.         ]
  71.         Emily
  72.         Madelyn
  73.     ]
  74.     [ Aubrey
  75.         Adalyn
  76.         Madison
  77.         [ Chloe
  78.             [ Harper
  79.                 Abigail
  80.                 [ Aaliyah
  81.                     Avery
  82.                 ]
  83.             ]
  84.             Evelyn
  85.         ]
  86.     ]
  87.     [ Nora
  88.         Kaylee
  89.         Ella
  90.         [ Ellie
  91.             [ Scarlett
  92.                 [ Arianna
  93.                     Hailey
  94.                 ]
  95.             ]
  96.         ]
  97.             
  98.     ]
  99. ]

复制代码

论坛徽章:
0
发表于 2017-05-28 02:10 |显示全部楼层

To rubyish大侠,

可否将3楼的文件输入格式改为如下
root:Sophia  # parent:child 格式
root:Amelia
root:Emily
Sophia:Emma
Sophia:Isabella

Etc....

Mia:Null
Ava:Null

这样便于输入,去除嵌套的[]的格式,或者请写一格式转换程式,万分感谢!!!

论坛徽章:
7
戌狗
日期:2013-12-15 20:43:38技术图书徽章
日期:2014-03-05 01:33:12技术图书徽章
日期:2014-03-15 20:31:17未羊
日期:2014-03-25 23:48:20丑牛
日期:2014-04-07 22:37:44巳蛇
日期:2014-04-11 21:58:0915-16赛季CBA联赛之青岛
日期:2016-03-17 20:36:13
发表于 2017-05-30 03:09 |显示全部楼层
回复 16# mjus

shishi:
perl abc.pl tree
perl abc.pl tree 0
perl abc.pl tree 2
perl abc.pl tree 4
.............

tree:
  1. Sophia:Emma
  2.     Emma:Olivia
  3.     Emma:Ava
  4.         Ava:Mia
  5.             Mia:Isabella
  6.                 Isabella:Riley
  7.         Ava:Aria
  8.         Ava:Zoe
  9.     Emma:Charlotte
  10.         Charlotte:Lily
  11.             Lily:Layla
  12. Sophia:Amelia
  13.     Amelia:Emily
  14.         Emily:Madelyn
  15. Sophia:Aubrey
  16.     Aubrey:Adalyn
  17.     Aubrey:Madison
  18.         Madison:Chloe
  19.             Chloe:Harper
复制代码
biru:
  1. #!/usr/bin/perl
  2. use 5.016;

  3. my $args = @ARGV;
  4. my $TAB;
  5. my $NODE = qr/(\w+)\s*:\s*(\w+)/;

  6. if ( $args == 1 ) {
  7.     draw( it() );
  8. }
  9. elsif ( $args == 2 ) {
  10.     $TAB = pop @ARGV;
  11.     my %format = these();
  12.     $format{ $TAB ? 1 : 2 }( it() );
  13. }
  14. else {
  15.     say 'use: perl abc.pl file';
  16.     say 'or : perl abc.pl file n  [ n = 0, 1, 2... ]';
  17. }

  18. # ____________________SUB____________________

  19. sub these {
  20.     1 => sub { F1_( @_, -1, '' ) },
  21.     2 => sub { F2_( @_, -1, '' ) }
  22. }

  23. sub draw { D_( @_, [], 0 ) }

  24. sub it {
  25.     my ( $seen, @node ) = map { my @w = /$NODE/; @w ? \@w : () } <>;
  26.     my $last = pop @$seen;
  27.     my @tree = [ @$seen, [$last] ];

  28.     for (@node) {
  29.         my ( $a, $b ) = @$_;
  30.         if ( $a eq $last ) { push @$seen, $a; }
  31.         elsif ( $a ne $seen->[-1] ) {
  32.             for ( my $i = $#$seen - 1 ; $i >= 0 ; $i-- ) {
  33.                 $#$seen = $i, last if $seen->[$i] eq $a;
  34.             }
  35.         }

  36.         $last = $b;
  37.         my $R = \@tree;
  38.         $R = $R->[-1] for 0 .. $#$seen;
  39.         push @$R, [$b];
  40.     }
  41.     $tree[0];
  42. }

  43. sub F1_ {
  44.     state $S = ' ' x $TAB;
  45.     my ( $t, $l, $p ) = @_;
  46.     say $S x $l, "$p:$t->[0]" if $p;
  47.     F1_( $t->[$_], $l + 1, $t->[0] ) for 1 .. $#$t;
  48. }

  49. sub F2_ {
  50.     my ( $t, $i, $p ) = @_;
  51.     state $pos = [-1];
  52.     say ' ' x $pos->[$i], "$p:$t->[0]" if $p;
  53.     $pos->[ $i + 1 ] = 1 + $pos->[$i] + length $p;
  54.     F2_( $t->[$_], $i + 1, $t->[0] ) for 1 .. $#$t;
  55. }

  56. sub D_ {
  57.     state $his = [];
  58.     my ( $A, $B, $C ) = @_;
  59.     if ( !ref $A ) {
  60.         for ( my $i = 0 ; $i <= $#$B ; $i += 2 ) {
  61.             if ( !defined $his->[$i] || $B->[$i] ne $his->[$i] ) {
  62.                 print "|- $B->[$i] ";
  63.             }
  64.             else {
  65.                 my $tab = $B->[ $i + 1 ] ? '|' : ' ';
  66.                 print $tab . ' ' x ( 3 + length $his->[$i] );
  67.             }
  68.         }
  69.         print "\n";
  70.         $his = $B;
  71.         return;
  72.     }

  73.     D_( $A->[$_], [ @$B, $A->[0], $C ], 1 ) for 1 .. $#$A - 1;
  74.     D_( $A->[-1], [ @$B, $A->[0], $C ], 0 );    # only 1, or -1
  75. }

  76. __DATA__
  77. $_


复制代码



论坛徽章:
0
发表于 2017-05-30 10:30 |显示全部楼层
Excellence & Elegance !!!

Many thanks to Master Rubyish !
您需要登录后才可以回帖 登录 | 注册

本版积分规则

SACC2017购票7.8折优惠进行时

2017中国系统架构师大会(SACC2017)将于10月19-21日在北京新云南皇冠假日酒店震撼来袭。今年,大会以“云智未来”为主题,云集国内外顶级专家,围绕云计算、人工智能、大数据、移动互联网、产业应用等热点领域展开技术探讨与交流。本届大会共设置2大主会场,18个技术专场;邀请来自互联网、金融、制造业、电商等多个领域,100余位技术专家及行业领袖来分享他们的经验;并将吸引4000+人次的系统运维、架构师及IT决策人士参会,为他们提供最具价值的交流平台。
----------------------------------------
优惠时间:2017年8月2日前

活动链接>>
  

北京皓辰网域网络信息技术有限公司. 版权所有 京ICP证:060528号 北京市公安局海淀分局网监中心备案编号:1101082001
广播电视节目制作经营许可证(京) 字第1234号 中国互联网协会会员  联系我们:
感谢所有关心和支持过ChinaUnix的朋友们 转载本站内容请注明原作者名及出处

清除 Cookies - ChinaUnix - Archiver - WAP - TOP