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

附件见末尾 | | | | | | | | | | | | | | | | | | | use utf8; | | use Encode; | | use JSON qw/from_json to_json/; | | use Cwd; | | use File::Slurp; | | use Data::Dumper; | | use List::Util qw/min max sum/; | | use Date::Format; | | $Data::Dumper::Indent = 1; | | STDOUT->autoflush(1); | | | | my $date = "202111"; | | my $dir = "./Data_${date}_Month"; | | 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"); | | | | @cmap = grep { | | $_ =~/#(.{2})(.{2})(.{2})/; | | if ( hex("0x$1") > 180 and hex("0x$2") > 180 and hex("0x$3") > 180) { | | 0; | | } | | elsif ( hex("0x$1") < 30 or hex("0x$2") < 30 or hex("0x$3") < 30 ) { | | 0; | | } else { | | 1; | | } | | } @cmap; | | my $colors = scalar(@cmap); | | | | my $raw = read_file( gbk("Category.json") ); | | my $data = from_json( $raw ); | | | | my $ID = 44; | | recur_tree( $data->{$ID}{child}, $ID, 1 ); | | | | | | sub recur_tree | | { | | my ( $node, $parentID, $lv ) = @_; | | for my $id ( keys %$node ) | | { | | printf "%s%s %s %s\n", " "x($lv*2), u2gbk($node->{$id}{label}), $id, $parentID; | | $node->{$id}{'trend'} = get_deal_trend( $id ); | | $node->{$id}{'percent'} = get_percent( $id ); | | recur_tree( $node->{$id}{child}, $id, $lv+1 ) if ( exists $node->{$id}{child} and $lv < 3 ); | | } | | } | | | | my $dv = {}; | | treedump( $dv, $data->{$ID}{child}, 100.0, 0 ); | | | | | | my $jsonstr = to_json( $dv->{'children'}, {pretty=>1} ); | | my $html = read_file("sunburst-drink_tmpl.html"); | | $html =~s/(var data = )\[\]/$1${jsonstr}/g; | | write_file("Visual_". u2gbk($info->{$ID}[2]) . "_MonthPercent_${date}.html", $html); | | | | sub get_percent | | { | | my ( $cateID ) = @_; | | my $file = "$dir/${cateID}_core.json"; | | my $raw = read_file( $file ); | | my $data = from_json( $raw ); | | my $percent = $data->{data}{payAmtParentCatePercent}{value}; | | return $percent; | | } | | | | sub get_addcart | | { | | my ( $cateID ) = @_; | | my $file = "$dir/${cateID}_core.json"; | | my $raw = read_file( $file ); | | my $data = from_json( $raw ); | | my $percent = $data->{data}{itemAddCartBuyerCnt}{value}; | | return $percent; | | } | | | | sub get_deal_trend | | { | | my ( $cateID ) = @_; | | my $file = "$dir/${cateID}_trend.json"; | | my $raw = read_file( $file ); | | my $data = from_json( $raw ); | | my $array = $data->{data}{selfCate}{noriskPayAmtIndex}; | | my $min = min(@$array ); | | @$array = map { $_ } @$array; | | return $array; | | } | | | | sub treedump | | { | | my ( $ref, $node, $value, $lv ) = @_; | | my @childs; | | for my $id ( sort { $a <=> $b } keys %$node ) | | { | | my $info = $node->{$id}; | | my ( $label, $trend, $percent ) = @{$info}{'label', 'trend', 'percent'}; | | | | | | next if $percent * $value < 0.1; | | | | | | printf "%s%d %s %s\n", " "x$lv, $id, u2gbk( $label ), $percent; | | | | my $tref = { | | 'name' => $label . " " . sprintf("%.1f\%", $percent * $value), | | 'itemStyle' => { 'color' => $cmap[ ($id) % $colors ] } | | }; | | | | if ($lv >= 0) | | { | | $tref->{'value'} = $percent * $value; | | } | | | | treedump( $tref, $node->{$id}{child}, $percent * $value, $lv+1 ); | | push @childs, $tref; | | } | | $ref->{children} = \@childs; | | } | | | | sub delta | | { | | my ($a, $b) = @_; | | return abs( $a - $b ); | | } | | | | sub gbk { encode('gbk', $_[0]) } | | sub uni { decode('utf8', $_[0]) } | | sub utf8 { encode('utf8', $_[0]) } | | sub u2gbk { encode('gbk', decode('utf8', $_[0])) }COPY |
3C_Market_DataVisualization.7z |