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ées issues de mysql utilisé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é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é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 # é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écuté :
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é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ésultats et affichage
00221
00222 pre() ;
00223 print "\n" ;
00224 clearstatcache();
00225 if ($fh = fopen($ftmp4,"r")) {
00226 $ok = 0 ;
00227 while (!feof ($fh)) {
00228 $lig = fgets($fh, 4096) ;
00229 ## print "<pre> on voit $ligs dans $ftmp4 </pre>";
00230 if ($lig == "STAT_FIN\n") { $ok = 0 ; } ;
00231 if ($ok==1) { echo " $lig " ; } ;
00232 if ($lig == "STAT_DEB\n") { $ok = 1 ; } ;
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 = -1 ;
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ées issues de mysql utilisé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é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é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 # é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écuté :
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é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ésultats et affichage
00401
00402 pre() ;
00403 print "\n" ;
00404 clearstatcache();
00405 if ($fh = fopen($ftmp4,"r")) {
00406 $ok = 0 ;
00407 while (!feof ($fh)) {
00408 $lig = fgets($fh, 4096) ;
00409 #if ($dbgr == 1) { print "<pre> on voit $ligs dans $ftmp4 </pre>"; } ;
00410 if ($lig == "STAT_FIN\n") { $ok = 0 ; } ;
00411 if ($ok==1) { echo " $lig " ; } ;
00412 if ($lig == "STAT_DEB\n") { $ok = 1 ; } ;
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 = 1 ;
00458 if ($lang=="FR") {
00459 echo '<h3>Texte analysé' ;
00460 } else {
00461 echo '<h3>Analysed text' ;
00462 } ; # fin de si
00463 nbsp(2) ;
00464 ## if ($minu==1) { echo '<font size="-1">(aprè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 = 0 ;
00488 $dico = array() ; # pour php 4.x
00489
00490 # premier passage, on met 0 à tout le monde
00491
00492 $vnbmd = 0 ;
00493 for ($im = 0 ; $im < $nbmd ; $im++) {
00494 $mot = trim($tabmot[ $im ]) ;
00495 if (strlen($mot)>0) {
00496 #echo " mot $im soit $mot \n<br>" ;
00497 $dico[$mot] = 0 ;
00498 $vnbmd++ ;
00499 } ; # fin de si
00500 } ; # fin de pour im
00501
00502 # premier passage, on met 0 à tout le monde
00503
00504 for ($im = 0 ; $im < $nbmd ; $im++) {
00505 $mot = trim($tabmot[ $im ]) ;
00506 if (strlen($mot)>0) {
00507 $dico[$mot] = $dico[$mot] + 1 ;
00508 # si valeur 1, il s'agit d'un mot diffé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é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épété $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é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&xmrks=$lnom&titr=&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 = - 1 ;
00643 $letexte = "" ;
00644 $numlig = -1 ;
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 " ;
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 ; # 0 en mode normal, 1 pour debug
00708 if ($dbgExt==1) { $dbgR = 1 ; } ;
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écuté :
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é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ésultats et affichage
00776
00777 clearstatcache();
00778 if ($fh = fopen($ftmp4,"r")) {
00779 $ok = 0 ;
00780 while (!feof ($fh)) {
00781 $lig = fgets($fh, 4096) ;
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 = 0 ; } ;
00789 if ($ok==1) { echo " $lig " ; } ;
00790 if ($lig == "STAT_DEB\n") { $ok = 1 ; } ;
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 ; # 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écuté :
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é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ésultats et affichage
00876
00877 clearstatcache();
00878 if ($fh = fopen($ftmp4,"r")) {
00879 $ok = 0 ;
00880 while (!feof ($fh)) {
00881 $lig = fgets($fh, 4096) ;
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 = 0 ; } ;
00885 if ($ok==1) { $ligret = $lig ; } ;
00886 if ($lig=="STAT_DEB") { $ok = 1 ; } ;
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($fh, 4096) ;
00931 $lig = preg_replace("/\n/","",$lig);
00932 $ligs = " " ;
00933 $lng = strlen($lig) ;
00934 $idc = 0 ;
00935 while ($idc<$lng) {
00936 $cc = substr($lig,$idc,1) ;
00937 if ($cc=="<") { $cc = "<" ; } ;
00938 if ($cc==">") { $cc = ">" ; } ;
00939 if ($cc=="&") { $cc = "&" ; } ;
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($fh, 4096) ;
00970 $lig = preg_replace("/\n/","",$lig);
00971 $ligs = " " ;
00972 $lng = strlen($lig) ;
00973 $idc = 0 ;
00974 while ($idc<$lng) {
00975 $cc = substr($lig,$idc,1) ;
00976 if ($cc=="<") { $cc = "<" ; } ;
00977 if ($cc==">") { $cc = ">" ; } ;
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 ?>
La coloration syntaxique est réalisée par un enrobage de la function php nommée highlight_file
mais si vous préférez, vous pouvez utiliser celle de SyntaxHighlighter ou même celle de geshi.
Pour ne pas voir les numéros de ligne, ajoutez &nl=non à la suite du nom du fichier.
Retour à la page principale de (gH)