NAME

SOOT::Examples::Hist - SOOT Examples for Hist

DESCRIPTION

This is a listing of all SOOT examples for Hist.

EXAMPLES

ContourList.pl

  use strict;
  use warnings;
  use SOOT ':all';
  
  # Getting Contours From TH2D
  # Author: Josh de Bever
  #         CSI Medical Physics Group
  #         The University of Western Ontario
  #         London, Ontario, Canada
  #   Date: Oct. 22, 2004
  #   Modified by O.Couet (Nov. 26, 2004)
  #   Converted to Perl by S. Mueller (Jul 22, 2011)
  
  ContourList();
  $gApplication->Run();
  
  sub SawTooth {
    # This function is specific to a sawtooth function with period
    # WaveLen, symmetric about x = 0, and with amplitude = 1. Each segment
    # is 1/4 of the wavelength.
    #
    #           |
    #      /\   |
    #     /  \  |
    #    /    \ |
    #   /      \
    #  /--------\--------/------------
    #           |\      /
    #           | \    /
    #           |  \  /
    #           |   \/
    #
    my ($x, $WaveLen) = @_;
    my $wl2 = 0.5*$WaveLen;
    my $wl4 = 0.25*$WaveLen;
    return -99999999 if $x < -$wl2 or $x > $wl2; # Error X out of bounds
    if ($x <= -$wl4) {
      return $x + 2.;
    } elsif ($x > -$wl4 and $x <= $wl4) {
      return -$x;
    } elsif ($x > $wl4 and $x <= $wl2) {
      return $x - 2.;
    }
    die "Should not be reached";
  }
  
  use constant PI => TMath::Pi();
  sub ContourList {
    my $c = TCanvas->new("c","Contour List",0,0,600,600)->keep;
    $c->SetRightMargin(0.15);
    $c->SetTopMargin(0.15);
  
    my ($i, $j);
  
    my $nZsamples   = 80;
    my $nPhiSamples = 80;
  
    my $HofZwavelength = 4.0;       # 4 meters
    my $dZ             =  $HofZwavelength/($nZsamples - 1.);
    my $dPhi           = 2*PI()/($nPhiSamples - 1.);
  
    my (@z, @HofZ, @phi, @FofPhi);
  
    # Discretized Z and Phi Values
    foreach my $i (0 .. $nZsamples) {
      $z[$i]    = $i*$dZ - $HofZwavelength/2.;
      $HofZ[$i] = SawTooth($z[$i], $HofZwavelength)
    }
  
    foreach my $i (0.. $nPhiSamples) {
      $phi[$i]    = $i*$dPhi;
      $FofPhi[$i] = sin($phi[$i]);
    }
     
    # Create Histogram
    my $HistStreamFn = TH2D->new(
      "HstreamFn",
      "#splitline{Histogram with negative and positive contents. Six contours are defined.}{It is plotted with options CONT LIST to retrieve the contours points in TGraphs}",
      $nZsamples, $z[0], $z[$#z],
      $nPhiSamples, $phi[0], $phi[$#phi]
    )->keep;
  
    # Load Histogram Data
    foreach my $i (0 .. $nZsamples) {
      foreach my $j (0 .. $nPhiSamples) {
        $HistStreamFn->SetBinContent($i, $j, $HofZ[$i] * $FofPhi[$j]);
      }
    }
  
    $gStyle->SetPalette(1);
    $gStyle->SetOptStat(0);
    $gStyle->SetTitleW(0.99);
    $gStyle->SetTitleH(0.08);
  
    my @contours = (-.7, -.5, -.1, .1, .4, .8);
    $HistStreamFn->SetContour(6, \@contours);
    # Draw contours as filled regions, and Save points
    $HistStreamFn->Draw("CONT Z LIST");
    $c->Update(); # Needed to force the plotting and retrieve the contours in TGraphs
  
    # Get Contours
    #my $sp = $gROOT->GetListOfSpecials();
    my $conts = $gROOT->FindObject("contours");
  
    my $nGraphs    = 0;
    my $TotalConts = 0;
    
    if (not defined($conts)) {
      printf("*** No Contours Were Extracted!\n");
      return;
    } else {
      $TotalConts = $conts->GetSize();
    }
  
    printf("TotalConts = %d\n", $TotalConts);
  
    foreach my $i (0 .. $TotalConts-1) {
      my $contLevel =$conts->At($i);
      printf("Contour %d has %d Graphs\n", $i, $contLevel->GetSize());
      $nGraphs += $contLevel->GetSize();
    }
  
    $nGraphs = 0;
  
    my $c1 = TCanvas->new("c1","Contour List",610,0,600,600)->keep;
    $c1->SetTopMargin(0.15);
    my $hr = TH2F->new("hr",
      "#splitline{Negative contours are returned first (highest to lowest). Positive contours are returned from}{lowest to highest. On this plot Negative contours are drawn in red and positive contours in blue.}",
      2, -2., 2., 2, 0., 6.5
    );
  
    $hr->Draw();
    my $l = TLatex->new;
    $l->SetTextSize(0.03);
  
    foreach my $i (0 .. $TotalConts-1) {
      my $contLevel = $conts->At($i);
      my $z0;
      if ($i<3) { $z0 = $contours[2-$i]; }
      else      { $z0 = $contours[$i]; }
      printf("Z-Level Passed in as:  Z = %f\n", $z0);
  
      # Get first graph from list on curves on this level
      my $curv = $contLevel->First();
      foreach my $j (0 .. $contLevel->GetSize()-1) {
        my $x0 = $curv->GetX()->[0];
        my $y0 = $curv->GetY()->[0];
        if ($z0<0) { $curv->SetLineColor(kRed); }
        if ($z0>0) { $curv->SetLineColor(kBlue); }
        $nGraphs++;
        printf("\tGraph: %d  -- %d Elements\n", $nGraphs, $curv->GetN());
  
        # Draw clones of the graphs to avoid deletions in case the 1st
        # pad is redrawn.
        my $gc = $curv->Clone()->keep;
        $gc->Draw("C");
  
        my $val = sprintf("%g",$z0);
           $l->DrawLatex($x0,$y0,$val);
           $curv = $contLevel->After($curv); # Get Next graph
        }
     }
     $c1->Update();
     printf("\n\n\tExtracted %d Contours and %d Graphs \n", $TotalConts, $nGraphs );
     $gStyle->SetTitleW(0.);
     $gStyle->SetTitleH(0.);
  }

DynamicSlice.pl

  #!/usr/bin/env perl
  use strict;
  use warnings;
  use SOOT qw/:all/;
  SOOT::Init(0);
  SOOT::Load('TGX11TTF');
  
  DynamicSlice();
  $gApplication->Run();
  
  sub DynamicExec {
    # Example of function called when a mouse event occurs in a pad.
    # When moving the mouse in the canvas, a second canvas shows the
    # projection along X of the bin corresponding to the Y position
    # of the mouse. The resulting histogram is fitted with a gaussian.
    # A "dynamic" line shows the current bin position in Y.
    # This more elaborated example can be used as a starting point
    # to develop more powerful interactive applications exploiting CINT
    # as a development engine.
    #
    # Author:  Rene Brun
     
    my $select = $gPad->GetSelected();
    return if !defined $select;
    $gPad->SetUniqueID(0), return if !$select->InheritsFrom(TH2::Class());
    my $h = $select->as('TH2');
    $gPad->GetCanvas()->FeedbackMode(kTRUE);
  
    # erase old position and draw a line at current position
    my $pyold = $gPad->GetUniqueID();
    my $px = $gPad->GetEventX();
    my $py = $gPad->GetEventY();
    my $uxmin = $gPad->GetUxmin();
    my $uxmax = $gPad->GetUxmax();
    my $pxmin = $gPad->XtoAbsPixel($uxmin);
    my $pxmax = $gPad->XtoAbsPixel($uxmax);
    if ($pyold) {
      $gVirtualX->DrawLine($pxmin, $pyold, $pxmax, $pyold);
    }
    $gVirtualX->DrawLine($pxmin, $py, $pxmax, $py);
    $gPad->SetUniqueID($py);
    my $upy = $gPad->AbsPixeltoY($py);
    my $y = $gPad->PadtoY($upy);
  
    # create or set the new canvas c2
    my $padsav = $gPad;
    my $c2 = $gROOT->FindObject("c2");
    if (defined $c2) {
      #$c2->GetPrimitive("Projection")->delete;
    }
    else {
      $c2 = TCanvas->new("c2","Projection Canvas",710,10,700,500);
    }
    $c2->SetGrid();
    $c2->cd();
  
    # draw slice corresponding to mouse position
    my $biny = $h->GetYaxis()->FindBin($y);
    my $hp = $h->ProjectionX("", $biny, $biny);
    $hp->SetFillColor(38);
    my $title = sprintf("Projection of biny=%d", $biny);
    $hp->SetName("Projection");
    $hp->SetTitle($title);
    $hp->Fit("gaus", "ql");
    $hp->GetFunction("gaus")->SetLineColor(kRed);
    $hp->GetFunction("gaus")->SetLineWidth(6);
    $c2->Update();
    $padsav->cd();
  }
  
  # Show the slice of a TH2 following the mouse position
  sub DynamicSlice {
    # Create a new canvas.
    my $c1 = TCanvas->new("c1","Dynamic Slice Example",10,10,700,500)->keep;
    $c1->SetFillColor(42);
    $c1->SetFrameFillColor(33);
    
    # create a 2-d histogram, fill and draw it
    my $hpxpy = TH2F->new("hpxpy","py vs px",40,-4,4,40,-4,4)->keep;
    $hpxpy->SetStats(0);
    foreach (1..50000) {
      my ($px, $py) = $gRandom->Rannor();
      $hpxpy->Fill($px, $py);
    }
    $hpxpy->Draw("col");
     
    # Add a TExec object to the canvas
    $c1->AddExec("dynamic", sub {DynamicExec()});
  }

draw2dopt.pl

  use strict;
  use warnings;
  use SOOT ':all';
  
  # display the various 2-d drawing options
  $gROOT->Reset();
  $gStyle->SetOptStat(0);
  $gStyle->SetPalette(1);
  $gStyle->SetCanvasColor(33);
  $gStyle->SetFrameFillColor(18);
  
  my $pl = TPaveLabel->new();
  
  my $f2 = TF2->new("f2","xygaus + xygaus(5) + xylandau(10)",-4,4,-4,4);
  my @params = (130,-1.4,1.8,1.5,1, 150,2,0.5,-2,0.5, 3600,-2,0.7,-3,0.3);
  for (my $i = 0; $i < scalar @params; $i++) {
   $f2->SetParameter($i, $params[$i]);
  }
  my $h2 = TH2F->new("h2","xygaus + xygaus(5) + xylandau(10)",20,-4,4,20,-4,4);
  $h2->SetFillColor(46);
  $h2->FillRandom("f2",40000);
  
  # basic 2-d options
  my $x1 = 0.67; 
  my $y1 = 0.875; 
  my $x2 = 0.85; 
  my $y2 = 0.95;
  my $cancolor = 17;
  
  my $c2h = TCanvas->new("c2h","2-d options",10,10,800,600);
  $c2h->Divide(2,2);
  $c2h->SetFillColor($cancolor);
  $c2h->cd(1);
  $h2->Draw();       
  $pl->DrawPaveLabel($x1,$y1,$x2,$y2,"SCAT","brNDC");
  $c2h->cd(2);
  $h2->Draw("box");  
  $pl->DrawPaveLabel($x1,$y1,$x2,$y2,"BOX","brNDC");
  $c2h->cd(3);
  $h2->Draw("arr");  
  $pl->DrawPaveLabel($x1,$y1,$x2,$y2,"ARR","brNDC");
  $c2h->cd(4);
  $h2->Draw("colz"); 
  $pl->DrawPaveLabel($x1,$y1,$x2,$y2,"COLZ","brNDC");
  $c2h->Update();
  
  # text option
  my $ctext = TCanvas->new("ctext","text option",50,50,800,600);
  $gPad->SetGrid();
  $ctext->SetFillColor($cancolor);
  $ctext->SetGrid();
  $h2->Draw("text"); 
  $pl->DrawPaveLabel($x1,$y1,$x2,$y2,"TEXT","brNDC");
  $ctext->Update();
  
  # contour options
  my $cont = TCanvas->new("contours","contours",100,100,800,600);
  $cont->Divide(2,2);
  $gPad->SetGrid();
  $cont->SetFillColor($cancolor);
  $cont->cd(1);
  $h2->Draw("contz"); 
  $pl->DrawPaveLabel($x1,$y1,$x2,$y2,"CONTZ","brNDC");
  $cont->cd(2);
  $gPad->SetGrid();
  $h2->Draw("cont1"); 
  $pl->DrawPaveLabel($x1,$y1,$x2,$y2,"CONT1","brNDC");
  $cont->cd(3);
  $gPad->SetGrid();
  $h2->Draw("cont2"); 
  $pl->DrawPaveLabel($x1,$y1,$x2,$y2,"CONT2","brNDC");
  $cont->cd(4);
  $gPad->SetGrid();
  $h2->Draw("cont3"); 
  $pl->DrawPaveLabel($x1,$y1,$x2,$y2,"CONT3","brNDC");
  $cont->Update();
  
  #lego options
  my $lego = TCanvas->new("lego","lego options",150,150,800,600);
  $lego->Divide(2,2);
  $lego->SetFillColor($cancolor);
  $lego->cd(1);
  $h2->Draw("lego");     
  $pl->DrawPaveLabel($x1,$y1,$x2,$y2,"LEGO","brNDC");
  $lego->cd(2);
  $h2->Draw("lego1");    
  $pl->DrawPaveLabel($x1,$y1,$x2,$y2,"LEGO1","brNDC");
  $lego->cd(3);
  $gPad->SetTheta(61); 
  $gPad->SetPhi(-82);
  $h2->Draw("surf1pol"); 
  $pl->DrawPaveLabel($x1,$y1,$x2+0.05,$y2,"SURF1POL","brNDC");
  $lego->cd(4);
  $gPad->SetTheta(21); 
  $gPad->SetPhi(-90);
  $h2->Draw("surf1cyl"); 
  $pl->DrawPaveLabel($x1,$y1,$x2+0.05,$y2,"SURF1CYL","brNDC");
  $lego->Update();
  
  # surface options
  my $surf = TCanvas->new("surfaces","surface options",200,200,800,600);
  $surf->Divide(2,2);
  $surf->SetFillColor($cancolor);
  $surf->cd(1);
  $h2->Draw("surf1");   
  $pl->DrawPaveLabel($x1,$y1,$x2,$y2,"SURF1","brNDC");
  $surf->cd(2);
  $h2->Draw("surf2z");  
  $pl->DrawPaveLabel($x1,$y1,$x2,$y2,"SURF2Z","brNDC");
  $surf->cd(3);
  $h2->Draw("surf3");   
  $pl->DrawPaveLabel($x1,$y1,$x2,$y2,"SURF3","brNDC");
  $surf->cd(4);
  $h2->Draw("surf4");   
  $pl->DrawPaveLabel($x1,$y1,$x2,$y2,"SURF4","brNDC");
  $surf->Update();
  
  $gApplication->Run;

earth.pl

  use strict;
  use warnings;
  use SOOT ':all';
  use File::Spec;
  
  $gROOT->Reset;
  $gStyle->SetPalette(1);
  $gStyle->SetOptTitle(1);
  $gStyle->SetOptStat(0);
  
  my $c1 = TCanvas->new("c1","earth_projections",1000,800);
  $c1->Divide(2,2);
  
  my $h1 = TH2F->new("h1","Aitoff",    180, -180, 180, 179, -89.5, 89.5);
  my $h2 = TH2F->new("h2","Mercator",  180, -180, 180, 161, -80.5, 80.5);
  my $h3 = TH2F->new("h3","Sinusoidal",180, -180, 180, 181, -90.5, 90.5);
  my $h4 = TH2F->new("h4","Parabolic", 180, -180, 180, 181, -90.5, 90.5);
  
  my $inFile = File::Spec->catfile($ENV{ROOTSYS}, qw(share doc root tutorials graphics earth.dat));
  open my $fh, "<", $inFile or die "Cannot open $inFile: $!";
  while (<$fh>) {
    chomp;
    my ($x, $y) = split /\s+/, $_;
    $x *= 1.;
    $y *= 1.;
    $h1->Fill($x, $y, 1);
    $h2->Fill($x, $y, 1);
    $h3->Fill($x, $y, 1);
    $h4->Fill($x, $y, 1);
  }
  close $fh;
  
  $c1->cd(1);
  $h1->Draw("z aitoff");
  
  $c1->cd(2);
  $h2->Draw("z mercator");
  
  $c1->cd(3);
  $h3->Draw("z sinusoidal");
  
  $c1->cd(4);
  $h4->Draw("z parabolic");
  
  $c1->Update();
  
  $gApplication->Run;

fillrandom.pl

  #!/usr/bin/env perl
  use strict;
  use warnings;
  use SOOT qw/:all/;
  
  fillrandom();
  $gApplication->Run();
  
  sub fillrandom {
    #Fill a 1-D histogram from a parametric function
    # To see the output of this macro, click begin_html <a href="gif/fillrandom.gif">here</a>. end_html
    #Author: Rene Brun
     
    my $c1 = TCanvas->new("c1","The FillRandom example",200,10,700,900)->keep;
    $c1->SetFillColor(18);
  
    my $pad1 = TPad->new("pad1","The pad with the function",0.05,0.50,0.95,0.95,21.)->keep;
    my $pad2 = TPad->new("pad2","The pad with the histogram",0.05,0.05,0.95,0.45,21.)->keep;
    $pad1->Draw();
    $pad2->Draw();
    $pad1->cd();
  
    $gBenchmark->Start("fillrandom");
    #
    # A function (any dimension) or a formula may reference
    # an already defined formula
    #
    my $form1 = TFormula->new("form1","abs(sin(x)/x)")->keep;
    my $sqroot = TF1->new("sqroot","x*gaus(0) + [3]*form1",0,10)->keep;
    $sqroot->SetParameters(10,4,1,20);
    $pad1->SetGridx();
    $pad1->SetGridy();
    $pad1->GetFrame()->SetFillColor(42);
    $pad1->GetFrame()->SetBorderMode(-1);
    $pad1->GetFrame()->SetBorderSize(5);
    $sqroot->SetLineColor(4);
    $sqroot->SetLineWidth(6);
    $sqroot->Draw();
    my $lfunction = TPaveLabel->new(5,39,9.8,46,"The sqroot function")->keep;
    $lfunction->SetFillColor(41);
    $lfunction->Draw();
    $c1->Update();
  
    #
    # Create a one dimensional histogram (one float per bin)
    # and fill it following the distribution in function sqroot.
    #
    $pad2->cd();
    $pad2->GetFrame()->SetFillColor(42);
    $pad2->GetFrame()->SetBorderMode(-1);
    $pad2->GetFrame()->SetBorderSize(5);
    my $h1f = TH1F->new("h1f","Test random numbers",200,0,10)->keep;
    $h1f->SetFillColor(45);
    $h1f->FillRandom("sqroot",10000);
    $h1f->Draw();
    $c1->Update();
    #
    # Open a ROOT file and save the formula, function and histogram
    #
    my $myfile = TFile->new("fillrandom.root","RECREATE");
    $form1->Write();
    $sqroot->Write();
    $h1f->Write();
    $gBenchmark->Show("fillrandom");
  }

hksimple.pl

  use strict;
  use warnings;
  use SOOT ':all';
  use constant kUPDATE => 10;
  
  # *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
  # *-*
  # *-*  This script illustrates the advantages of a TH1K histogram
  # *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
  
  # Create a new canvas.
  my $c1 = TCanvas->new("c1","Dynamic Filling Example",200,10,600,900);
  $c1->SetFillColor(42);
  
  # Create a normal histogram and two TH1K histograms
  my @hpx;
  $hpx[0] = TH1F->new("hp0","Normal histogram",1000,-4,4);
  $hpx[1] = TH1K->new("hk1","Nearest Neighboor of order 3",1000,-4,4);
  $hpx[2] = TH1K->new("hk2","Nearest Neighboor of order 16",1000,-4,4,16);
  $c1->Divide(1,3);
  for my $j (0..2) {
     $c1->cd($j+1); 
     $gPad->SetFrameFillColor(33);
     $hpx[$j]->SetFillColor(48);
     $hpx[$j]->Draw();
  }
  
  # Fill histograms randomly
  $gRandom->SetSeed();
  foreach (0..299) {
    my $px = $gRandom->Gaus(0.0,1.0);
    $hpx[$_]->Fill($px) for 0..2;
    padRefresh($c1) if $_ and $_ % kUPDATE == 0;
  }
  
  $hpx[$_]->Fit("gaus","","") for 0..2;
  
  padRefresh($c1);
  
  sub padRefresh {
    my $pad = shift;
    my $flag = shift || 0;
  
    return if not defined $pad;
    $pad->Modified();
    $pad->Update();
    my $tl = $pad->GetListOfPrimitives();
    return if not defined $tl;
    for (my $i = 0; $i < $tl->GetSize(); $i++) {
      my $obj = $tl->At($i);
      padRefresh($obj, 1) if $obj->isa("TPad");
    }
    return if ($flag);
    $gSystem->ProcessEvents();
  }
  
  
  $gApplication->Run;

hstack.pl

  use strict;
  use warnings;
  use SOOT ':all';
  
  $gROOT->Reset();
  $gBenchmark->Start('hstack');
     
  my $hs = THStack->new("hs","test stacked histograms");
  
  # create three 1-d histograms
  my $h1 = TH1F->new("h1","test hstack",100,-4,4);
  $h1->FillRandom("gaus",20000);
  $h1->SetFillColor(kRed);
  $h1->SetMarkerStyle(21);
  $h1->SetMarkerColor(kRed);
  $hs->Add($h1);
  
  my $h2 = TH1F->new("h2","test hstack",100,-4,4);
  $h2->FillRandom("gaus",15000);
  $h2->SetFillColor(kBlue);
  $h2->SetMarkerStyle(21);
  $h2->SetMarkerColor(kBlue);
  $hs->Add($h2);
  
  my $h3 = TH1F->new("h3","test hstack",100,-4,4);
  $h3->FillRandom("gaus",10000);
  $h3->SetFillColor(kGreen);
  $h3->SetMarkerStyle(21);
  $h3->SetMarkerColor(kGreen);
  $hs->Add($h3);
  
  my $c1 = TCanvas->new("c1","stacked hists",10,10,1000,800);
  $c1->SetFillColor(41);
  $c1->Divide(2,2);
  
  # in top left pad, draw the stack with defaults
  $c1->cd(1);
  $hs->Draw();
  
  # in top right pad, draw the stack in non-stack mode and errors option
  $c1->cd(2);
  $gPad->SetGrid();
  $hs->Draw("nostack,e1p");
  
  # in bottom left, draw in stack mode with "lego1" option
  $c1->cd(3);
  $gPad->SetFrameFillColor(17);
  $gPad->SetTheta(3.77);
  $gPad->SetPhi(2.9);
  $hs->Draw("lego1");
  
  $c1->cd(4);
  
  #create two 2-D histograms and draw them in stack mode
  $gPad->SetFrameFillColor(17);
  
  my $a = THStack->new("a","test legos");
  my $f1 = TF2->new("f1","xygaus + xygaus(5) + xylandau(10)",-4,4,-4,4);
  $f1->SetParameters([130.,-1.4,1.8,1.5,1, 150,2,0.5,-2,0.5, 3600,-2,0.7,-3,0.3]);
  
  my $h2a = TH2F->new("h2a","h2a",20,-4,4,20,-4,4);
  $h2a->SetFillColor(38);
  $h2a->FillRandom("f1",4000);
  
  my $f2 = TF2->new("f2","xygaus + xygaus(5)",-4,4,-4,4);
  $f2->SetParameters([100.,-1.4,1.9,1.1,2, 80,2,0.7,-2,0.5]);
  
  my $h2b = TH2F->new("h2b","h2b",20,-4,4,20,-4,4);
  $h2b->SetFillColor(46);
  $h2b->FillRandom("f2",3000);
  
  $a->Add($h2a);
  $a->Add($h2b);
  $a->Draw();
  
  $gBenchmark->Show('hstack');
  
  $gApplication->Run;

hsum.pl

  #!/usr/bin/env perl
  use strict;
  use warnings;
  use SOOT qw/:all/;
  
  hsum();
  $gApplication->Run();
  
  # histograms filled and drawn in a loop
  use constant kUPDATE => 500;
  sub hsum {
  #
  # To see the output of this macro, click begin_html <a href="gif/hsum.gif" >here</a> end_html
  #    Simple example illustrating how to use the C++ interpreter       
  #    to fill histograms in a loop and show the graphics results
  #Author: Rene Brun
  
    my $c1 = TCanvas->new("c1","The HSUM example",200,10,600,400)->keep;
    $c1->SetGrid();
  
    $gBenchmark->Start("hsum");
  
    # Create some histograms.
    my $total  = TH1F->new("total","This is the total distribution",100,-4,4)->keep;
    my $main   = TH1F->new("main","Main contributor",100,-4,4)->keep;
    my $s1     = TH1F->new("s1","This is the first signal",100,-4,4)->keep;
    my $s2     = TH1F->new("s2","This is the second signal",100,-4,4)->keep;
    $total->Sumw2(); # store the sum of squares of weights
    $total->SetMarkerStyle(21);
    $total->SetMarkerSize(0.7);
    $main->SetFillColor(16);
    $s1->SetFillColor(42);
    $s2->SetFillColor(46);
    my $slider;
  
    # Fill histograms randomly
    $gRandom->SetSeed();
    my ($xs1, $xs2, $xmain);
    foreach my $i (0..9999) {
       $xmain = $gRandom->Gaus(-1,1.5);
       $xs1   = $gRandom->Gaus(-0.5,0.5);
       $xs2   = $gRandom->Landau(1,0.15);
       $main->Fill($xmain);
       $s1->Fill($xs1, 0.3);
       $s2->Fill($xs2, 0.2);
       $total->Fill($xmain);
       $total->Fill($xs1,0.3);
       $total->Fill($xs2,0.2);
       if ($i && ($i % kUPDATE()) == 0) {
          if ($i == kUPDATE) {
             $total->Draw("e1p");
             $main->Draw("same");
             $s1->Draw("same");
             $s2->Draw("same");
             $c1->Update();
             $slider = TSlider->new("slider",
                "test",4.2,0,4.6,$total->GetMaximum(),38);
             $slider->SetFillColor(46);
          }
          $slider->SetRange(0., $i/10000.) if $slider;
          $c1->Modified();
          $c1->Update();
       }
    }
    $slider->SetRange(0, 1);
    $total->Draw("sameaxis");# to redraw axis hidden by the fill area
    $c1->Modified();
    $gBenchmark->Show("hsum");
  }

multicolor.pl

  use strict;
  use warnings;
  use SOOT ':all';
  use constant NBINS => 20;
  
  my $stack = shift;
  my $c1 = TCanvas->new;
  
  my $hs = THStack->new("hs","three plots")->keep;
  my @colors = (kBlue, kRed, kYellow);
  my @names  = qw(h1 h2 h3);
  my @h = map {
    my $h = TH2F->new(($names[$_]) x 2, NBINS,-4,4, NBINS,-4,4);
    $h->keep;
    $h->SetFillColor($colors[$_]);
    $hs->Add($h);
    $h
  } 0..$#names;
  
  my $r = TRandom->new;
  
  $h[0]->Fill($r->Gaus(), $r->Gaus()) for 1..20000; 
  
  foreach (1..200) {
    my $ix = int($r->Uniform(0, NBINS));
    my $iy = int($r->Uniform(0, NBINS));
    my $bin = $h[0]->GetBin($ix, $iy);
    my $val = $h[0]->GetBinContent($bin);
    next if $val <= 0;
    $h[0]->SetBinContent($bin,0) if not $stack;
    if ($r->Rndm() > 0.5) {
      $h[1]->SetBinContent($bin, 0) if not $stack;
      $h[2]->SetBinContent($bin, $val);
    } 
    else {
      $h[2]->SetBinContent($bin, 0) if not $stack;
      $h[1]->SetBinContent($bin, $val);
    }
  }
  $hs->Draw("lego1");
  
  $gApplication->Run;

quantiles.pl

  use strict;
  use warnings;
  use SOOT ':all';
  
  use constant NQ => 100;
  use constant NSHOTS => 10;
  
  # demo for quantiles
  # Author; Rene Brun
  my $xq = [map {$_/NQ} 1..NQ]; # position where to compute the quantiles in [0,1]
  my $yq = [(0.) x NQ]; # array to contain the quantiles
  
  my $gr70 = TGraph->new(NSHOTS);
  my $gr90 = TGraph->new(NSHOTS);
  my $gr98 = TGraph->new(NSHOTS);
  my $h = TH1F->new("h", "demo quantiles", 50, -3, 3);
  
  for my $shot (0..NSHOTS-1) {
    $h->FillRandom("gaus", 50);
    $h->GetQuantiles(NQ, $yq, $xq);
    $gr70->SetPoint($shot, $shot+1, $yq->[70]*1.0);
    $gr90->SetPoint($shot, $shot+1, $yq->[90]*1.0);
    $gr98->SetPoint($shot, $shot+1, $yq->[98]*1.0);
  }
  
  # show the original histogram in the top pad
  my $c1 = TCanvas->new("c1", "demo quantiles", 10, 10, 600, 900);
  $c1->SetFillColor(41);
  $c1->Divide(1, 3);
  $c1->cd(1);
  $h->SetFillColor(38);
  $h->Draw();
  
  # show the final quantiles in the middle pad
  $c1->cd(2);
  $gPad->SetFrameFillColor(33);
  $gPad->SetGrid();
  my $gr = TGraph->new(NQ, $xq, $yq);
  $gr->SetTitle("final quantiles");
  $gr->SetMarkerStyle(21);
  $gr->SetMarkerColor(kRed);
  $gr->SetMarkerSize(0.3);
  $gr->Draw("ap");
  
  # show the evolution of some  quantiles in the bottom pad
  $c1->cd(3);
  $gPad->SetFrameFillColor(17);
  $gPad->DrawFrame(0, 0, NSHOTS+1, 3.2);
  $gPad->SetGrid();
  $gr98->SetMarkerStyle(22);
  $gr98->SetMarkerColor(kRed);
  $gr98->Draw("lp");
  $gr90->SetMarkerStyle(21);
  $gr90->SetMarkerColor(kBlue);
  $gr90->Draw("lp");
  $gr70->SetMarkerStyle(20);
  $gr70->SetMarkerColor(kMagenta);
  $gr70->Draw("lp");
  
  # add a legend
  my $legend = TLegend->new(0.85, 0.74, 0.95, 0.95);
  $legend->SetTextFont(72);
  $legend->SetTextSize(0.05);
  $legend->AddEntry($gr98," q98","lp");
  $legend->AddEntry($gr90," q90","lp");
  $legend->AddEntry($gr70," q70","lp");
  $legend->Draw();
  
  $gApplication->Run;

seism.pl

  use strict;
  use warnings;
  use SOOT ':all';
  use threads;
  use Time::HiRes 'usleep';
  
  my $sw = TStopwatch->new(); 
  $sw->Start();
  
  # set time offset
  #my $dtime = TDatime->new(); # FIXME TDatime not wrapped (not a TObject), but utterly superseded by Perl-tools
  $gStyle->SetTimeOffset(time()); # We could be more elaborate. Check out DateTime.pm
  
  my $c1 = TCanvas->new("c1","Time on axis",10,10,1000,500);
  $c1->SetFillColor(42);
  $c1->SetFrameFillColor(33);
  $c1->SetGrid();
     
  my $bintime = 1; # one bin = 1 second. change it to set the time scale
  my $ht = TH1F->new("ht","The ROOT seism",10,0,10*$bintime);
  my $signal = 1000.0;
  
  $ht->SetMaximum($signal);
  $ht->SetMinimum(-$signal);
  $ht->SetStats(0);
  $ht->SetLineColor(2);
  $ht->GetXaxis()->SetTimeDisplay(1);
  $ht->GetYaxis()->SetNdivisions(520);
  $ht->Draw();
     
  my $thr = threads->new(sub {$gApplication->Run()}); #canvas can be edited during the loop
  usleep(5000); # FIXME find better way to fix this
  $gApplication->SetReturnFromRun(1);
  
  for my $i (1..2299) {
    #======= Build a signal : noisy damped sine ======
    my $noise = $gRandom->Gaus(0,120);
    $noise += $signal*sin(($i-700.)*6.28/30)*exp((700.-$i)/300.) if $i > 700;
    $ht->SetBinContent($i,$noise);
    $c1->Modified();
    $c1->Update();
  }
  print sprintf("Real Time = %8.3fs, Cpu Time = %8.3fs\n",$sw->RealTime(),$sw->CpuTime());
  
  $gApplication->Terminate();
  $thr->join();

transpad.pl

  use strict;
  use warnings;
  use SOOT ':all';
  
  # Example of a canvas showing two histograms with different scales.
  # The second histogram is drawn in a transparent pad
  my $c1 = TCanvas->new("c1","transparent pad",200,10,700,500);
  my $pad1 = TPad->new("pad1","",0,0,1,1);
  my $pad2 = TPad->new("pad2","",0,0,1,1);
  $pad2->SetFillStyle(4000); # will be transparent
  $pad1->Draw();
  $pad1->cd();
  
  my $h1 = TH1F->new("h1","h1",100,-3,3);
  my $h2 = TH1F->new("h2","h2",100,-3,3);
  my $r = TRandom->new;
  
  my $nloop = 100000;
  for my $i (0..$nloop-1) {
    if ($i < 1000) {
      my $x1 = $r->Gaus(-1,0.5);
      $h1->Fill($x1);
    }
    my $x2 = $r->Gaus(1,1.5);
    $h2->Fill($x2);
  }
  
  $h1->Draw();
  $pad1->Update(); #this will force the generation of the "stats" box
  my $ps1 = $h1->GetListOfFunctions()->FindObject("stats");
  $ps1->SetX1NDC(0.4); 
  $ps1->SetX2NDC(0.6);
  $pad1->Modified();
  $c1->cd();
   
  #compute the pad range with suitable margins
  my $ymin = 0;
  my $ymax = 2000;
  my $dy = ($ymax-$ymin)/0.8; # 10 per cent margins top and bottom
  my $xmin = -3;
  my $xmax = 3;
  my $dx = ($xmax-$xmin)/0.8; # 10 per cent margins left and right
  $pad2->Range($xmin-0.1*$dx,$ymin-0.1*$dy,$xmax+0.1*$dx,$ymax+0.1*$dy);
  $pad2->Draw();
  $pad2->cd();
  $h2->SetLineColor(kRed);
  $h2->Draw("sames");
  $pad2->Update();
  
  my $ps2 = $h2->GetListOfFunctions()->FindObject("stats");
  $ps2->SetX1NDC(0.65); 
  $ps2->SetX2NDC(0.85);
  $ps2->SetTextColor(kRed);
  
  # draw axis on the right side of the pad
  my $axis = TGaxis->new($xmax,$ymin,$xmax,$ymax,$ymin,$ymax,50510,"+L");
  $axis->SetLabelColor(kRed);
  $axis->Draw();
  
  $gApplication->Run;

zones.pl

  use strict;
  use warnings;
  use SOOT ':all';
  
  $gROOT->Reset();
  my $c1 = TCanvas->new('c1','The Ntuple canvas',200,10,700,780);
  $gStyle->SetPadBorderMode(0);
  $gStyle->SetOptStat(0);
  $c1->Divide(2,2,0,0);
  
  my $pad1 = TPad->new('pad1','This is pad1',0.02,0.52,0.48,0.98,21);
  my $pad2 = TPad->new('pad2','This is pad2',0.52,0.52,0.98,0.98,21);
  my $pad3 = TPad->new('pad3','This is pad3',0.02,0.02,0.48,0.48,21);
  my $pad4 = TPad->new('pad4','This is pad4',0.52,0.02,0.98,0.48,1);
  
  $pad1->Draw();
  $pad2->Draw();
  $pad3->Draw();
  $pad4->Draw();
  
  my $h1 = TH2F->new("h1","test1",10,0,1,20,0,20);
  my $h2 = TH2F->new("h2","test2",10,0,1,20,0,100);
  my $h3 = TH2F->new("h3","test3",10,0,1,20,-1,1);
  my $h4 = TH2F->new("h4","test4",10,0,1,20,0,1000);
  $h1->FillRandom("gaus", 100000);
  $h2->FillRandom("gaus", 100000);
  $h3->FillRandom("gaus", 100000);
  $h4->FillRandom("gaus", 100000);
  
  $pad1->cd();
  $pad1->SetBottomMargin(0);
  $pad1->SetRightMargin(0);
  $pad1->SetTickx(2);
  $h1->Draw();
  
  $pad2->cd();
  $pad2->SetLeftMargin(0);
  $pad2->SetBottomMargin(0);
  $pad2->SetTickx(2);
  $pad2->SetTicky(2);
  $h2->GetYaxis()->SetLabelOffset(0.01);
  $h2->Draw();
  
  $pad3->cd();
  $pad3->SetTopMargin(0);
  $pad3->SetRightMargin(0);
  $h3->Draw();
  
  $pad4->cd();
  $pad4->SetLeftMargin(0);
  $pad4->SetTopMargin(0);
  $pad4->SetTicky(2);
  $h4->Draw();
  
  $c1->Update();
  
  $gApplication->Run;

AUTHOR

Steffen Mueller, <smueller@cpan.org>

COPYRIGHT AND LICENSE

SOOT, the Perl-ROOT wrapper, is free software; you can redistribute it and/or modify it under the same terms as ROOT itself, that is, the GNU Lesser General Public License. A copy of the full license text is available from the distribution as the LICENSE file.

To install SOOT, copy and paste the appropriate command in to your terminal.

cpanm

cpanm SOOT

CPAN shell

perl -MCPAN -e shell
install SOOT

For more information on module installation, please visit the detailed CPAN module installation guide.

	Global
`s`	Focus search bar
`?`	Bring up this help dialog

	GitHub
`g` `p`	Go to pull requests
`g` `i`	go to github issues (only if github is preferred repository)

	POD
`g` `a`	Go to author
`g` `c`	Go to changes
`g` `i`	Go to issues
`g` `d`	Go to dist
`g` `r`	Go to repository/SCM
`g` `s`	Go to source
`g` `b`	Go to file browse

	Search terms
module: (e.g. module:Plugin)
distribution: (e.g. distribution:Dancer auth)
author: (e.g. author:SONGMU Redis)
version: (e.g. version:1.00)