Listing du fichier statuno.php avec syntaxhighlighter
<?php
error_reporting(E_ALL | E_NOTICE) ;
# (gH) -_- statuno.php ; TimeStamp (unix) : 24 Octobre 2011 vers 09:18
include_once("std7.php") ;
$versionStatuno = 3.35 ;
# version 3.35 : ajout de echo"\n" pour entree_R et sortie_R
# version 3.33 : ajout de source("statgh.r") dans fonction execute_R
# version 3.31 : fonction execute_R pour calcstat/aqt_det.php (voir vers ligne 580)
# version 3.29 : fonctions entree_sortie_R entree_R sortie_R graphique_R_png
# pour gérer les TD de biostat MasterTPV et EDA
# version 3.27 : fonction_R() permet de renvoyer une seule valeur par
# l'appel de la fonction R correspondante
# version 3.25 : on peut mettre plusieurs tables MYSQL concaténées par des +
# les + sont convertis en virgules et le tour est joué
###############################################################
function statgh($nomf="",$cla="orange_stim") {
###############################################################
if ($nomf=="") {
return(href("../statghfns.php","statgh.r")) ;
} else {
return(href("../statghfns.php?lafns=$nomf","$nomf()",$cla)) ;
} # finsi
} # fin de fonction statgh
###############################################################
function hrr($nomf,$package="base",$cla="orange_stim") {
###############################################################
# renvoie le lien sur finzi pour la fonction
# exemple d'utilisation :
# echo href(hrr("mode"),"storage.mode()").". " ;
return("http://finzi.psych.upenn.edu/R/library/$package/html/$nomf".".html") ;
} # fin de fonction hrr
###############################################################
function hrrr($nomf,$package="base",$nomh="",$cla="gvert") {
###############################################################
# renvoie le lien sur finzi pour la fonction
# avec un nom différent dans le lien, si besoin est
# exemple d'utilisation :
# echo hrrr("class") ;
# echo hrrr("nrow","base","ncol","gvert").". " ; # car ncol est référencé dans la page de nrow
if ($package=="") {
$package = "base" ;
} # fin si
if ($nomh=="") {
$nomh = $nomf."()" ;
} # fin si
return(href(hrr($nomf,$package),$nomh,$cla)) ;
} # fin de fonction hrrr
###############################################################
function hrrp($package="base",$nomp="",$cla="gbleuf") {
###############################################################
# renvoie le lien sur finzi pour le package
# avec un nom différent dans le lien, si besoin est
# exemple d'utilisation :
# echo hrrr("phyloseq") ;
# echo hrrr("nrow","base","ncol","gvert").". " ; # car ncol est référencé dans la page de nrow
if ($package=="") {
$package = "base" ;
} # fin si
if ($nomp=="") {
$nomp = $package ;
} # fin si
return(href(hrr("00Index",$package),$nomp,$cla)) ;
} # fin de fonction hrrp
###############################################################################
###############################################################################
function decritQT($titreQT,$tabQT,$uniteQT="?",$lang="FR",$grf="") {
###############################################################################
#
# calcul QT sur un tableau PHP
# voir aussi decritQT_Sql pour calcul QT sur un champ SQL
#
if ($lang=="FR") {
h2("Analyse QT de la variable $titreQT") ;
} else {
h2("Analysis of the variable '$titreQT'") ;
} ; # fin de si
if (count($tabQT)==0) {
h3(" no data found.") ;
} ; # fin de si
$ftmp1 = tempnam("/tmp","statuno_data.tmp") ; # fichier des données issues de mysql utilisées par R
$ftmp2 = tempnam("/tmp","statuno_calculs.r") ; # programme R
$ftmp3 = tempnam("/tmp","statuno_calcstats.r") ; # pour "sourcer" le programme
$ftmp4 = tempnam("/tmp","statuno_calculs.sor") ; # sorties du programme R
# transfert des données du tableau $tabQT dans le fichier tmp1
if ($fh = fopen($ftmp1,"w")) {
# pre() ;
$nbvQT = count($tabQT) ;
for ($idvQT=0; $idvQT<$nbvQT;$idvQT++) {
$ligs = $tabQT[$idvQT]."\n" ;
## echo $ligs ;
fputs($fh, $ligs) ;
} ; # fin pour chaque
# finpre() ;
fclose($fh) ;
## print "<pre> fichier $ftmp1 ok sans doute \n</pre>" ;
} else {
print "<pre> pb avec $ftmp1 \n</pre>" ;
return("") ;
} ; # fin de si
# préparation des commandes R, on lit dans phpmp1
$cmdr = "" ;
$cmdr .= " source(\"../statgh.r\",echo=TRUE) \n" ;
$cmdr .= " \n" ;
$cmdr .= " alldata <- read.table(\"$ftmp1\") \n" ;
$cmdr .= " \n" ;
$cmdr .= " valQT <- alldata[,1] \n" ;
$cmdr .= " \n" ;
$cmdr .= " cat(\"STAT_DEB\\n\") ; \n" ;
$cmdr .= " cat(\"\\n\") \n" ;
$cmdr .= " \n" ;
$cmdr .= " decritQT(\"$titreQT\",valQT,\"$uniteQT\") \n" ;
$cmdr .= " \n" ;
$cmdr .= " cat(\"\\n\") \n" ;
if ($lang=="FR") {
$cmdr .= " cat(\"DIAGRAMME TIGE-FEUILLES\") \n" ;
} else {
$cmdr .= " cat(\"STEM and LEAF DIAGRAM\") \n" ;
} ; # fin de si
$cmdr .= " cat(\"\\n\") \n" ;
$cmdr .= " stem(valQT,width=130) \n" ;
$cmdr .= " cat(\"\\n\") \n" ;
$cmdr .= " cat(\"STAT_FIN\\n\") ; \n" ;
## print "<pre> CMD = $cmdr \n\n</pre>" ;
# écriture des commandes R dans le fichier ftmp2
if ($fh = fopen($ftmp2,"w")) {
fputs($fh, $cmdr) ;
fclose($fh) ;
# print "<pre> fichier $ftmp2 ok sans doute \n</pre>" ;
} else {
print "<pre> pb avec $ftmp2 \n</pre>" ;
} ; # fin de si
# afin de simplifier les affichages, on ne met que source
# dans le fichier tmp3 qui sera exécuté :
if ($fh = fopen($ftmp3,"w")) {
$ligs = " source(\"$ftmp2\",echo=FALSE) \n ";
fputs($fh, $ligs) ;
fclose($fh) ;
# print "<pre> fichier $ftmp3 ok sans doute \n</pre>" ;
} else {
print "<pre> pb avec $ftmp3 \n</pre>" ;
} ; # fin de si
# exécution standard de R avec redirection
unlink($ftmp4) ;
/*
pre() ;
system("head $ftmp1") ;
system("head $ftmp2") ;
system("head $ftmp3") ;
finpre() ;
*/
$cmd = "R --quiet --vanilla < $ftmp3 > $ftmp4 2> $ftmp4 " ;
## h3("$cmd") ;
# si cela ne marche pas, essayer : $cmd = "R --quiet --vanilla < $ftmp3 " ;
system($cmd) ;
# system("head $ftmp4") ;
# filtrage des résultats et affichage
pre() ;
print "\n" ;
clearstatcache();
if ($fh = fopen($ftmp4,"r")) {
$ok = 0 ;
while (!feof ($fh)) {
$lig = fgets($fh, 4096) ;
## print "<pre> on voit $ligs dans $ftmp4 </pre>";
if ($lig == "STAT_FIN\n") { $ok = 0 ; } ;
if ($ok==1) { echo " $lig " ; } ;
if ($lig == "STAT_DEB\n") { $ok = 1 ; } ;
} ; # fin tant que
fclose($fh) ;
} else {
print "<pre> pas de valeurs pour $ftmp4 </pre>" ;
} ; # fin de si
print "\n" ;
finpre() ;
flush() ;
#$cmd = "perl alng.pl LNG $tmp1 $tmp3" ;
#print("<pre> $cmd \n</pre>") ;
#
#system("$cmd ") ;
#calcstat_en_R($tmp1,$tmp2) ;
unlink($ftmp1) ;
unlink($ftmp2) ;
unlink($ftmp3) ;
unlink($ftmp4) ;
# tracé via jpgrah
if (!$grf=="") {
sort($tabQT) ;
$ydval = "" ;
for ($idvQT=0; $idvQT<$nbvQT;$idvQT++) {
$ydval .= $tabQT[$idvQT] ;
if ($idvQT<$nbvQT-1){ $ydval .= "_" ; } ;
} ; # fin pour chaque
echo "<blockquote>" ;
echo "<p>" ;
echo("<img src='../traceydata.php?ydval=$ydval' alt='graph' />");
echo "</p>" ;
echo "</blockquote>" ;
} ; # fin de si
} # function decritQT
###############################################################################
function decritQT_Sql($titreQT,$uniteQT="?",$tablesSQL,$champSQL,$conditions="",$lang="FR",$grf="") {
###############################################################################
# remarques : on suppose la connexion SQL faite
# $tableSQL peut contenir plusieurs noms
# et meme du code SQL tant que cela va dans la partie FROM
# 1. transfert des données dans un tableau
$lestablesSQL = str_replace("+",",",$tablesSQL) ;
$que = " select $champSQL from $lestablesSQL $conditions " ;
$res = mysql_query($que) ;
$tabQT = array() ;
$indqt = -1 ;
while ($tdr=mysql_fetch_array($res)) {
$indqt++ ;
$tabQT[$indqt] = $tdr[$champSQL] ;
} ; # fin de tant que
## echo "<pre>\n".print_r($tabQT)."\n</pre>\n" ;
# 2. appel de la fonction decritQT($titreQT,$tabQT,$uniteQT="?")
decritQT($titreQT,$tabQT,$uniteQT,$lang,$grf) ;
} # fin function decritQT_Sql
###############################################################################
###############################################################################
function decritQL($titreQL,$tabQL,$tmodaQL) {
###############################################################################
h2("Analyse QL de la variable $titreQL") ;
$ftmp1 = tempnam("/tmp","statuno_data.tmp") ; # fichier des données issues de mysql utilisées par R
$ftmp2 = tempnam("/tmp","statuno_calculs.r") ; # programme R
$ftmp3 = tempnam("/tmp","statuno_calcstats.r") ; # pour "sourcer" le programme
$ftmp4 = tempnam("/tmp","statuno_calculs.sor") ; # sorties du programme R
# transfert des données du tableau $tabQT dans le fichier tmp1
if ($fh = fopen($ftmp1,"w")) {
# pre() ;
$nbvQL = count($tabQL) ;
for ($idvQL=0; $idvQL<$nbvQL;$idvQL++) {
$ligs = $tabQL[$idvQL]."\n" ;
## echo $ligs ;
fputs($fh, $ligs) ;
} ; # fin pour chaque
# finpre() ;
fclose($fh) ;
# print "<pre> fichier $ftmp1 ok sans doute \n</pre>" ;
} else {
print "<pre> pb avec $ftmp1 \n</pre>" ;
return("") ;
} ; # fin de si
# préparation des commandes R, on lit dans phpmp1
$cmdr = "" ;
$cmdr .= " source(\"../../statgh.r\",echo=FALSE) \n" ;
$cmdr .= " \n" ;
$cmdr .= " alldata <- read.table(\"$ftmp1\") \n" ;
$cmdr .= " \n" ;
$cmdr .= " valQL <- alldata[,1] \n" ;
$cmdr .= " \n" ;
$cmdr .= " cat(\"STAT_DEB\\n\") ; \n" ;
$cmdr .= " cat(\"\\n\") \n" ;
$cmdr .= " \n" ;
$cmdr .= " decritQL(\"$titreQL\",valQL,\"$tmodaQL\") \n" ;
$cmdr .= " \n" ;
$cmdr .= " cat(\"\\n\") \n" ;
$cmdr .= " cat(\"STAT_FIN\\n\") ; \n" ;
# print "<pre> CMD = $cmdr \n\n</pre>" ;
# écriture des commandes R dans le fichier ftmp2
if ($fh = fopen($ftmp2,"w")) {
fputs($fh, $cmdr) ;
fclose($fh) ;
# print "<pre> fichier $ftmp2 ok sans doute \n</pre>" ;
} else {
print "<pre> pb avec $ftmp2 \n</pre>" ;
} ; # fin de si
# afin de simplifier les affichages, on ne met que source
# dans le fichier tmp3 qui sera exécuté :
if ($fh = fopen($ftmp3,"w")) {
$ligs = " source(\"$ftmp2\") \n ";
fputs($fh, $ligs) ;
fclose($fh) ;
# print "<pre> fichier $ftmp3 ok sans doute \n</pre>" ;
} else {
print "<pre> pb avec $ftmp3 \n</pre>" ;
} ; # fin de si
# exécution standard de R avec redirection
unlink($ftmp4) ;
$cmd = "R --quiet --vanilla < $ftmp3 > $ftmp4 2> $ftmp4 " ;
# si cela ne marche pas, essayer : $cmd = "R --quiet --vanilla < $ftmp3 " ;
/*
h3("$cmd") ;
pre() ;
system("head $ftmp1") ;
system("head $ftmp2") ;
system("head $ftmp3") ;
finpre() ;
*/
system($cmd) ;
# system("head $ftmp4") ;
# filtrage des résultats et affichage
pre() ;
print "\n" ;
clearstatcache();
if ($fh = fopen($ftmp4,"r")) {
$ok = 0 ;
while (!feof ($fh)) {
$lig = fgets($fh, 4096) ;
#if ($dbgr == 1) { print "<pre> on voit $ligs dans $ftmp4 </pre>"; } ;
if ($lig == "STAT_FIN\n") { $ok = 0 ; } ;
if ($ok==1) { echo " $lig " ; } ;
if ($lig == "STAT_DEB\n") { $ok = 1 ; } ;
} ; # fin tant que
fclose($fh) ;
} else {
print "<pre> pas de valeurs pour $ftmp4 </pre>" ;
} ; # fin de si
print "\n" ;
finpre() ;
flush() ;
#$cmd = "perl alng.pl LNG $tmp1 $tmp3" ;
#print("<pre> $cmd \n</pre>") ;
#
#system("$cmd ") ;
#calcstat_en_R($tmp1,$tmp2) ;
unlink($ftmp1) ;
unlink($ftmp2) ;
unlink($ftmp3) ;
unlink($ftmp4) ;
} # function decritQT
###############################################################################
function decritQL_Sql($baseQL,$tableQL,$titreQL,$tabQL,$tmodaQL) {
###############################################################################
} # fin function decritQT_Sql
###############################################################################
###############################################################################
function decritQX($titreQX,$txtQX,$lang="FR",$histopct="no") {
###############################################################################
if ($lang=="FR") {
h2("Analyse QX de la variable textuelle $titreQX") ;
} else {
h2("Analysis of the textual variable '$titreQX'") ;
} ; # fin de si
$minu = 1 ;
if ($lang=="FR") {
echo '<h3>Texte analysé' ;
} else {
echo '<h3>Analysed text' ;
} ; # fin de si
nbsp(2) ;
## if ($minu==1) { echo '<font size="-1">(après conversion en minuscules)</font>' ; } ;
echo '</h3>' ;
div() ;
echo '<textarea name="mat" rows="8" cols="80" class="fond_jaune">' ;
echo "\n" ;
$tta = $txtQX ; # transfert du texte
$tta = strtr($tta, "\\"," ") ;
$tta = str_replace(" '","'",$tta) ;
$tta = str_replace(" -- "," ",$tta) ;
if ($minu==1) { $tta = strtolower($tta) ; } ;
echo $tta ;
echo '</textarea>' ;
findiv() ;
$tta = urldecode($tta) ;
$tta = strtr($tta, ",.;()&\"\n'\\:?"," ") ;
$tabmot = split(" ",$tta) ;
$nbmd = count( $tabmot ) ;
$nbm = 0 ;
$dico = array() ; # pour php 4.x
# premier passage, on met 0 à tout le monde
$vnbmd = 0 ;
for ($im = 0 ; $im < $nbmd ; $im++) {
$mot = trim($tabmot[ $im ]) ;
if (strlen($mot)>0) {
#echo " mot $im soit $mot \n<br>" ;
$dico[$mot] = 0 ;
$vnbmd++ ;
} ; # fin de si
} ; # fin de pour im
# premier passage, on met 0 à tout le monde
for ($im = 0 ; $im < $nbmd ; $im++) {
$mot = trim($tabmot[ $im ]) ;
if (strlen($mot)>0) {
$dico[$mot] = $dico[$mot] + 1 ;
# si valeur 1, il s'agit d'un mot différent
if ($dico[$mot] == 1) {
$nbm++ ;
#echo " mot $im soit $mot donc nbm $nbm\n<br>" ;
} ; # fin de si
} ; # fin de si
} ; # fin de pour im
p() ;
if ($lang=="FR") {
echo "Dans le texte il y a sans doute $vnbmd mots en tout et $nbm mots différents ;\n<br /> " ;
} else {
echo "In this text there are probably $vnbmd words on the whole and $nbm distinct words;\n<br /> " ;
} ; # fin de si
if ($nbm>0) {
$nbf = $nbmd/$nbm ;
$nbf = sprintf("%5.2f",$nbf) ;
if ($lang=="FR") {
echo " chaque mot est donc répété $nbf fois en moyenne.\n" ;
} else {
echo " each word is therefore repeated $nbf times on the average.\n" ;
} ; # fin de si
}
finp() ;
table() ;
tr() ;
td() ;
p() ;
if ($lang=="FR") {
echo '<b>Dictionnaire alphabétique</b>' ;
} else {
echo '<b>Alphabetical dictionnary</b>' ;
} ; # fin de si
finp() ;
echo '<textarea name="mat" rows="15" cols="50" class="fond_jaune">' ;
$dicNom = $dico ;
ksort($dicNom) ;
reset($dicNom) ;
$lcnt = "" ;
$lnom = "" ;
foreach ($dicNom as $ind=>$cnt) {
#for(reset($dicNom); $ind = key($dicNom); next($dicNom)) {
$mnd = $ind ;
if (strlen($mnd)>30) {
$mnd = substr($ind,0,29) ;
} ;
echo " ".sprintf("%-30s",$mnd)." ".sprintf("%7d",$cnt)."\n";
$lcnt .= $cnt."_" ;
$lnom .= $ind."_" ;
} ; # fin pour
if (substr($lcnt,strlen($lcnt)-1,1)=="_") {
$lcnt = substr($lcnt,0,strlen($lcnt)-1) ;
} ; # fin si
if (substr($lnom,strlen($lnom)-1,1)=="_") {
$lnom = substr($lnom,0,strlen($lnom)-1) ;
} ; # fin si
echo '</textarea>' ;
fintd() ;
td() ; nbsp(3) ; fintd() ;
td() ;
p() ;
if ($lang=="FR") {
echo '<b>Dictionnaire par occurences</b>' ;
} else {
echo '<b>Occurences dictionnary</b>' ;
} ; # fin de si
finp() ;
echo '<textarea name="mat" rows="15" cols="50" class="fond_jaune">' ;
$dicOcc = $dico ;
arsort($dicOcc) ;
reset($dicOcc) ;
#for(reset($dicOcc); $ind = key($dicOcc); next($dicOcc)) {
foreach ($dicOcc as $ind=>$cnt) {
#for(reset($dicNom); $ind = key($dicNom); next($dicNom)) {
$mnd = $ind ;
if (strlen($mnd)>30) {
$mnd = substr($ind,0,29) ;
} ;
echo " ".sprintf("%-30s",$mnd)." ".sprintf("%7d",$cnt)."\n";
} ; # fin pour
echo '</textarea>' ;
fintd() ;
fintr() ;
fintable() ;
# si le paramètre $histopct ne vaut pas "no"
# on fait un histogramme du dico alphabétique
if ($histopct!="no") {
p() ;
echo "<b>Frequency histogram</b>" ;
br() ;
nbsp() ;
br() ;
$url = "../jphistopct.php?vdata=$lcnt&xmrks=$lnom&titr=&tailx=800" ;
echo "<img src='$url' alt='histogramme' />\n" ;
finp() ;
} ; # fin si
} # fin function decritQX
###############################################################################
function decritQX_Sql($titreQX,$tableSQL,$champQX,$conditions="",$lang="FR",$histopct="no",$cusm=0) {
###############################################################################
# exemples : decritQX_Sql("leadata","TISSUE TYPE","devstage") ;
# decritQX_Sql("leadata","TISSUE TYPE","devstage","","EN","no",1)
# remarques : on suppose la connexion SQL faite
# $tableSQL peut contenir plusieurs noms
# et meme du code SQL tant que cela va dans la partie FROM
# le dernier paramètre considère tout le champ comme un seul mot
# extraction des données
$lestablesSQL = str_replace("+",",",$tableSQL) ;
$qry = " SELECT $champQX FROM $lestablesSQL $conditions " ;
#echo"<pre>$qry</pre>\n" ;
$rdq = mysql_query($qry) ;
$numlig = - 1 ;
$letexte = "" ;
$numlig = -1 ;
while ($tdr=mysql_fetch_array($rdq)) {
$numlig++ ;
$vdc = trim($tdr[$champQX]) ; # contenu original du champ
if ($cusm==1) {
$vdc = str_replace(" ","_",$vdc) ;
$vdc = str_replace(".","_",$vdc) ;
$vdc = str_replace("'","_",$vdc) ;
$vdc = str_replace("-","_",$vdc) ;
} ; # fin de si
$letexte .= $vdc." " ;
} ; # fin de tant que
# construction des dictionnaires
decritQX($titreQX,$letexte,$lang,$histopct) ;
} # fin function decritQX_Sql($titreQX,$tabQX) {
###############################################################################
function execute_R($tabCmd,$dbgExt=1) {
###############################################################################
# ceci permet d'exécuter un fichier R quelconque et d'afficher ses résultats
# (entre STAT_DEB et STAT_FIN)
# voir par exemple vd.php ou progstat.php pour des exemples d'utilisation
# comme ci-dessous :
/*
# calculs stat via execute_R de statuno.php
$tcmdR = array() ;
$nbcmd = -1 ;
$nbcmd++ ; $tcmdR[$nbcmd] = " source(\"statgh.r\",encoding='latin1') \n" ;
$nbcmd++ ; $tcmdR[$nbcmd] = " lesd <- read.table(\"$ficdat\") \n" ;
$nbcmd++ ; $tcmdR[$nbcmd] = " attach(lesd) \n" ;
$nbcmd++ ; $tcmdR[$nbcmd] = " vqtGH <- V1\n" ;
$nbcmd++ ; $tcmdR[$nbcmd] = " cat(\"STAT_DEB\n\")\n" ;
#$nbcmd++ ; $tcmdR[$nbcmd] = " cat(\"\nVoici vos données: \")\n" ;
#$nbcmd++ ; $tcmdR[$nbcmd] = " print(vqtGH) \n" ;
#$nbcmd++ ; $tcmdR[$nbcmd] = " cat(\"et leur analyse: \")\n" ;
$nbcmd++ ; $tcmdR[$nbcmd] = " dtQT(\"DataWeb\",vqtGH,\"$uni\",TRUE,\"$png1\",\"$png2\") \n" ;
$nbcmd++ ; $tcmdR[$nbcmd] = " cat(\"STAT_FIN\n\")\n" ;
if ($dbg==1) {
p() ;
echo " on utilise la fonction ".b("execute_R()")." avec comme paramètre le tableau suivant " ;
finp() ;
pre() ;
print_r($tcmdR) ;
finpre() ;
} ; # fin si
pre() ;
execute_R($tcmdR,$dbg) ; # la fonction execute_R est dans statuno.php
finpre() ;
*/
$dbgR = 0 ; # 0 en mode normal, 1 pour debug
if ($dbgExt==1) { $dbgR = 1 ; } ;
$ftmp2 = tempnam("/tmp","statuno_calculs.r") ; # programme R
$ftmp3 = tempnam("/tmp","statuno_calcstats.r") ; # pour "sourcer" le programme
$ftmp4 = tempnam("/tmp","statuno_calculs.sor") ; # sorties du programme R
# transfert des commandes R dans le fichier tmp2
if ($fh = fopen($ftmp2,"w")) {
# pre() ;
$nblc = count($tabCmd) ;
for ($idlc=0; $idlc<$nblc;$idlc++) {
if (isset($tabCmd[$idlc])) {
$ligc = $tabCmd[$idlc]."\n" ;
if ($dbgR==1) {
echo $ligc ;
} ; # fin si
fputs($fh, $ligc) ;
} ; # fin si
} ; # fin pour chaque
# finpre() ;
fclose($fh) ;
# print "<pre> fichier $ftmp1 ok sans doute \n</pre>" ;
} else {
print "<pre> pb avec $ftmp2 \n</pre>" ;
return("") ;
} ; # fin de si
# afin de simplifier les affichages, on ne met que source
# dans le fichier tmp3 qui sera exécuté :
if ($fh = fopen($ftmp3,"w")) {
$ligs = " source(\"$ftmp2\",encoding='latin1') \n ";
if ($dbgR==1) {
$ligs = " source(\"$ftmp2\",print.eval=TRUE,echo=TRUE,encoding='latin1') \n ";
} ; # fin de si
fputs($fh, $ligs) ;
fclose($fh) ;
# print "<pre> fichier $ftmp3 ok sans doute \n</pre>" ;
} else {
print "<pre> pb avec $ftmp3 \n</pre>" ;
} ; # fin de si
# exécution standard de R avec redirection
unlink($ftmp4) ;
$cmd = "R --quiet --no-save < $ftmp3 > $ftmp4 2>> $ftmp4 " ;
if ($dbgR==1) {
$cmd = "R --quiet --no-save < $ftmp3 > $ftmp4 2>> $ftmp4 " ;
} ; # fin si
# si cela ne marche pas, essayer : $cmd = "R --quiet --vanilla < $ftmp3 " ;
if ($dbgR==1) {
echo b("$cmd") ;
system("head $ftmp2") ;
system("head $ftmp3") ;
} ; # fin si
system($cmd) ;
if ($dbgR==1) {
system("head $ftmp4") ;
} ; # fin si
# filtrage des résultats et affichage
clearstatcache();
if ($fh = fopen($ftmp4,"r")) {
$ok = 0 ;
while (!feof ($fh)) {
$lig = fgets($fh, 4096) ;
# quelques nettoyages
if (strpos($lig,"vous pouvez utiliser")>-1) { $lig = "" ; } ;
if (strpos($lig,"The decimal point is")>-1) { $lig = "" ; } ;
if (strpos($lig,"la moyenne est en rouge")>-1) { $lig = "" ; } ;
#if ($dbgr == 1) { print "<pre> on voit $ligs dans $ftmp4 </pre>"; } ;
if ($lig == "STAT_FIN\n") { $ok = 0 ; } ;
if ($ok==1) { echo " $lig " ; } ;
if ($lig == "STAT_DEB\n") { $ok = 1 ; } ;
} ; # fin tant que
fclose($fh) ;
} else {
print "<pre> pas de valeurs pour $ftmp4 </pre>" ;
} ; # fin de si
print "\n" ;
flush() ;
# nettoyage des fichiers
if ($dbgR==1) {
unlink($ftmp2) ;
unlink($ftmp3) ;
unlink($ftmp4) ;
} ; # fin si
} # fin function execute_R
###############################################################################
###############################################################################
function fonction_R($txt) {
###############################################################################
# exécute une fonction R et renvoie la valeur résultat
$dbgR = 0 ; # 0 en mode normal, 1 pour debug
if ($dbgR==1) { pre() ; } ;
$ftmp2 = tempnam("/tmp","statuno_calculs.r") ; # programme R
$ftmp3 = tempnam("/tmp","statuno_calcstats.r") ; # pour "sourcer" le programme
$ftmp4 = tempnam("/tmp","statuno_calculs.sor") ; # sorties du programme R
# transfert des commandes R dans le fichier tmp2
if ($fh = fopen($ftmp2,"w")) {
fputs($fh, "source(\"statgh.r\") ; " ) ;
fputs($fh, "cat(\"STAT_DEB\",\"\\n\") ; " ) ;
fputs($fh, "cat( $txt ,\"\\n\") ; " ) ;
fputs($fh, "cat(\"STAT_FIN\",\"\\n\") ; " ) ;
fclose($fh) ;
if ($dbgR==1) { finpre() ; } ;
# print "<pre> fichier $ftmp1 ok sans doute \n</pre>" ;
} else {
print "<pre> pb avec $ftmp2 \n</pre>" ;
return("") ;
} ; # fin de si
# afin de simplifier les affichages, on ne met que source
# dans le fichier tmp3 qui sera exécuté :
if ($fh = fopen($ftmp3,"w")) {
$ligs = " source(\"$ftmp2\") \n ";
fputs($fh, $ligs) ;
fclose($fh) ;
# print "<pre> fichier $ftmp3 ok sans doute \n</pre>" ;
} else {
print "<pre> pb avec $ftmp3 \n</pre>" ;
} ; # fin de si
# exécution standard de R avec redirection
unlink($ftmp4) ;
$cmd = "R --quiet --vanilla --encoding=latin1 < $ftmp3 > $ftmp4 2>> $ftmp4 " ;
# si cela ne marche pas, essayer : $cmd = "R --quiet --vanilla < $ftmp3 " ;
if ($dbgR==1) {
h3("$cmd") ;
pre() ;
system("head $ftmp2") ;
system("head $ftmp3") ;
finpre() ;
} ; # fin si
system($cmd) ;
if ($dbgR==1) {
system("head $ftmp4") ;
} ; # fin si
# filtrage des résultats et affichage
clearstatcache();
if ($fh = fopen($ftmp4,"r")) {
$ok = 0 ;
while (!feof ($fh)) {
$lig = fgets($fh, 4096) ;
$lig = trim(strtr($lig,"\n"," ")) ;
if ($dbgR == 1) { print "<pre> on voit *$lig* dans $ftmp4 et ok vaut $ok</pre>"; } ;
if ($lig=="STAT_FIN") { $ok = 0 ; } ;
if ($ok==1) { $ligret = $lig ; } ;
if ($lig=="STAT_DEB") { $ok = 1 ; } ;
} ; # fin tant que
fclose($fh) ;
} else {
print "<pre> pas de valeurs pour $ftmp4 </pre>" ;
} ; # fin de si
print "\n" ;
flush() ;
# nettoyage des fichiers
if ($dbgR==1) {
unlink($ftmp2) ;
unlink($ftmp3) ;
unlink($ftmp4) ;
} ; # fin si
return($ligret) ;
} # fin function fonction_R
###############################################################################
###############################################################################
function entree_sortie_R($es,$nomfic) {
###############################################################
# écrit le contenu du fichier-paramètre en mode pre, style cadrebleu ou cadrejaune
if ($es=="entree") {
pre("cadrebleu") ;
} else {
pre("cadrejaune") ;
} ; # fin si
echo "\n" ;
if (!file_exists($nomfic)) {
print " fichier $nomfic non vu\n" ;
} else {
$fh = fopen($nomfic,"r") ;
while (!feof ($fh)) {
$lig = fgets($fh, 4096) ;
$lig = preg_replace("/\n/","",$lig);
$ligs = " " ;
$lng = strlen($lig) ;
$idc = 0 ;
while ($idc<$lng) {
$cc = substr($lig,$idc,1) ;
if ($cc=="<") { $cc = "<" ; } ;
if ($cc==">") { $cc = ">" ; } ;
if ($cc=="&") { $cc = "&" ; } ;
$ligs .= $cc ;
$idc++ ;
} ; # fintant que
echo $ligs;
nbsp(5) ;
echo"\n" ;
} ; # fin tant que
fclose($fh) ;
} ; # fin si le fichier existe
finpre() ;
} # fin de fonction entree_sortie_R
###############################################################
function pre_cadre($nomfic) {
###############################################################
# écrit le contenu du fichier-paramètre en mode pre, style cadre
pre("cadre") ;
echo"\n" ;
if (!file_exists($nomfic)) {
print " fichier $nomfic non vu\n" ;
} else {
$fh = fopen($nomfic,"r") ;
while (!feof ($fh)) {
$lig = fgets($fh, 4096) ;
$lig = preg_replace("/\n/","",$lig);
$ligs = " " ;
$lng = strlen($lig) ;
$idc = 0 ;
while ($idc<$lng) {
$cc = substr($lig,$idc,1) ;
if ($cc=="<") { $cc = "<" ; } ;
if ($cc==">") { $cc = ">" ; } ;
$ligs .= $cc ;
$idc++ ;
} ; # fintant que
echo $ligs ;
nbsp(5) ;
echo"\n" ;
} ; # fin tant que
fclose($fh) ;
} ; # fin si le fichier existe
finpre() ;
} # fin de fonction pre_cadre
###############################################################
function entree_R($nomfic) {
###############################################################
# affiche le code source d'un fichier R
entree_sortie_R("entree",$nomfic) ;
} # fin de fonction entree_R
###############################################################
function sortie_R($nomfic) {
###############################################################
# affiche le résutat d'exécution d'un fichier R
entree_sortie_R("sortie",$nomfic) ;
} # fin de fonction sortie_R
###############################################################
function graphe_R($nomfic,$taille=400) {
###############################################################
# appel de graphique_R_png avec le meme nombre de lettres
# que pour entree_R et sortie_R
graphique_R_png($nomfic,$taille) ;
} # fin de fonction graphe_R
###############################################################
function graphique_R_png($nomfic,$taille=400) {
###############################################################
# affiche un graphique-paramètre
div("cadrejaune") ;
blockquote() ;
p("center") ;
echo href($nomfic,img($nomfic,$nomfic,$taille)) ;
finp() ;
finblockquote() ;
findiv() ;
} # fin de fonction graphique_R_png
###############################################################
function graphiques_R_png($nomfic1,$nomfic2,$nomfic3="",$nomfic4="",$nomfic5="",$nomfic6="") {
###############################################################
div("cadrejaune") ;
blockquote() ;
table() ;
tr() ;
td() ; echo href($nomfic1,img($nomfic1,$nomfic1,"300")) ; fintd() ;
td() ; p() ; nbsp(10) ; finp() ; fintd() ;
td() ; echo href($nomfic2,img($nomfic2,$nomfic2,"300")) ; fintd() ;
fintr() ;
if (!$nomfic3=="") {
tr() ;
td() ; p() ; nbsp(10) ; finp() ; fintd() ;
fintr() ;
tr() ;
td() ; echo href($nomfic3,img($nomfic3,$nomfic3,"300")) ; fintd() ;
td() ; p() ; nbsp(10) ; finp() ; fintd() ;
td() ; if (!$nomfic4=="") { echo href($nomfic4,img($nomfic4,$nomfic4,"300")) ; } ; fintd() ;
fintr() ;
if (!$nomfic5=="") {
tr() ;
td() ; p() ; nbsp(10) ; finp() ; fintd() ;
fintr() ;
tr() ;
td() ; echo href($nomfic5,img($nomfic5,$nomfic5,"300")) ; fintd() ;
td() ; p() ; nbsp(10) ; finp() ; fintd() ;
td() ; echo href($nomfic6,img($nomfic6,$nomfic6,"300")) ; fintd() ;
fintr() ;
} ; # fin si
} ; # fin si
fintable() ;
finblockquote() ;
findiv() ;
} # fin de fonction graphiques_R_png
###############################################################
function DeuxGraphiquesEn_R_png($nomfic1,$nomfic2) {
###############################################################
blockquote() ;
table() ;
tr() ;
td() ;
nbsp(20) ;
fintd() ;
td() ; echo href($nomfic1,img($nomfic1,$nomfic1,"300")) ; fintd() ;
td() ; p() ; nbsp(10) ; finp() ; fintd() ;
td() ; echo href($nomfic2,img($nomfic2,$nomfic2,"300")) ; fintd() ;
fintr() ;
fintable() ;
finblockquote() ;
} # fin de fonction DeuxGraphiquesEn_R_png
###############################################################
function TroisGraphiquesEn_R_png($nomfic1,$nomfic2,$nomfic3) {
###############################################################
blockquote() ;
table() ;
tr() ;
td() ; echo href($nomfic1,img($nomfic1,$nomfic1,"300")) ; fintd() ;
td() ; p() ; nbsp(10) ; finp() ; fintd() ;
td() ; echo href($nomfic2,img($nomfic2,$nomfic2,"300")) ; fintd() ;
td() ; p() ; nbsp(10) ; finp() ; fintd() ;
td() ; echo href($nomfic3,img($nomfic3,$nomfic3,"300")) ; fintd() ;
fintr() ;
fintable() ;
finblockquote() ;
} # fin de fonction TroisGraphiquesEn_R_png
###############################################################
function sixGraphiquesEn_R_png($nomfic1,$nomfic2,$nomfic3,$nomfic4,$nomfic5,$nomfic6) {
###############################################################
div("cadrejaune") ;
blockquote() ;
table() ;
tr() ;
td() ; echo href($nomfic1,img($nomfic1,$nomfic1,"300")) ; fintd() ;
td() ; p() ; nbsp(10) ; finp() ; fintd() ;
td() ; echo href($nomfic2,img($nomfic2,$nomfic2,"300")) ; fintd() ;
fintr() ;
tr() ;
td("C","",3) ; nbsp() ; fintd() ;
fintr() ;
tr() ;
td("C","",3) ; echo href($nomfic3,img($nomfic3,$nomfic3,"300")) ; fintd() ;
fintr() ;
fintable() ;
finblockquote() ;
findiv() ;
} # fin de fonction TroisGraphiquesEn_R_png
###############################################################
function execute_Sweave($tabCmd) {
###############################################################
# not yet !
} # fin de fonction execute_Sweave
?>
La coloration syntaxique est réalisée par : SyntaxHighlighter. Si vous préférez, vous pouvez utiliser celle de geshi ou même celle construite autour de la fonction highlight_file. |
Retour à la page principale de
(gH)