Valid XHTML     Valid CSS2    

Listing du fichier statuno.php

 

00001     <?php
00002     
00003     error_reporting(
E_ALL E_NOTICE) ;
00004     
00005     #    (gH)   -_-  statuno.php  ;  TimeStamp (unix) : 24 Octobre 2011 vers 09:18
00006     
00007     include_once(
"std7.php") ;
00008     
00009     $versionStatuno 
3.35 ;
00010     
00011     # version 3.35 : ajout de echo"\n" pour entree_R et sortie_R
00012     
00013     # version 3.33 : ajout de source("statgh.r") dans fonction execute_R
00014     
00015     # version 3.31 : fonction execute_R pour calcstat/aqt_det.php (voir vers ligne 580)
00016     
00017     # version 3.29 : fonctions entree_sortie_R entree_R sortie_R graphique_R_png
00018     #                pour gérer les TD de biostat MasterTPV et EDA
00019     
00020     # version 3.27 : fonction_R() permet de renvoyer une seule valeur par
00021     # l'appel de la fonction R correspondante
00022     
00023     # version 3.25 : on peut mettre plusieurs tables MYSQL concaténées par des +
00024     # les + sont convertis en virgules et le tour est joué
00025     
00026     ###############################################################
00027     
00028     function 
statgh($nomf="",$cla="orange_stim") {
00029     
00030     ###############################################################
00031     
00032     if (
$nomf=="") {
00033       return(href
("../statghfns.php","statgh.r")) ;
00034     } else {
00035       return(href
("../statghfns.php?lafns=$nomf","$nomf()",$cla)) ;
00036     } # finsi
00037     
00038     
# fin de fonction statgh
00039     
00040     ###############################################################
00041     
00042     function 
hrr($nomf,$package="base",$cla="orange_stim") {
00043     
00044     ###############################################################
00045     
00046       # renvoie le lien sur finzi pour la fonction
00047     
00048       # exemple d'utilisation :
00049       #   echo href(hrr("mode"),"storage.mode()").". " ;
00050     
00051       return(
"http://finzi.psych.upenn.edu/R/library/$package/html/$nomf".".html") ;
00052     
00053     } # fin de fonction hrr
00054     
00055     ###############################################################
00056     
00057     function 
hrrr($nomf,$package="base",$nomh="",$cla="gvert") {
00058     
00059     ###############################################################
00060     
00061       # renvoie le lien sur finzi pour la fonction
00062       # avec un nom différent dans le lien, si besoin est
00063     
00064       # exemple d'utilisation :
00065       #   echo hrrr("class") ;
00066       #   echo hrrr("nrow","base","ncol","gvert").". " ; # car ncol est référencé dans la page de nrow
00067     
00068       if (
$package=="") {
00069         $package 
"base" ;
00070       } # fin si
00071       if (
$nomh=="") {
00072         $nomh 
$nomf."()" ;
00073       } # fin si
00074       return(
href(hrr($nomf,$package),$nomh,$cla)) ;
00075     
00076     } # fin de fonction hrrr
00077     
00078     ###############################################################
00079     
00080     function 
hrrp($package="base",$nomp="",$cla="gbleuf") {
00081     
00082     ###############################################################
00083     
00084       # renvoie le lien sur finzi pour le package
00085       # avec un nom différent dans le lien, si besoin est
00086     
00087       # exemple d'utilisation :
00088       #   echo hrrr("phyloseq") ;
00089       #   echo hrrr("nrow","base","ncol","gvert").". " ; # car ncol est référencé dans la page de nrow
00090     
00091       if (
$package=="") {
00092         $package 
"base" ;
00093       } # fin si
00094       if (
$nomp=="") {
00095         $nomp 
$package ;
00096       } # fin si
00097       return(
href(hrr("00Index",$package),$nomp,$cla)) ;
00098     
00099     } # fin de fonction hrrp
00100     
00101     
00102     
00103     ###############################################################################
00104     ###############################################################################
00105     
00106     function 
decritQT($titreQT,$tabQT,$uniteQT="?",$lang="FR",$grf="") {
00107     
00108     ###############################################################################
00109     
00110     #
00111     # calcul QT sur un tableau PHP
00112     # voir aussi decritQT_Sql pour calcul QT sur un champ SQL
00113     #
00114     
00115       if (
$lang=="FR") {
00116          h2
("Analyse QT de la variable $titreQT") ;
00117       } else {
00118          h2
("Analysis of the variable '$titreQT'") ;
00119       } ; # fin de si
00120     
00121       if (
count($tabQT)==0) {
00122         h3
(" no data found.") ;
00123       } ; # fin de si
00124     
00125       $ftmp1 
tempnam("/tmp","statuno_data.tmp")    ; # fichier des donn&eacute;es issues de mysql utilis&eacute;es par R
00126       $ftmp2 
tempnam("/tmp","statuno_calculs.r")   ; # programme R
00127       $ftmp3 
tempnam("/tmp","statuno_calcstats.r") ; # pour "sourcer" le programme
00128       $ftmp4 
tempnam("/tmp","statuno_calculs.sor") ; # sorties du programme R
00129     
00130       # transfert des donn&eacute;es du tableau $tabQT dans le fichier tmp1
00131     
00132       if (
$fh fopen($ftmp1,"w")) {
00133            # pre() ;
00134            $nbvQT 
count($tabQT) ;
00135            for  ($idvQT
=0$idvQT<$nbvQT;$idvQT++) {
00136                 $ligs 
$tabQT[$idvQT]."\n" ;
00137                 ## echo $ligs ;
00138                 fputs
($fh$ligs) ;
00139            } ; # fin pour chaque
00140            # finpre() ;
00141            fclose
($fh) ;
00142     ## print "<pre> fichier $ftmp1 ok sans doute \n</pre>" ;
00143       } else {
00144         print "<pre> pb  avec 
$ftmp1 \n</pre>" ;
00145         return(""
) ;
00146       } ; # fin de si
00147     
00148       # pr&eacute;paration des commandes R, on lit dans phpmp1
00149     
00150       $cmdr 
"" ;
00151       $cmdr 
.= "    source(\"../statgh.r\",echo=TRUE)       \n" ;
00152       $cmdr 
.= "                                        \n" ;
00153       $cmdr 
.= "    alldata <- read.table(\"$ftmp1\")      \n" ;
00154       $cmdr 
.= "                                        \n" ;
00155       $cmdr 
.= "    valQT   <- alldata[,1]                \n" ;
00156       $cmdr 
.= "                                        \n" ;
00157       $cmdr 
.= "    cat(\"STAT_DEB\\n\") ;               \n" ;
00158       $cmdr 
.= "    cat(\"\\n\")                          \n" ;
00159       $cmdr 
.= "                                         \n" ;
00160       $cmdr 
.= "    decritQT(\"$titreQT\",valQT,\"$uniteQT\")       \n" ;
00161       $cmdr 
.= "                                         \n" ;
00162       $cmdr 
.= "    cat(\"\\n\")                          \n" ;
00163     
00164       if ($lang
=="FR") {
00165          $cmdr 
.= "    cat(\"DIAGRAMME TIGE-FEUILLES\")                          \n" ;
00166       } else {
00167          $cmdr 
.= "    cat(\"STEM and LEAF DIAGRAM\")                          \n" ;
00168       } ; # fin de si
00169     
00170       $cmdr 
.= "    cat(\"\\n\")                          \n" ;
00171       $cmdr 
.= "    stem(valQT,width=130)                          \n" ;
00172       $cmdr 
.= "    cat(\"\\n\")                          \n" ;
00173       $cmdr 
.= "    cat(\"STAT_FIN\\n\") ;                \n" ;
00174     
00175     ## print "<pre> CMD = $cmdr \n\n</pre>" ;
00176     
00177       # &eacute;criture des commandes R dans le fichier ftmp2
00178     
00179       if (
$fh fopen($ftmp2,"w")) {
00180          fputs
($fh$cmdr) ;
00181          fclose
($fh) ;
00182          # print "<pre> fichier $ftmp2 ok sans doute \n</pre>" ;
00183       } else {
00184         print "<pre> pb  avec 
$ftmp2 \n</pre>" ;
00185       } ; # fin de si
00186     
00187       # afin de simplifier les affichages, on ne met que source
00188       # dans le fichier tmp3 qui sera ex&eacute;cut&eacute; :
00189     
00190       if (
$fh fopen($ftmp3,"w")) {
00191          $ligs 
"  source(\"$ftmp2\",echo=FALSE) \n ";
00192          fputs
($fh$ligs) ;
00193          fclose
($fh) ;
00194          # print "<pre> fichier $ftmp3 ok sans doute \n</pre>" ;
00195       } else {
00196         print "<pre> pb  avec 
$ftmp3 \n</pre>" ;
00197       } ; # fin de si
00198     
00199       # ex&eacute;cution standard de R avec redirection
00200     
00201       unlink
($ftmp4) ;
00202     
00203     /*
00204       pre() ;
00205       system("head $ftmp1") ;
00206       system("head $ftmp2") ;
00207       system("head $ftmp3") ;
00208       finpre() ;
00209     */
00210     
00211       $cmd 
"R --quiet --vanilla < $ftmp3 > $ftmp4  2> $ftmp4 " ;
00212     
00213     ##  h3("$cmd") ;
00214     
00215       # si cela ne marche pas, essayer : $cmd = "R --quiet --vanilla < $ftmp3 " ;
00216     
00217       system
($cmd) ;
00218       # system("head $ftmp4") ;
00219     
00220       # filtrage des r&eacute;sultats et affichage
00221     
00222       pre
() ;
00223       print "\n" 
;
00224       clearstatcache
();
00225       if ($fh 
fopen($ftmp4,"r")) {
00226            $ok 
;
00227            while (!feof 
($fh)) {
00228              $lig 
fgets($fh4096) ;
00229     ## print "<pre>  on voit $ligs dans $ftmp4 </pre>";
00230              if (
$lig == "STAT_FIN\n") { $ok ; } ;
00231              if ($ok
==1) { echo "  $lig " ; } ;
00232              if ($lig 
== "STAT_DEB\n") { $ok ; } ;
00233            } ; # fin tant que
00234            fclose
($fh) ;
00235       } else {
00236         print "<pre> pas de valeurs pour 
$ftmp4 </pre>" ;
00237       } ; # fin de si
00238     
00239       print 
"\n" ;
00240       finpre
() ;
00241       flush
() ;
00242     
00243       #$cmd = "perl alng.pl LNG $tmp1 $tmp3" ;
00244       #print("<pre> $cmd \n</pre>") ;
00245       #
00246       #system("$cmd ") ;
00247       #calcstat_en_R($tmp1,$tmp2) ;
00248     
00249       unlink
($ftmp1) ;
00250       unlink
($ftmp2) ;
00251       unlink
($ftmp3) ;
00252       unlink
($ftmp4) ;
00253     
00254     # tracé via jpgrah
00255     
00256       if (!
$grf=="") {
00257     
00258       sort
($tabQT) ;
00259     
00260        $ydval   
"" ;
00261        for  ($idvQT
=0$idvQT<$nbvQT;$idvQT++) {
00262             $ydval 
.= $tabQT[$idvQT] ;
00263             if ($idvQT
<$nbvQT-1){  $ydval .= "_" ; } ;
00264        } ; # fin pour chaque
00265     
00266        echo 
"<blockquote>" ;
00267        echo "<p>" 
;
00268        echo("<img src='../traceydata.php?ydval=
$ydval' alt='graph' />");
00269        echo "</p>" 
;
00270        echo "</blockquote>" 
;
00271     
00272       } ; # fin de si
00273     
00274     
00275     
# function decritQT
00276     
00277     ###############################################################################
00278     
00279     function 
decritQT_Sql($titreQT,$uniteQT="?",$tablesSQL,$champSQL,$conditions="",$lang="FR",$grf="") {
00280     
00281     ###############################################################################
00282     
00283       # remarques : on suppose la connexion SQL faite
00284       #             $tableSQL peut contenir plusieurs noms
00285       #             et meme du code SQL tant que cela va dans la partie FROM
00286     
00287     
00288       # 1. transfert des données dans un tableau
00289     
00290       $lestablesSQL 
str_replace("+",",",$tablesSQL) ;
00291       $que 
" select $champSQL from $lestablesSQL $conditions " ;
00292       $res 
mysql_query($que) ;
00293       $tabQT 
= array() ;
00294       $indqt 
= -;
00295       while ($tdr
=mysql_fetch_array($res)) {
00296           $indqt
++ ;
00297           $tabQT
[$indqt] = $tdr[$champSQL] ;
00298       } ; # fin de tant que
00299     
00300       ## echo "<pre>\n".print_r($tabQT)."\n</pre>\n" ;
00301     
00302     
00303       # 2. appel de la fonction  decritQT($titreQT,$tabQT,$uniteQT="?")
00304     
00305       decritQT
($titreQT,$tabQT,$uniteQT,$lang,$grf) ;
00306     
00307     } # fin function decritQT_Sql
00308     
00309     ###############################################################################
00310     ###############################################################################
00311     
00312     function 
decritQL($titreQL,$tabQL,$tmodaQL) {
00313     
00314     ###############################################################################
00315     
00316       h2
("Analyse QL de la variable $titreQL") ;
00317     
00318       $ftmp1 
tempnam("/tmp","statuno_data.tmp")    ; # fichier des donn&eacute;es issues de mysql utilis&eacute;es par R
00319       $ftmp2 
tempnam("/tmp","statuno_calculs.r")   ; # programme R
00320       $ftmp3 
tempnam("/tmp","statuno_calcstats.r") ; # pour "sourcer" le programme
00321       $ftmp4 
tempnam("/tmp","statuno_calculs.sor") ; # sorties du programme R
00322     
00323       # transfert des donn&eacute;es du tableau $tabQT dans le fichier tmp1
00324     
00325       if (
$fh fopen($ftmp1,"w")) {
00326            # pre() ;
00327            $nbvQL 
count($tabQL) ;
00328            for  ($idvQL
=0$idvQL<$nbvQL;$idvQL++) {
00329                 $ligs 
$tabQL[$idvQL]."\n" ;
00330                 ## echo $ligs ;
00331                 fputs
($fh$ligs) ;
00332            } ; # fin pour chaque
00333            # finpre() ;
00334            fclose
($fh) ;
00335           # print "<pre> fichier $ftmp1 ok sans doute \n</pre>" ;
00336       } else {
00337         print "<pre> pb  avec 
$ftmp1 \n</pre>" ;
00338         return(""
) ;
00339       } ; # fin de si
00340     
00341       # pr&eacute;paration des commandes R, on lit dans phpmp1
00342     
00343       $cmdr 
"" ;
00344       $cmdr 
.= "    source(\"../../statgh.r\",echo=FALSE)       \n" ;
00345       $cmdr 
.= "                                        \n" ;
00346       $cmdr 
.= "    alldata <- read.table(\"$ftmp1\")      \n" ;
00347       $cmdr 
.= "                                        \n" ;
00348       $cmdr 
.= "    valQL   <- alldata[,1]                \n" ;
00349       $cmdr 
.= "                                        \n" ;
00350       $cmdr 
.= "    cat(\"STAT_DEB\\n\") ;               \n" ;
00351       $cmdr 
.= "    cat(\"\\n\")                          \n" ;
00352       $cmdr 
.= "                                         \n" ;
00353       $cmdr 
.= "    decritQL(\"$titreQL\",valQL,\"$tmodaQL\")       \n" ;
00354       $cmdr 
.= "                                         \n" ;
00355       $cmdr 
.= "    cat(\"\\n\")                          \n" ;
00356       $cmdr 
.= "    cat(\"STAT_FIN\\n\") ;                \n" ;
00357     
00358       # print "<pre> CMD = $cmdr \n\n</pre>" ;
00359     
00360       # &eacute;criture des commandes R dans le fichier ftmp2
00361     
00362       if (
$fh fopen($ftmp2,"w")) {
00363          fputs
($fh$cmdr) ;
00364          fclose
($fh) ;
00365          # print "<pre> fichier $ftmp2 ok sans doute \n</pre>" ;
00366       } else {
00367         print "<pre> pb  avec 
$ftmp2 \n</pre>" ;
00368       } ; # fin de si
00369     
00370       # afin de simplifier les affichages, on ne met que source
00371       # dans le fichier tmp3 qui sera ex&eacute;cut&eacute; :
00372     
00373       if (
$fh fopen($ftmp3,"w")) {
00374          $ligs 
"  source(\"$ftmp2\") \n ";
00375          fputs
($fh$ligs) ;
00376          fclose
($fh) ;
00377          # print "<pre> fichier $ftmp3 ok sans doute \n</pre>" ;
00378       } else {
00379         print "<pre> pb  avec 
$ftmp3 \n</pre>" ;
00380       } ; # fin de si
00381     
00382       # ex&eacute;cution standard de R avec redirection
00383     
00384       unlink
($ftmp4) ;
00385       $cmd 
"R --quiet --vanilla < $ftmp3 > $ftmp4  2> $ftmp4 " ;
00386       # si cela ne marche pas, essayer : $cmd = "R --quiet --vanilla < $ftmp3 " ;
00387     /*
00388       h3("$cmd") ;
00389     
00390       pre() ;
00391       system("head $ftmp1") ;
00392       system("head $ftmp2") ;
00393       system("head $ftmp3") ;
00394       finpre() ;
00395     */
00396     
00397       system
($cmd) ;
00398       # system("head $ftmp4") ;
00399     
00400       # filtrage des r&eacute;sultats et affichage
00401     
00402       pre
() ;
00403       print "\n" 
;
00404       clearstatcache
();
00405       if ($fh 
fopen($ftmp4,"r")) {
00406            $ok 
;
00407            while (!feof 
($fh)) {
00408              $lig 
fgets($fh4096) ;
00409       #if ($dbgr == 1) { print "<pre>  on voit $ligs dans $ftmp4 </pre>"; } ;
00410              if (
$lig == "STAT_FIN\n") { $ok ; } ;
00411              if ($ok
==1) { echo "  $lig " ; } ;
00412              if ($lig 
== "STAT_DEB\n") { $ok ; } ;
00413            } ; # fin tant que
00414            fclose
($fh) ;
00415       } else {
00416         print "<pre> pas de valeurs pour 
$ftmp4 </pre>" ;
00417       } ; # fin de si
00418     
00419       print 
"\n" ;
00420       finpre
() ;
00421       flush
() ;
00422     
00423       #$cmd = "perl alng.pl LNG $tmp1 $tmp3" ;
00424       #print("<pre> $cmd \n</pre>") ;
00425       #
00426       #system("$cmd ") ;
00427       #calcstat_en_R($tmp1,$tmp2) ;
00428     
00429       unlink
($ftmp1) ;
00430       unlink
($ftmp2) ;
00431       unlink
($ftmp3) ;
00432       unlink
($ftmp4) ;
00433     
00434     } # function decritQT
00435     
00436     ###############################################################################
00437     
00438     function 
decritQL_Sql($baseQL,$tableQL,$titreQL,$tabQL,$tmodaQL) {
00439     
00440     ###############################################################################
00441     
00442     
# fin function decritQT_Sql
00443     
00444     ###############################################################################
00445     ###############################################################################
00446     
00447     function 
decritQX($titreQX,$txtQX,$lang="FR",$histopct="no") {
00448     
00449     ###############################################################################
00450     
00451       if (
$lang=="FR") {
00452          h2
("Analyse QX de la variable textuelle $titreQX") ;
00453       } else {
00454          h2
("Analysis of the textual variable '$titreQX'") ;
00455       } ; # fin de si
00456     
00457       $minu 
;
00458       if ($lang
=="FR") {
00459          echo '<h3>Texte analys&eacute;' 
;
00460       } else {
00461          echo '<h3>Analysed text' 
;
00462       } ; # fin de si
00463       nbsp
(2) ;
00464       ## if ($minu==1) { echo '<font size="-1">(apr&egrave;s conversion en minuscules)</font>' ; } ;
00465       echo 
'</h3>' ;
00466     
00467       div
() ;
00468       echo '<textarea name="mat" rows="8" cols="80" class="fond_jaune">' 
;
00469       echo "\n" 
;
00470     
00471       $tta 
$txtQX # transfert du texte
00472       $tta 
strtr($tta"\\"," ") ;
00473       $tta 
str_replace(" '","'",$tta) ;
00474       $tta 
str_replace(" -- "," ",$tta) ;
00475     
00476       if ($minu
==1) { $tta strtolower($tta) ; } ;
00477       echo $tta 
;
00478     
00479       echo '</textarea>' 
;
00480       findiv
() ;
00481     
00482       $tta 
urldecode($tta) ;
00483       $tta 
strtr($tta",.;()&\"\n'\\:?","            ") ;
00484     
00485       $tabmot 
split(" ",$tta)   ;
00486       $nbmd   
count$tabmot )  ;
00487       $nbm    
;
00488       $dico   
= array() ; # pour php 4.x
00489     
00490       # premier passage, on met 0 &agrave; tout le monde
00491     
00492       $vnbmd 
;
00493       for ($im 
$im $nbmd $im++) {
00494         $mot 
trim($tabmot$im ])  ;
00495         if (strlen
($mot)>0) {
00496       #echo " mot $im soit $mot \n<br>" ;
00497            $dico
[$mot] = ;
00498            $vnbmd
++ ;
00499         } ; # fin de si
00500       } ; 
# fin de pour im
00501     
00502       # premier passage, on met 0 &agrave; tout le monde
00503     
00504       for (
$im $im $nbmd $im++) {
00505         $mot 
trim($tabmot$im ])  ;
00506         if (strlen
($mot)>0) {
00507            $dico
[$mot] = $dico[$mot] + ;
00508            # si valeur 1, il s'agit d'un mot diff&eacute;rent
00509            if (
$dico[$mot] == 1) {
00510                $nbm
++ ;
00511       #echo " mot $im soit $mot donc nbm $nbm\n<br>" ;
00512            } ; 
# fin de si
00513         } ; 
# fin de si
00514       } ; 
# fin de pour im
00515     
00516       p
() ;
00517       if ($lang
=="FR") {
00518         echo "Dans le texte il y a sans doute 
$vnbmd mots en tout et $nbm mots diff&eacute;rents ;\n<br /> " ;
00519       } else {
00520         echo "In this text there are probably 
$vnbmd words on the whole and $nbm distinct words;\n<br /> " ;
00521       } ; # fin de si
00522       if (
$nbm>0) {
00523          $nbf 
$nbmd/$nbm ;
00524          $nbf 
sprintf("%5.2f",$nbf) ;
00525          if ($lang
=="FR") {
00526             echo " chaque mot est donc r&eacute;p&eacute;t&eacute; 
$nbf fois en moyenne.\n" ;
00527          } else {
00528             echo " each word is therefore repeated 
$nbf times on the average.\n" ;
00529          } ; # fin de si
00530       }
00531       finp
() ;
00532     
00533       table
() ;
00534       tr
() ;
00535     
00536       td
() ;
00537       p
() ;
00538       if ($lang
=="FR") {
00539          echo '<b>Dictionnaire alphab&eacute;tique</b>' 
;
00540       } else {
00541          echo '<b>Alphabetical dictionnary</b>' 
;
00542       } ; # fin de si
00543       finp
() ;
00544       echo '<textarea name="mat" rows="15" cols="50" class="fond_jaune">' 
;
00545       $dicNom 
$dico ;
00546       ksort
($dicNom) ;
00547       reset
($dicNom) ;
00548     
00549       $lcnt 
"" ;
00550       $lnom 
"" ;
00551       foreach ($dicNom 
as  $ind=>$cnt) {
00552       #for(reset($dicNom); $ind = key($dicNom); next($dicNom)) {
00553           $mnd 
$ind ;
00554           if (strlen
($mnd)>30) {
00555              $mnd 
substr($ind,0,29) ;
00556           } ;
00557           echo "  "
.sprintf("%-30s",$mnd)."  ".sprintf("%7d",$cnt)."\n";
00558           $lcnt 
.= $cnt."_" ;
00559           $lnom 
.= $ind."_" ;
00560       } ; # fin pour
00561       if (
substr($lcnt,strlen($lcnt)-1,1)=="_") {
00562         $lcnt 
substr($lcnt,0,strlen($lcnt)-1)  ;
00563       } ; # fin si
00564       if (
substr($lnom,strlen($lnom)-1,1)=="_") {
00565         $lnom 
substr($lnom,0,strlen($lnom)-1)  ;
00566       } ; # fin si
00567     
00568       echo 
'</textarea>' ;
00569       fintd
() ;
00570     
00571       td
() ; nbsp(3) ; fintd() ;
00572     
00573       td
() ;
00574       p
() ;
00575       if ($lang
=="FR") {
00576         echo '<b>Dictionnaire par occurences</b>' 
;
00577       } else {
00578         echo '<b>Occurences dictionnary</b>' 
;
00579       } ; # fin de si
00580       finp
() ;
00581       echo '<textarea name="mat" rows="15" cols="50" class="fond_jaune">' 
;
00582       $dicOcc 
$dico ;
00583       arsort
($dicOcc) ;
00584       reset
($dicOcc) ;
00585     
00586       #for(reset($dicOcc); $ind = key($dicOcc); next($dicOcc)) {
00587       foreach (
$dicOcc as  $ind=>$cnt) {
00588       #for(reset($dicNom); $ind = key($dicNom); next($dicNom)) {
00589           $mnd 
$ind ;
00590           if (strlen
($mnd)>30) {
00591              $mnd 
substr($ind,0,29) ;
00592           } ;
00593           echo "  "
.sprintf("%-30s",$mnd)."  ".sprintf("%7d",$cnt)."\n";
00594       } ; # fin pour
00595     
00596       echo 
'</textarea>' ;
00597       fintd
() ;
00598     
00599       fintr
() ;
00600       fintable
() ;
00601     
00602       # si le paramètre $histopct ne vaut pas "no"
00603       # on fait un histogramme du dico alphabétique
00604     
00605       if (
$histopct!="no") {
00606     
00607       p
() ;
00608       echo "<b>Frequency histogram</b>" 
;
00609       br
() ;
00610       nbsp
() ;
00611       br
() ;
00612       $url 
"../jphistopct.php?vdata=$lcnt&amp;xmrks=$lnom&amp;titr=&amp;tailx=800" ;
00613       echo "<img src='
$url' alt='histogramme' />\n" ;
00614       finp
() ;
00615     
00616       } ; # fin si
00617     
00618     
# fin function decritQX
00619     
00620     ###############################################################################
00621     
00622     function 
decritQX_Sql($titreQX,$tableSQL,$champQX,$conditions="",$lang="FR",$histopct="no",$cusm=0) {
00623     
00624     ###############################################################################
00625     
00626     # exemples : decritQX_Sql("leadata","TISSUE TYPE","devstage") ;
00627     #            decritQX_Sql("leadata","TISSUE TYPE","devstage","","EN","no",1)
00628     
00629     
00630       # remarques : on suppose la connexion SQL faite
00631       #             $tableSQL peut contenir plusieurs noms
00632       #             et meme du code SQL tant que cela va dans la partie FROM
00633       # le dernier paramètre considère tout le champ comme un seul mot
00634     
00635       # extraction des données
00636     
00637       $lestablesSQL 
str_replace("+",",",$tableSQL) ;
00638     
00639       $qry  
" SELECT $champQX FROM $lestablesSQL  $conditions "  ;
00640     #echo"<pre>$qry</pre>\n" ;
00641       $rdq 
mysql_query($qry) ;
00642       $numlig 
= - ;
00643       $letexte 
"" ;
00644       $numlig 
= -;
00645       while ($tdr
=mysql_fetch_array($rdq)) {
00646         $numlig
++ ;
00647         $vdc 
=  trim($tdr[$champQX]) ; # contenu original du champ
00648         if (
$cusm==1) {
00649             $vdc 
str_replace(" ","_",$vdc) ;
00650             $vdc 
str_replace(".","_",$vdc) ;
00651             $vdc 
str_replace("'","_",$vdc) ;
00652             $vdc 
str_replace("-","_",$vdc) ;
00653         } ; # fin de si
00654         $letexte 
.= $vdc." " ;
00655       } ; # fin de tant que
00656     
00657       # construction des dictionnaires
00658     
00659       decritQX
($titreQX,$letexte,$lang,$histopct) ;
00660     
00661     } # fin function decritQX_Sql($titreQX,$tabQX) {
00662     
00663     ###############################################################################
00664     
00665     function 
execute_R($tabCmd,$dbgExt=1) {
00666     
00667     ###############################################################################
00668     
00669     # ceci permet d'exécuter un fichier R quelconque et d'afficher ses résultats
00670     # (entre STAT_DEB et STAT_FIN)
00671     # voir par exemple vd.php ou progstat.php pour des exemples d'utilisation
00672     # comme ci-dessous :
00673     
00674     /*
00675     
00676     # calculs stat via execute_R de statuno.php
00677     
00678     $tcmdR = array() ;
00679     $nbcmd = -1 ;
00680     
00681     $nbcmd++ ; $tcmdR[$nbcmd] = "  source(\"statgh.r\",encoding='latin1') \n" ;
00682     $nbcmd++ ; $tcmdR[$nbcmd] = "  lesd <- read.table(\"$ficdat\") \n" ;
00683     $nbcmd++ ; $tcmdR[$nbcmd] = "  attach(lesd) \n" ;
00684     $nbcmd++ ; $tcmdR[$nbcmd] = "  vqtGH <- V1\n" ;
00685     $nbcmd++ ; $tcmdR[$nbcmd] = "  cat(\"STAT_DEB\n\")\n" ;
00686     #$nbcmd++ ; $tcmdR[$nbcmd] = "  cat(\"\nVoici vos données: \")\n" ;
00687     #$nbcmd++ ; $tcmdR[$nbcmd] = "  print(vqtGH) \n" ;
00688     #$nbcmd++ ; $tcmdR[$nbcmd] = "  cat(\"et leur analyse: \")\n" ;
00689     $nbcmd++ ; $tcmdR[$nbcmd] = "  dtQT(\"DataWeb\",vqtGH,\"$uni\",TRUE,\"$png1\",\"$png2\") \n" ;
00690     $nbcmd++ ; $tcmdR[$nbcmd] = "  cat(\"STAT_FIN\n\")\n" ;
00691     
00692     if ($dbg==1) {
00693       p() ;
00694        echo " on utilise la fonction ".b("execute_R()")." avec comme paramètre le tableau suivant&nbsp;" ;
00695       finp() ;
00696       pre() ;
00697         print_r($tcmdR) ;
00698       finpre() ;
00699     } ; # fin si
00700     
00701     pre() ;
00702       execute_R($tcmdR,$dbg) ; # la fonction execute_R est dans statuno.php
00703     finpre() ;
00704     
00705     */
00706     
00707       $dbgR 
# 0 en mode normal, 1 pour debug
00708       if (
$dbgExt==1) { $dbgR ; } ;
00709     
00710       $ftmp2 
tempnam("/tmp","statuno_calculs.r")   ; # programme R
00711       $ftmp3 
tempnam("/tmp","statuno_calcstats.r") ; # pour "sourcer" le programme
00712       $ftmp4 
tempnam("/tmp","statuno_calculs.sor") ; # sorties du programme R
00713     
00714       # transfert des commandes R dans le fichier tmp2
00715     
00716       if (
$fh fopen($ftmp2,"w")) {
00717            # pre() ;
00718            $nblc 
count($tabCmd) ;
00719            for  ($idlc
=0$idlc<$nblc;$idlc++) {
00720                 if (isset($tabCmd
[$idlc])) {
00721                    $ligc 
$tabCmd[$idlc]."\n" ;
00722                    if ($dbgR
==1) {
00723                       echo $ligc 
;
00724                    } ; # fin si
00725                    fputs
($fh$ligc) ;
00726                 } ; # fin si
00727            } ; 
# fin pour chaque
00728            # finpre() ;
00729            fclose
($fh) ;
00730           # print "<pre> fichier $ftmp1 ok sans doute \n</pre>" ;
00731       } else {
00732         print "<pre> pb  avec 
$ftmp2 \n</pre>" ;
00733         return(""
) ;
00734       } ; # fin de si
00735     
00736       # afin de simplifier les affichages, on ne met que source
00737       # dans le fichier tmp3 qui sera ex&eacute;cut&eacute; :
00738     
00739       if (
$fh fopen($ftmp3,"w")) {
00740          $ligs 
"  source(\"$ftmp2\",encoding='latin1') \n ";
00741          if ($dbgR
==1) {
00742             $ligs 
"  source(\"$ftmp2\",print.eval=TRUE,echo=TRUE,encoding='latin1') \n ";
00743          } ; # fin de si
00744          fputs
($fh$ligs) ;
00745          fclose
($fh) ;
00746          # print "<pre> fichier $ftmp3 ok sans doute \n</pre>" ;
00747       } else {
00748         print "<pre> pb  avec 
$ftmp3 \n</pre>" ;
00749       } ; # fin de si
00750     
00751       # ex&eacute;cution standard de R avec redirection
00752     
00753       unlink
($ftmp4) ;
00754       $cmd 
"R --quiet --no-save < $ftmp3 > $ftmp4  2>> $ftmp4 " ;
00755       if ($dbgR
==1) {
00756           $cmd 
"R --quiet --no-save < $ftmp3 > $ftmp4  2>> $ftmp4 " ;
00757       } ; # fin si
00758     
00759       # si cela ne marche pas, essayer : $cmd = "R --quiet --vanilla < $ftmp3 " ;
00760     
00761       if (
$dbgR==1) {
00762     
00763          echo b
("$cmd") ;
00764     
00765          system
("head $ftmp2") ;
00766          system
("head $ftmp3") ;
00767     
00768       } ; # fin si
00769     
00770       system
($cmd) ;
00771       if ($dbgR
==1) {
00772          system
("head $ftmp4") ;
00773       } ; # fin si
00774     
00775       # filtrage des r&eacute;sultats et affichage
00776     
00777       clearstatcache
();
00778       if ($fh 
fopen($ftmp4,"r")) {
00779            $ok 
;
00780            while (!feof 
($fh)) {
00781              $lig 
fgets($fh4096) ;
00782     # quelques nettoyages
00783              if (
strpos($lig,"vous pouvez utiliser")>-1) { $lig "" ; } ;
00784              if (strpos
($lig,"The decimal point is")>-1) { $lig "" ; } ;
00785              if (strpos
($lig,"la moyenne est en rouge")>-1) { $lig "" ; } ;
00786     
00787       #if ($dbgr == 1) { print "<pre>  on voit $ligs dans $ftmp4 </pre>"; } ;
00788              if (
$lig == "STAT_FIN\n") { $ok ; } ;
00789              if ($ok
==1) { echo "  $lig " ; } ;
00790              if ($lig 
== "STAT_DEB\n") { $ok ; } ;
00791            } ; # fin tant que
00792            fclose
($fh) ;
00793       } else {
00794         print "<pre> pas de valeurs pour 
$ftmp4 </pre>" ;
00795       } ; # fin de si
00796     
00797       print 
"\n" ;
00798       flush
() ;
00799     
00800       # nettoyage des fichiers
00801     
00802       if (
$dbgR==1) {
00803          unlink
($ftmp2) ;
00804          unlink
($ftmp3) ;
00805          unlink
($ftmp4) ;
00806       } ; # fin si
00807     
00808     
# fin function execute_R
00809     
00810     ###############################################################################
00811     ###############################################################################
00812     
00813     function 
fonction_R($txt) {
00814     
00815     ###############################################################################
00816     
00817     # exécute une fonction R et renvoie la valeur résultat
00818     
00819       $dbgR 
# 0 en mode normal, 1 pour debug
00820     
00821       if (
$dbgR==1) { pre() ; } ;
00822     
00823       $ftmp2 
tempnam("/tmp","statuno_calculs.r")   ; # programme R
00824       $ftmp3 
tempnam("/tmp","statuno_calcstats.r") ; # pour "sourcer" le programme
00825       $ftmp4 
tempnam("/tmp","statuno_calculs.sor") ; # sorties du programme R
00826     
00827       # transfert des commandes R dans le fichier tmp2
00828     
00829       if (
$fh fopen($ftmp2,"w")) {
00830            fputs
($fh"source(\"statgh.r\") ; " ) ;
00831            fputs
($fh"cat(\"STAT_DEB\",\"\\n\") ; " ) ;
00832            fputs
($fh"cat( $txt ,\"\\n\") ; " ) ;
00833            fputs
($fh"cat(\"STAT_FIN\",\"\\n\") ; " ) ;
00834            fclose
($fh) ;
00835            if ($dbgR
==1) { finpre() ; } ;
00836           # print "<pre> fichier $ftmp1 ok sans doute \n</pre>" ;
00837       } else {
00838         print "<pre> pb  avec 
$ftmp2 \n</pre>" ;
00839         return(""
) ;
00840       } ; # fin de si
00841     
00842       # afin de simplifier les affichages, on ne met que source
00843       # dans le fichier tmp3 qui sera ex&eacute;cut&eacute; :
00844     
00845       if (
$fh fopen($ftmp3,"w")) {
00846          $ligs 
"  source(\"$ftmp2\") \n ";
00847          fputs
($fh$ligs) ;
00848          fclose
($fh) ;
00849          # print "<pre> fichier $ftmp3 ok sans doute \n</pre>" ;
00850       } else {
00851         print "<pre> pb  avec 
$ftmp3 \n</pre>" ;
00852       } ; # fin de si
00853     
00854       # ex&eacute;cution standard de R avec redirection
00855     
00856       unlink
($ftmp4) ;
00857       $cmd 
"R --quiet --vanilla --encoding=latin1 < $ftmp3 > $ftmp4  2>> $ftmp4 " ;
00858       # si cela ne marche pas, essayer : $cmd = "R --quiet --vanilla < $ftmp3 " ;
00859     
00860       if (
$dbgR==1) {
00861     
00862          h3
("$cmd") ;
00863          pre
() ;
00864          system
("head $ftmp2") ;
00865          system
("head $ftmp3") ;
00866          finpre
() ;
00867     
00868       } ; # fin si
00869     
00870       system
($cmd) ;
00871       if ($dbgR
==1) {
00872          system
("head $ftmp4") ;
00873       } ; # fin si
00874     
00875       # filtrage des r&eacute;sultats et affichage
00876     
00877       clearstatcache
();
00878       if ($fh 
fopen($ftmp4,"r")) {
00879            $ok 
;
00880            while (!feof 
($fh)) {
00881              $lig 
fgets($fh4096) ;
00882              $lig 
trim(strtr($lig,"\n"," ")) ;
00883     if ($dbgR 
== 1) { print "<pre>  on voit *$lig* dans $ftmp4 et ok vaut $ok</pre>"; } ;
00884              if ($lig
=="STAT_FIN") { $ok ; } ;
00885              if ($ok
==1) { $ligret $lig ; } ;
00886              if ($lig
=="STAT_DEB") { $ok ; } ;
00887            } ; # fin tant que
00888            fclose
($fh) ;
00889       } else {
00890         print "<pre> pas de valeurs pour 
$ftmp4 </pre>" ;
00891       } ; # fin de si
00892     
00893       print 
"\n" ;
00894       flush
() ;
00895     
00896       # nettoyage des fichiers
00897     
00898       if (
$dbgR==1) {
00899          unlink
($ftmp2) ;
00900          unlink
($ftmp3) ;
00901          unlink
($ftmp4) ;
00902       } ; # fin si
00903     
00904     return(
$ligret) ;
00905     
00906     } # fin function fonction_R
00907     
00908     ###############################################################################
00909     ###############################################################################
00910     
00911     function 
entree_sortie_R($es,$nomfic) {
00912     
00913     ###############################################################
00914     
00915     # écrit le contenu du fichier-paramètre en mode pre, style cadrebleu ou cadrejaune
00916     
00917       if (
$es=="entree") {
00918           pre
("cadrebleu") ;
00919       } else {
00920          pre
("cadrejaune") ;
00921       } ; # fin si
00922     
00923       echo 
"\n" ;
00924     
00925       if (!file_exists
($nomfic)) {
00926          print " fichier 
$nomfic non vu\n" ;
00927       } else {
00928       $fh 
fopen($nomfic,"r") ;
00929       while (!feof 
($fh)) {
00930        $lig 
fgets($fh4096) ;
00931           $lig 
preg_replace("/\n/","",$lig);
00932           $ligs 
"     " ;
00933           $lng  
strlen($lig) ;
00934           $idc 
;
00935           while ($idc
<$lng) {
00936             $cc 
substr($lig,$idc,1) ;
00937             if ($cc
=="<") { $cc "&lt;" ; } ;
00938             if ($cc
==">") { $cc "&gt;" ; } ;
00939             if ($cc
=="&") { $cc "&amp;" ; } ;
00940             $ligs 
.= $cc ;
00941             $idc
++ ;
00942           } ; # fintant que
00943           echo 
$ligs;
00944           nbsp
(5) ;
00945           echo"\n" 
;
00946       } ; # fin tant que
00947       fclose
($fh) ;
00948       } ; # fin si le fichier existe
00949     
00950       finpre
() ;
00951     
00952     } # fin de fonction entree_sortie_R
00953     
00954     ###############################################################
00955     
00956     function 
pre_cadre($nomfic) {
00957     
00958     ###############################################################
00959     
00960     # écrit le contenu du fichier-paramètre en mode pre, style cadre
00961     
00962       pre
("cadre") ;
00963       echo"\n" 
;
00964       if (!file_exists
($nomfic)) {
00965          print " fichier 
$nomfic non vu\n" ;
00966       } else {
00967       $fh 
fopen($nomfic,"r") ;
00968       while (!feof 
($fh)) {
00969        $lig 
fgets($fh4096) ;
00970           $lig 
preg_replace("/\n/","",$lig);
00971           $ligs 
"     " ;
00972           $lng  
strlen($lig) ;
00973           $idc 
;
00974           while ($idc
<$lng) {
00975             $cc 
substr($lig,$idc,1) ;
00976             if ($cc
=="<") { $cc "&lt;" ; } ;
00977             if ($cc
==">") { $cc "&gt;" ; } ;
00978             $ligs 
.= $cc ;
00979             $idc
++ ;
00980           } ; # fintant que
00981           echo 
$ligs ;
00982           nbsp
(5) ;
00983           echo"\n" 
;
00984       } ; # fin tant que
00985       fclose
($fh) ;
00986       } ; # fin si le fichier existe
00987     
00988       finpre
() ;
00989     
00990     } # fin de fonction pre_cadre
00991     
00992     ###############################################################
00993     
00994     function 
entree_R($nomfic) {
00995     
00996     ###############################################################
00997     
00998     # affiche le code source d'un fichier R
00999     
01000       entree_sortie_R
("entree",$nomfic) ;
01001     
01002     } # fin de fonction entree_R
01003     
01004     ###############################################################
01005     
01006     function 
sortie_R($nomfic) {
01007     
01008     ###############################################################
01009     
01010     # affiche le résutat d'exécution d'un fichier R
01011     
01012       entree_sortie_R
("sortie",$nomfic) ;
01013     
01014     } # fin de fonction sortie_R
01015     
01016     ###############################################################
01017     
01018     function 
graphe_R($nomfic,$taille=400) {
01019     
01020     ###############################################################
01021     
01022     # appel de graphique_R_png avec le meme nombre de lettres
01023     # que pour entree_R et sortie_R
01024     
01025     graphique_R_png
($nomfic,$taille) ;
01026     
01027     } # fin de fonction graphe_R
01028     
01029     ###############################################################
01030     
01031     function 
graphique_R_png($nomfic,$taille=400) {
01032     
01033     ###############################################################
01034     
01035     # affiche un graphique-paramètre
01036     
01037      div
("cadrejaune") ;
01038       blockquote
() ;
01039       p
("center") ;
01040           echo href
($nomfic,img($nomfic,$nomfic,$taille)) ;
01041       finp
() ;
01042       finblockquote
() ;
01043       findiv
() ;
01044     
01045     } # fin de fonction graphique_R_png
01046     
01047     ###############################################################
01048     
01049     function 
graphiques_R_png($nomfic1,$nomfic2,$nomfic3="",$nomfic4="",$nomfic5="",$nomfic6="") {
01050     
01051     ###############################################################
01052     
01053       div
("cadrejaune") ;
01054       blockquote
() ;
01055       table
() ;
01056       tr
() ;
01057         td
() ; echo href($nomfic1,img($nomfic1,$nomfic1,"300")) ; fintd() ;
01058         td
() ; p() ; nbsp(10) ; finp() ; fintd() ;
01059         td
() ; echo href($nomfic2,img($nomfic2,$nomfic2,"300")) ; fintd() ;
01060       fintr
() ;
01061       if (!$nomfic3
=="") {
01062            tr
() ;
01063              td
() ; p() ; nbsp(10) ; finp() ; fintd() ;
01064            fintr
() ;
01065            tr
() ;
01066              td
() ; echo href($nomfic3,img($nomfic3,$nomfic3,"300")) ; fintd() ;
01067              td
() ; p() ; nbsp(10) ; finp() ; fintd() ;
01068              td
() ; if (!$nomfic4=="") { echo href($nomfic4,img($nomfic4,$nomfic4,"300")) ; } ; fintd() ;
01069            fintr
() ;
01070            if (!$nomfic5
=="") {
01071                 tr
() ;
01072                   td
() ; p() ; nbsp(10) ; finp() ; fintd() ;
01073                 fintr
() ;
01074                 tr
() ;
01075                   td
() ; echo href($nomfic5,img($nomfic5,$nomfic5,"300")) ; fintd() ;
01076                   td
() ; p() ; nbsp(10) ; finp() ; fintd() ;
01077                   td
() ; echo href($nomfic6,img($nomfic6,$nomfic6,"300")) ; fintd() ;
01078                 fintr
() ;
01079            } ; # fin si
01080       } ; 
# fin si
01081       fintable
() ;
01082       finblockquote
() ;
01083       findiv
() ;
01084     
01085     } # fin de fonction graphiques_R_png
01086     
01087     ###############################################################
01088     
01089     function 
DeuxGraphiquesEn_R_png($nomfic1,$nomfic2) {
01090     
01091     ###############################################################
01092     
01093       blockquote
() ;
01094       table
() ;
01095       tr
() ;
01096         td
() ;
01097           nbsp
(20) ;
01098         fintd
() ;
01099         td
() ; echo href($nomfic1,img($nomfic1,$nomfic1,"300")) ; fintd() ;
01100         td
() ; p() ; nbsp(10) ; finp() ; fintd() ;
01101         td
() ; echo href($nomfic2,img($nomfic2,$nomfic2,"300")) ; fintd() ;
01102       fintr
() ;
01103       fintable
() ;
01104       finblockquote
() ;
01105     
01106     } # fin de fonction DeuxGraphiquesEn_R_png
01107     
01108     ###############################################################
01109     
01110     function 
TroisGraphiquesEn_R_png($nomfic1,$nomfic2,$nomfic3) {
01111     
01112     ###############################################################
01113     
01114       blockquote
() ;
01115       table
() ;
01116       tr
() ;
01117         td
() ; echo href($nomfic1,img($nomfic1,$nomfic1,"300")) ; fintd() ;
01118         td
() ; p() ; nbsp(10) ; finp() ; fintd() ;
01119         td
() ; echo href($nomfic2,img($nomfic2,$nomfic2,"300")) ; fintd() ;
01120         td
() ; p() ; nbsp(10) ; finp() ; fintd() ;
01121         td
() ; echo href($nomfic3,img($nomfic3,$nomfic3,"300")) ; fintd() ;
01122       fintr
() ;
01123       fintable
() ;
01124       finblockquote
() ;
01125     
01126     } # fin de fonction TroisGraphiquesEn_R_png
01127     
01128     ###############################################################
01129     
01130     function 
sixGraphiquesEn_R_png($nomfic1,$nomfic2,$nomfic3,$nomfic4,$nomfic5,$nomfic6) {
01131     
01132     ###############################################################
01133     
01134       div
("cadrejaune") ;
01135       blockquote
() ;
01136       table
() ;
01137       tr
() ;
01138         td
() ; echo href($nomfic1,img($nomfic1,$nomfic1,"300")) ; fintd() ;
01139         td
() ; p() ; nbsp(10) ; finp() ; fintd() ;
01140         td
() ; echo href($nomfic2,img($nomfic2,$nomfic2,"300")) ; fintd() ;
01141       fintr
() ;
01142       tr
() ;
01143         td
("C","",3) ; nbsp() ; fintd() ;
01144       fintr
() ;
01145       tr
() ;
01146         td
("C","",3) ; echo href($nomfic3,img($nomfic3,$nomfic3,"300")) ; fintd() ;
01147       fintr
() ;
01148       fintable
() ;
01149       finblockquote
() ;
01150       findiv
() ;
01151     
01152     } # fin de fonction TroisGraphiquesEn_R_png
01153     
01154     ###############################################################
01155     
01156     function 
execute_Sweave($tabCmd) {
01157     
01158     ###############################################################
01159     
01160     # not yet !
01161     
01162     
# fin de fonction execute_Sweave
01163     
01164     
01165     ?>

Pour ne pas voir les numéros de ligne, ajoutez &nl=non à la suite du nom du fichier.

 

 

retour gH    Retour à la page principale de   (gH)