#! /usr/bin/perl -w

# 12/2004 Laurent FACQ - facq@u-bordeaux-fr (REAUMUR - Université de Bordeaux)

## Programme utilisé pour réaliser des statistiques textes et graphiques 
## à partir des données contenue d'une base de données
## (postgresql)

## TODO : parametre range de visualisation <> range de calculs
## TODO : parametre par nom
##
## generation d'une arboresecne web avec raffinement par ...


$use= "
(/bin/rm -r /tmp/gtssd ; mkdir  /tmp/gtssd ; ./pgplot ; cd /tmp/gtssd ; cat *.gnuplot | gnuplot ; xzgv *.png)
(/bin/rm -r /tmp/gtssd ; mkdir  /tmp/gtssd ; ./pgplot ; cd /tmp/gtssd ; cat *.gnuplot | gnuplot)

(cd /tmp/ ; tar -cf - gtssd | gzip -9 > /tmp/gtssd.tgz)

"; $use.=$use;

### todo : generer du script 'R' : http://www.r-project.org/index.html

### particionnement avec statistics::descriptive (partition)
$dbname= "gtssd";
$dbhost= "localhost";

$debug= 0;

use Statistics::Descriptive; # apt-get install libstatistics-descriptive-perl 
use DBI;                     # apt-get install libdbi-perl 

$dbh= DBI->connect("dbi:Pg:dbname=$dbname;host=$dbhost","","");
	
if (!$dbh)
{
    die "DBI:Internal error";
}

$outputdir= "/tmp/gtssd";
$table= "survey_2";
$condition_generales = " xratio <> 0 ";


unlink("$outputdir/all.pdata");

@sql_defaults= (
		WHERE=>$condition_generales,
		TABLE=>$table,
		);

@gnuplot_defaults= (

		    );

@defaults= (
	    PATH=>$outputdir,
	    );


###################

$req= "SELECT DISTINCT structure FROM $table";
@structures = @{$dbh->selectcol_arrayref($req)};

$req= "SELECT DISTINCT code, answer FROM answers";
$ref= $dbh->selectall_arrayref($req);
foreach $row (@{$ref})
{
    ($code, $ans)= @{$row};

    $ans =~ s/[^ -z]/./g; # todo - ne garder que ce qui est imprimable
    $answers{$code}=$ans;

    print "$code -> $ans\n" if $debug;
}


###################

percent(@defaults,
	TITLE=>"Type de structure ayant repondu",
	VALUENAME=>"structures",
	SQL=>[
	      @sql_defaults,
	      EXP=>'structure',
	      ],
	);

foreach $structure ( "TOUT",@structures )
{
    print STDERR "DEBUG : $structure\n";
    
    $suffix= "--$structure";
    $comment= $structure;
    $where = " $condition_generales ";
    
    if ($structure ne "TOUT") 
    { 
	$where = " $condition_generales AND structure = ".$dbh->quote($structure)." ";
	if (defined($answers{$structure})) { $comment.= "- $answers{$structure}"; }

    }
    
    percent(@defaults,
	    TITLE=>"Utilisation d un SSD $comment",
	    VALUENAME=>"ssd$suffix",
	    SQL=>[
		  @sql_defaults,
		  EXP=>'logicieldedie',
		  WHERE=>$where,
		  ],
	    );



    repartition(@defaults,
		TITLE=>"Repartition du nombre des interlocuteurs $comment", 
		VALUENAME=>"nb-interlocuteurs$suffix", 
		SQL=> [
		       @sql_defaults,
		       EXP=>'xnbuser', 
		       WHERE=>$where,
		       ],
		STEP=>20, # could be distribution cf frequency_distribution
		GNUPLOT=>[
			  @gnuplot_defaults,
			  #####################"""XRANGE=>'[0:500]',
			  ]
		);
    
    repartition(@defaults,
		TITLE=>"Repartition du nombre de membres du service $comment",
		VALUENAME=>"nb-membres-services$suffix", 
		SQL=>[
		      @sql_defaults,
		      EXP=>'xnbmembres',
		      WHERE=>$where, 
		      ],
		GNUPLOT=>[
			  @gnuplot_defaults,
			  ],
		STEP=>1, # could be distribution cf frequency_distribution
		);
    
    repartition(@defaults,
		TITLE=>"Repartition du ratio Nb Interlocuteurs par Nb Membres du Service $comment",
		VALUENAME=>"ratio$suffix", 
		SQL=>[
		      @sql_defaults,
		      EXP=>'xratio', 
		      WHERE=>$where,
		      ],
		GNUPLOT=>[
			  @gnuplot_defaults,
			  #######################"XRANGE=>'[0:600]',
			  ],
		STEP=>10, # could be distribution cf frequency_distribution
		);
    
    percent(@defaults,
	    TITLE=>"Type de logiciel $comment",
	    VALUENAME=>"typelogiciel$suffix",
	    SQL=>[
		  @sql_defaults,
		  EXP=>'typelogiciel',
		  WHERE=>" $where AND xoui ",
		  ],
	    );
    
    percent(@defaults,
	    TITLE=>"Soumission de demandes par... $comment",
	    VALUENAME=>"typesoumission-xnon-xnonmais$suffix",
	    SQL=>[
		  @sql_defaults,
		  EXP=>'typesoumission',
		  WHERE=>" $where AND ( xnon OR xnonmais ) ",
		  ],
	    );

    percent(@defaults,
	    TITLE=>"Soumission de demandes par (nbmembre=1)... $comment",
	    VALUENAME=>"typesoumission-xnon-xnonmais-e1$suffix",
	    SQL=>[
		  @sql_defaults,
		  EXP=>'typesoumission',
		  WHERE=>" $where AND ( xnon OR xnonmais ) AND xnbmembres = 1 ",
		  ],
	    );

    percent(@defaults,
	    TITLE=>"Soumission de demandes par (nbmembre>1)... $comment",
	    VALUENAME=>"typesoumission-xnon-xnonmais-s1$suffix",
	    SQL=>[
		  @sql_defaults,
		  EXP=>'typesoumission',
		  WHERE=>" $where AND ( xnon OR xnonmais ) AND xnbmembres > 1 ",
		  ],
	    );

    percent(@defaults,
	    TITLE=>"Soumission de demandes par (nbmembre>2)... $comment",
	    VALUENAME=>"typesoumission-xnon-xnonmais-s2$suffix",
	    SQL=>[
		  @sql_defaults,
		  EXP=>'typesoumission',
		  WHERE=>" $where AND ( xnon OR xnonmais ) AND xnbmembres > 2 ",
		  ],
	    );
    
    percent(@defaults,
	    TITLE=>"Modification des habitudes $comment",
	    VALUENAME=>"modificationhabitudes$suffix",
	    SQL=>[
		  @sql_defaults,
		  EXP=>'modificationhabitudes',
		  WHERE=>" $where AND ( xoui ) ",
		  ],
	    );
    
    percent(@defaults,
	    TITLE=>"Pourquoi n'avez vous pas mis en place un tel systeme $comment",
	    VALUENAME=>"pourquoi-non$suffix",
	    SQL=>[
		  @sql_defaults,
		  EXP=>'pourquoi',
		  WHERE=>" $where AND ( xnon ) ",
		  ],
	    );
    
    percent(@defaults,
	    TITLE=>"Pourquoi avez vous renonce a mettre en place un tel systeme $comment",
	    VALUENAME=>"renonceautiliserssd$suffix",
	    SQL=>[
		  @sql_defaults,
		  EXP=>'renonceautiliserssd',
		  WHERE=>" $where AND ( xnonmais ) ",
		  ],
	    );

#percent(@defaults,
#	TITLE=>"Pourquoi avez vous renonce ou n'avez vous pas mis en place un tel systeme",
#	VALUENAME=>"pourquoi-non-nomais",
#	SQL=>[
#	      @sql_defaults,
#	      EXP=>'pourquoi',
#	      WHERE=>" $condition_generales AND ( xnon or xnonmais ) ",
#	      ],
#	);

    
    percent(@defaults,
	    TITLE=>"Moyen utilises pour soumissionner $comment",
	    VALUENAME=>"typesoumission-xnon$suffix",
	    SQL=>[
		  @sql_defaults,
		  EXP=>'typesoumission',
		  WHERE=>" $where AND ( xnon ) ",
		  ],
	    );

    percent(@defaults,
	    TITLE=>"Existance d'un point d'entree unique $comment",
	    VALUENAME=>"pointentreeunique$suffix",
	    SQL=>[
		  @sql_defaults,
		  EXP=>'pointentreeunique',
		  WHERE=>" $where AND ( xnon OR xnonmais ) ",
		  ],
	    );

    percent(@defaults,
	    TITLE=>"Existance d'un point d'entree unique (nbmembres > 1)$comment",
	    VALUENAME=>"pointentreeunique-s1$suffix",
	    SQL=>[
		  @sql_defaults,
		  EXP=>'pointentreeunique',
		  WHERE=>" $where AND ( xnon OR xnonmais ) AND xnbmembres > 1 ",
		  ],
	    );


    percent(@defaults,
	    TITLE=>"Existance d'un point d'entree unique (nbmembres = 1)$comment",
	    VALUENAME=>"pointentreeunique-e1$suffix",
	    SQL=>[
		  @sql_defaults,
		  EXP=>'pointentreeunique',
		  WHERE=>" $where AND ( xnon OR xnonmais ) AND xnbmembres = 1 ",
		  ],
	    );
    
    percent(@defaults,
	    TITLE=>"Type de soumission quand existe un point d'entree unique $comment",
	    VALUENAME=>"typesoumission-pour-point-entree-unique$suffix",
	    SQL=>[
		  @sql_defaults,
		  EXP=>'typesoumission',
		  WHERE=>" $where AND ( xnon or xnonmais ) AND pointentreeunique='Y' ",
		  ],
	    );

    percent(@defaults,
	    TITLE=>"Type de soumission quand existe un point d'entree unique (nb membres > 1) $comment",
	    VALUENAME=>"typesoumission-pour-point-entree-unique-s1$suffix",
	    SQL=>[
		  @sql_defaults,
		  EXP=>'typesoumission',
		  WHERE=>" $where AND ( xnon or xnonmais ) AND pointentreeunique='Y' AND xnbmembres > 1 ",
		  ],
	    );
    
    percent(@defaults,
	    TITLE=>"Duree de mise en place $comment",
	    VALUENAME=>"combientempsmiseenplace$suffix",
	    SQL=>[
		  @sql_defaults,
		  EXP=>'combientempsmiseenplace',
		  WHERE=>" $where AND ( xoui ) ",
		  ],
	    );

    percent(@defaults,
	    TITLE=>"Combien de temps d'utilisation $comment",
	    VALUENAME=>"combiendetempsutilisation$suffix",
	    SQL=>[
		  @sql_defaults,
		  EXP=>'combiendetempsutilisation',
		  WHERE=>" $where AND ( xoui ) ",
		  ],
	    );
    
    percent(@defaults,
	    TITLE=>"Conseilleriez vous l'utilsiation d'un ssd $comment",
	    VALUENAME=>"conseillessd$suffix",
	    SQL=>[
		  @sql_defaults,
		  EXP=>'conseillessd',
		  WHERE=>" $where AND ( xoui ) ",
		  ],
	    );
    
    percent(@defaults,
	    TITLE=>"Indice de satisfaction globale $comment",
	    VALUENAME=>"satisfaction$suffix",
	    SQL=>[
		  @sql_defaults,
		  EXP=>'satisfaction',
		  WHERE=>" $where AND ( xoui ) ",
		  ],
	    );


    percent(@defaults,
	    TITLE=>"Polyvalence des membre (> 1) $comment",
	    VALUENAME=>"polyvalence$suffix",
	    SQL=>[
		  @sql_defaults,
		  EXP=>'polyvalent',
		  WHERE=>" $where AND xnbmembres > 1 ",
		  ],
	    );

    percent(@defaults,
	    TITLE=>"Existance de sous equipes (> 1) $comment",
	    VALUENAME=>"sousequipes$suffix",
	    SQL=>[
		  @sql_defaults,
		  EXP=>'sousequipes',
		  WHERE=>" $where AND xnbmembres > 1 ",
		  ],
	    );

    percent(@defaults,
	    TITLE=>"Interlocuteurs permenants - non permanents $comment",
	    VALUENAME=>"typeuserpnp$suffix",
	    SQL=>[
		  @sql_defaults,
		  EXP=>'typeuserpnp',
		  WHERE=>" $where ",
		  ],
	    );

    percent(@defaults,
	    TITLE=>"Type d'interlocuteurs final - correspondant $comment",
	    VALUENAME=>"typeuserfc$suffix",
	    SQL=>[
		  @sql_defaults,
		  EXP=>'typeuserfc',
		  WHERE=>" $where ",
		  ],
	    );


}

#
#Voici ce qu'il reste a traiter
#
#
#-  Facon de soumettre les demandes A REFAIRE AVEC NON + NOM-MAIS
#
#- Point d\u2019entree unique (pour non et non-mais)
#
#- depuis combien de temps logiciel est utilise
#
#- combien de temps a pris la mise en place
#
#- est-ce que la mise en place a modifie habitudes des utilisateurs (oui)
#
#- classer apports logiciels depouiller
#
#- principales dificultes
#
#- conseilleriez-vous d\u2019utiliser un SSD ?
#
#- satisfaction globale
#



sub percent
{
    my ($table, $titre, $namex, $expx, $cond, $step, $file);
    
    my (%param)= @_;
    my ($p,$sub,$k, $where);
    
    my $output="";

    foreach $sub ( qw/SQL GNUPLOT/ )
    {
	if (defined($p= $param{$sub}))
	{
	    $param{$sub}= {};
	    %{$param{$sub}}= @{$p};
	}
    }

    if (!defined($param{FILENAME})) { $param{FILENAME}=$param{VALUENAME}; }
    if (!defined($param{PATH})) { $param{PATH}='/tmp/'; }
    
    $file= $param{PATH}."/".$param{FILENAME};
    $file=~ s/[^\/a-zA-Z0-9+=-]//g;
    open(LOG,">$file.log") or die "cannot output in $file...";    

    my ($row,$val,$i);

    $where= "";
    if (defined($param{SQL}{WHERE})) { $where= " WHERE ( ".$param{SQL}{WHERE}." ) " ; }

    $exp = $param{SQL}{EXP};
    
### utiliser freqneucy distribution (distribution a tranche variables, boite min et boite max)

    my ($valx) = $exp;
    
    my $reqc= "SELECT count(1) as nb "
	." FROM $param{SQL}{TABLE} "
	." $where ";
    my ($count)= $dbh->selectrow_array($reqc);

    print LOG "#".`date`;
    print LOG "$reqc\n";

    my $req= "SELECT $valx as val, "
	."count($valx) as nb, round((100::numeric*(count($valx)))/$count,2) as p FROM $param{SQL}{TABLE} "
	." $where "
	."GROUP BY $valx "
	."ORDER BY nb DESC ";
    print STDERR "DEBUG - Requete : $req\nto $file\n" if $debug;
    my $ref= $dbh->selectall_arrayref($req);
    
    print LOG "$req\n";
###
    
    
    $output.= "#".`date`;
    $output.="# $param{TITLE}\n";
    $output.="# $reqc\n";
    $output.="# $req\n";

    foreach $row (@{$ref})
    {
	($val, $count, $p)= @{$row};
	$valexp= "";
	if (defined($answers{$val})) { $valexp= $answers{$val}; }
	$output.="$p% \t $count \t $val [$valexp]\n";
    }
    
    $output.="\n\n";

    open(OUT,">$file.pdata") or die "cannot output in $file...";
    print OUT $output;
    close(OUT);

    open(OUT,">>$param{PATH}/all.pdata") or die "cannot output in $file...";
    print OUT $output;
    close(OUT);

    
}



sub repartition
{
    my ($table, $titre, $namex, $expx, $cond, $step, $file);
    
    my (%param)= @_;
    my ($p,$sub,$k, $where, $total);

    foreach $sub ( qw/SQL GNUPLOT/ )
    {
	if (defined($p= $param{$sub}))
	{
	    $param{$sub}= {};
	    %{$param{$sub}}= @{$p};
	}
    }

    if (!defined($param{FILENAME})) { $param{FILENAME}=$param{VALUENAME}; }
    if (!defined($param{PATH})) { $param{PATH}='/tmp/'; }
    
    $file= $param{PATH}."/".$param{FILENAME};
    $file=~ s/[^\/a-zA-Z0-9+=-]//g;
    open(LOG,">$file.log") or die "cannot output in $file...";    

    my ($row,$val,$i);

    $where= "";
    if (defined($param{SQL}{WHERE})) { $where= " WHERE ( ".$param{SQL}{WHERE}." ) " ; }

    $step= $param{STEP};
    $exp = $param{SQL}{EXP};

    my $valx="$step/2+($step)*round((($exp)/($step))::numeric,0)";
    
### utiliser freqneucy distribution (distribution a tranche variables, boite min et boite max)
    

    my $req= "SELECT $valx as val, "
	."count($valx) as nb FROM $param{SQL}{TABLE} "
	." $where "
	."GROUP BY $valx ";
    print STDERR "DEBUG - Requete : $req\nto $file\n" if $debug;
    
    print LOG "#".`date`;
    print LOG "$req\n";

    my $ref= $dbh->selectall_arrayref($req);
    
    my $stat= Statistics::Descriptive::Full->new();

###

    open(OUT,">$file.data") or die "cannot output in $file...";    
    print OUT "#".`date`;
    $total= 0;
    foreach $row (@{$ref})
    {
	($val, $count)= @{$row};
	$total += $count;
	print OUT "$val $count\n";
	foreach $i (1..$count)
	{
	    $stat->add_data($val); # "x $count);
	}
    }
    close(OUT);
    
###

    $centilrange1= $stat->percentile(10)-1;
    $centilrange2= $stat->percentile(90)+1;
    $centilrange= "[$centilrange1:$centilrange2]";

    open(GNUPLOT,">$file.gnuplot") or die "cannot output in $file...";    
    open(TEXT,">$file.text") or die "cannot output in $file...";    
    
    print GNUPLOT "reset \n";
    print GNUPLOT "set terminal png large \n";
    print GNUPLOT "set output \"$file.png\"\n";

    print GNUPLOT "set xlabel \" $param{VALUENAME} \" \n";
    print GNUPLOT "set ylabel \" nb réponses \" \n";
    print GNUPLOT "set title \"$centilrange ".$param{TITLE}." (/$step)\" \n";

    foreach $k (keys %{$param{GNUPLOT}})
    {
	print GNUPLOT "set ".lc($k)." ".$param{GNUPLOT}{$k}."\n"; 
    }

    print GNUPLOT "set xrange $centilrange\n"; 

#    print GNUPLOT "plot '"."$file.data"."' with impulses \n";
#    print GNUPLOT "plot '"."$file.data"."' with linespoints \n";
#    print GNUPLOT "plot '"."$file.data"."' with boxes \n";
#    print GNUPLOT "plot '"."$file.data"."' title \"nb $param{VALUENAME}\" with impulses \n";
    print GNUPLOT "plot '"."$file.data"."' title \"\" with impulses \n";
    #print GNUPLOT "pause mouse \" attente return \" \n";
    #print GNUPLOT "pause 100 \" attente return \" \n";

    print TEXT "$param{TITLE} $centilrange\n";
    print TEXT "Nombre de reposnes : \t $total\n";
    print TEXT "Deviation Standard : \t ".$stat->standard_deviation()." \n";

    print TEXT "Centil 25 : \t ".$stat->percentile(25)." \n";
    print TEXT "Centil 75 : \t ".$stat->percentile(75)." \n";

    print TEXT "Mediane : \t ".$stat->median()." \n";

    print TEXT "Mode : \t ".$stat->mode()." \n";

    print TEXT "Moyenne : \t ".$stat->mean()." \n";
    print TEXT "Nombre : \t ".$stat->count()." \n";

    print TEXT "Min : \t ".$stat->min()." \n";
    print TEXT "Max : \t ".$stat->max()." \n";


    close(GNUPLOT);
    close(TEXT);
    close(LOG);
}