[新手上路]批处理新手入门导读[视频教程]批处理基础视频教程[视频教程]VBS基础视频教程[批处理精品]批处理版照片整理器
[批处理精品]纯批处理备份&还原驱动[批处理精品]CMD命令50条不能说的秘密[在线下载]第三方命令行工具[在线帮助]VBScript / JScript 在线参考
返回列表 发帖

[原创代码] [Perl]跨境平台市场大盘数据可视化(结合Echarts.js)

不知道图片是否正常显示,等待两秒吧~


附件见末尾
  1. =info
  2.     类目各层级交易占比可视化
  3.     Author: 523066680/vicyang
  4.     2020-04
  5.    
  6.     Echarts旭日图模板: sunburst-drink_tmpl.html
  7.     颜色分配:按ID % scalar(@cmap)
  8. =cut
  9. use utf8;
  10. use Encode;
  11. use JSON qw/from_json to_json/;
  12. use Cwd;
  13. use File::Slurp;
  14. use Data::Dumper;
  15. use List::Util qw/min max sum/;
  16. use Date::Format;
  17. $Data::Dumper::Indent = 1;
  18. STDOUT->autoflush(1);
  19. my $date = "202111";
  20. my $dir = "./Data_${date}_Month";
  21. my @cmap = ("#da0d68","#975e6d","#e0719c","#f99e1c","#ef5a78","#f7f1bd","#da1d23","#dd4c51","#3e0317","#e62969","#6569b0","#ef2d36","#c94a44","#b53b54","#a5446f","#f2684b","#e73451","#e65656","#f89a1c","#aeb92c","#4eb849","#f68a5c","#baa635","#f7a128","#f26355","#e2631e","#fde404","#7eb138","#ebb40f","#e1c315","#9ea718","#94a76f","#d0b24f","#8eb646","#faef07","#c1ba07","#b09733","#8f1c53","#b34039","#ba9232","#8b6439","#187a2f","#a2b029","#718933","#3aa255","#a2bb2b","#62aa3c","#03a653","#038549","#28b44b","#a3a830","#7ac141","#5e9a80","#0aa3b5","#9db2b7","#8b8c90","#beb276","#fefef4","#744e03","#a3a36f","#c9b583","#978847","#9d977f","#cc7b6a","#db646a","#76c0cb","#80a89d","#def2fd","#7a9bae","#039fb8","#5e777b","#120c0c","#c94930","#caa465","#dfbd7e","#be8663","#b9a449","#899893","#a1743b","#894810","#ddaf61","#b7906f","#eb9d5f","#ad213e","#794752","#cc3d41","#b14d57","#c78936","#8c292c","#e5762e","#a16c5a","#a87b64","#c78869","#d4ad12","#9d5433","#c89f83","#bb764c","#692a19","#470604","#e65832","#d45a59","#310d0f","#ae341f","#d78823","#da5c1f","#f89a80","#f37674","#e75b68","#d0545f");
  22. #color filter   
  23. @cmap = grep {
  24.     $_ =~/#(.{2})(.{2})(.{2})/;
  25.     if ( hex("0x$1") > 180 and hex("0x$2") > 180 and hex("0x$3") > 180) {
  26.         0;
  27.     }
  28.     elsif ( hex("0x$1") < 30 or hex("0x$2") < 30 or hex("0x$3") < 30 ) {
  29.         0;
  30.     } else {
  31.         1;
  32.     }
  33. } @cmap;
  34. my $colors = scalar(@cmap);
  35. my $raw = read_file( gbk("Category.json") );
  36. my $data = from_json( $raw );
  37. my $ID = 44;
  38. recur_tree( $data->{$ID}{child}, $ID, 1 );
  39. # 遍历层级并获取对应节点的平台数据
  40. sub recur_tree
  41. {
  42.     my ( $node, $parentID, $lv ) = @_;
  43.     for my $id ( keys %$node )
  44.     {
  45.         printf "%s%s %s %s\n", " "x($lv*2), u2gbk($node->{$id}{label}), $id, $parentID;
  46.         $node->{$id}{'trend'} = get_deal_trend( $id );
  47.         $node->{$id}{'percent'} = get_percent( $id );
  48.         recur_tree( $node->{$id}{child}, $id, $lv+1 ) if ( exists $node->{$id}{child} and $lv < 3 );
  49.     }
  50. }
  51. my $dv = {};
  52. treedump( $dv, $data->{$ID}{child}, 100.0, 0 );
  53. # 去除外层 children 键
  54. my $jsonstr = to_json( $dv->{'children'}, {pretty=>1} );
  55. my $html = read_file("sunburst-drink_tmpl.html");
  56. $html =~s/(var data = )\[\]/$1${jsonstr}/g;
  57. write_file("Visual_". u2gbk($info->{$ID}[2]) . "_MonthPercent_${date}.html", $html);
  58. sub get_percent
  59. {
  60.     my ( $cateID ) = @_;
  61.     my $file = "$dir/${cateID}_core.json";
  62.     my $raw = read_file( $file );
  63.     my $data = from_json( $raw );
  64.     my $percent = $data->{data}{payAmtParentCatePercent}{value};
  65.     return $percent;
  66. }
  67. sub get_addcart
  68. {
  69.     my ( $cateID ) = @_;
  70.     my $file = "$dir/${cateID}_core.json";
  71.     my $raw = read_file( $file );
  72.     my $data = from_json( $raw );
  73.     my $percent = $data->{data}{itemAddCartBuyerCnt}{value};
  74.     return $percent;
  75. }
  76. sub get_deal_trend
  77. {
  78.     my ( $cateID ) = @_;
  79.     my $file = "$dir/${cateID}_trend.json";
  80.     my $raw = read_file( $file );
  81.     my $data = from_json( $raw );
  82.     my $array = $data->{data}{selfCate}{noriskPayAmtIndex};
  83.     my $min = min(@$array );
  84.     @$array = map { $_ } @$array;
  85.     return $array;
  86. }
  87. sub treedump
  88. {
  89.     my ( $ref, $node, $value, $lv ) = @_;
  90.     my @childs;
  91.     for my $id ( sort { $a <=> $b } keys %$node )
  92.     {
  93.         my $info = $node->{$id};
  94.         my ( $label, $trend, $percent ) = @{$info}{'label', 'trend', 'percent'};
  95.         # 小于一定比例不显示
  96.         next if $percent * $value < 0.1;
  97.         #next if ( $lv > 1 and $percent * $value < 0.5 );
  98.         printf "%s%d %s %s\n", "    "x$lv, $id, u2gbk( $label ), $percent;
  99.         my $tref = {
  100.                     'name' => $label . " " . sprintf("%.1f\%", $percent * $value),
  101.                     'itemStyle' => { 'color' => $cmap[ ($id) % $colors ] }
  102.                 };
  103.         if ($lv >= 0)
  104.         {
  105.             $tref->{'value'} = $percent * $value;
  106.         }
  107.         treedump( $tref, $node->{$id}{child}, $percent * $value, $lv+1 );
  108.         push @childs, $tref;
  109.     }
  110.     $ref->{children} = \@childs;
  111. }
  112. sub delta
  113. {
  114.     my ($a, $b) = @_;
  115.     return abs( $a - $b );
  116. }
  117. sub gbk { encode('gbk', $_[0]) }
  118. sub uni { decode('utf8', $_[0]) }
  119. sub utf8 { encode('utf8', $_[0]) }
  120. sub u2gbk { encode('gbk', decode('utf8', $_[0])) }
复制代码
3C_Market_DataVisualization.7z
1

评分人数

    • sxw: Perl++技术 + 1

返回列表