Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl-Sensitive Sunglasses

Comment on

( #3333=superdoc: print w/replies, xml ) Need Help??

Here's a working script that produces pie charts. See the notes at the end (which will probably make more sense after you've read the code and run the script).

#!/usr/bin/env perl use strict; use warnings; use Tk; use List::Util 'sum'; my $pie_slice_colours = [ map { '#' . $_ } qw{ff0000 ffff00 00ff00 00ffff 0000ff ff00ff} + ]; my @pie_data = ( { centre_x => 50, centre_y => 150, radius => 40, values => [ 1, 2, 5, 3 ], fills => $pie_slice_colours, }, { centre_x => 220, centre_y => 105, radius => 100, values => [ 1, 8, 16, 4, 2 ], fills => $pie_slice_colours, }, { centre_x => 420, centre_y => 75, radius => 75, values => [ 1, 1, 2, 3, 5, 8 ], fills => $pie_slice_colours, }, { centre_x => 60, centre_y => 40, radius => 50, values => [ 32, 16, 8, 4, 2, 1 ], fills => $pie_slice_colours, }, ); my $mw = MainWindow->new; my $ctrl_F = $mw->Frame->pack(-side => 'bottom'); $ctrl_F->Button(-text => 'Quit', -command => sub { exit })->pack; my $canv_F = $mw->Frame->pack(-side => 'top', -fill => 'both', -expand + => 1); my $sc = $canv_F->Scrolled(Canvas => -scrollbars => 'osoe', -bg => '#ffffff', -width => 500, -height => 220, -scrollregion => [0, 0, 500, 220], ); $sc->pack(-fill => 'both', -expand => 1); my $canvas = $sc->Subwidget('canvas'); draw_pie(\$canvas, $_) for @pie_data; MainLoop; sub draw_pie { my ($c_ref, $data) = @_; my @coords = @{_get_pie_coords($c_ref, $data)}; $$c_ref->createArc(@coords, %$_) for @{_get_pie_slices($data)}; return; } sub _get_pie_coords { my ($c_ref, $data) = @_; my ($x, $y, $r) = @$data{qw{centre_x centre_y radius}}; my $h = $$c_ref->cget('-height'); return [$x - $r, $h - $y + $r, $x + $r, $h - $y - $r]; } sub _get_pie_slices { my $data = shift; my @values = @{$data->{values}}; my @fills = @{$data->{fills}}; my $total_values = sum @values; my $start = 90; return [ map { my $extent = 360 * $values[$_] / $total_values; $start -= $extent; +{ -extent => $extent, -start => $start, -fill => $fills[$ +_] } } 0 .. $#values ]; }


  • The Tk::Canvas coordinate system is an upside-down version of Cartesian coordinates. I personally don't like this: mainly because I find it counter-intuitive (x increases along the x-axis but y decreases along the y-axis). _get_pie_coords() takes (x,y) Cartesian coordinates for the centre of the pie chart, as well as the radius for the pie chart, and returns the coordinates required by createArc(). Feel free to revert to the Tk::Canvas coordinate system; however, you'll still need a function like this unless you're happy to specify (x1, y1, x2, y2) for every pie chart (and note those coordinates are outside the pie chart).
  • The placement of the pie slices is also somewhat counter-intuitive (at least, in my opinion). If you take the defaults, -start is called 0 (but, on a compass, it would be east, i.e. 90); and -extent (whose default value is 90) increases in an anticlockwise direction such that adding 90 to east results in north (on a compass, that would be south). Anyway, _get_pie_slices() works all that out for you: the first slice starts at 0 (north) and extends proportionally in a clockwise fashion; subsequent slices continue to be added in the same manner.
  • Unless you have a particular reason not to, you probably want (at least optional) scrollbars. Note that Scrolled(Canvas => ...) is actually a composite widget and the Tk::Canvas widget is a component of this accessed with Subwidget('canvas').
  • I've added six colours ($pie_slice_colours) and reused them for each pie chart. You may need more colours. You may not want the same colours for every chart: set the value of the fills key how you want it.
  • Everything else should either be fairly straightforward Perl or documented via links already supplied.

-- Ken

In reply to Re^3: Creating Pie chart based graph network by kcott
in thread Creating Pie chart based graph network by KuntalBhusan

Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":

  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.
  • Log In?

    What's my password?
    Create A New User
    [stevieb]: went for a long hike in the mountains today while the weather is hovering just about freezing. I think tomorrow I'm going to huddle up and do a good read through perlguts

    How do I use this? | Other CB clients
    Other Users?
    Others drinking their drinks and smoking their pipes about the Monastery: (7)
    As of 2017-01-22 02:51 GMT
    Find Nodes?
      Voting Booth?
      Do you watch meteor showers?

      Results (186 votes). Check out past polls.