Valid XHTML 1.0!                  

  quelques exemples de programmes informatiques
  dans divers langages

 

  Fortran   Cobol   Lisp

         integer bottls

         do 50 i = 1, 99

            bottls = 100 - i
            print 10, bottls
   10       format(1x, i2, 31h bottle(s) of beer on the wall.)   
            print 20, bottls
   20       format(1x, i2, 19h bottle(s) of beer.)
            print 30
   30       format(34h Take one down and pass it around,)
            bottls = bottls - 1
            print 10, bottls
            print 40
   40       format(1x)

   50    continue

         stop
         end



    IDENTIFICATION DIVISION.
    PROGRAM-ID.BOTTLES_OF_BEER.
    AUTHOR.DONALD FRASER.
   *
    ENVIRONMENT DIVISION.
    CONFIGURATION SECTION.
    SOURCE-COMPUTER. VAX.
    OBJECT-COMPUTER. VAX.
   *
    INPUT-OUTPUT SECTION.
    FILE-CONTROL.
           SELECT OUTPUT-FILE
                   ASSIGN TO BEERS_ON_THE_WALL.
   *
    DATA DIVISION.
    FILE SECTION.
    FD OUTPUT-FILE
           LABEL RECORDS ARE OMITTED.
    01 BEERS-OUT                                   PIC X(133).
   *
    WORKING-STORAGE SECTION.
    01 FLAGS-COUNTERS-ACCUMULATORS.
           05 FLAGS.
                   10 E-O-F                        PIC 9.
                           88 END-OF-FILE                VALUE 1.
           05 COUNTERS.
                   10 BOTTLES                      PIC 999
                                                   VALUE 0.
    01 RECORD-OUT.
           05 LINE1.
                   10 NUMBER-OF-BEERS-1            PIC ZZ9.
                   10                              PIC X(28)
                                   VALUE "BOTTLES OF BEER IN THE WALL ".
                   10                              PIC X
                                   VALUE ",".
                           10 NUMBER-OF-BEERS-2    PIC ZZ9.
                   10                              PIC    X.
                   10                              PIC X(17)
                                   VALUE "BOTTLES OF BEER.".
           05 LINE2.
                   10                              PIC X(34)
                                   VALUE "TAKE ONE DOWN AND PASS IT ARROUND ".
                   10 NUMBER-OF-BEERS-3            PIC ZZ9.
                   10                              PIC X.
                   10                              PIC X(28)
                                   VALUE "BOTTLES OF BEER IN THE WALL".
   *
    PROCEDURE DIVISION.
    DRIVER-MODULE.
         PERFORM INITIALIZATION.
         PERFORM PROCESS UNTIL END-OF-FILE.
         PERFORM TERMINATION.
         STOP RUN.
   *
    INITIALIZATION.
           OPEN OUTPUT OUTPUT-FILE.
           ADD 100 TO BOTTLES.
   *
    PROCESS.
            IF BOTTLES = 0 THEN
                   COMPUTE E-O-F = 1
           ELSE PERFORM WRITE-ROUTINE
           END-IF.
   *
    TERMINATION.
           CLOSE OUTPUT-FILE.
   *
    WRITE-ROUTINE.
           MOVE BOTTLES TO NUMBER-OF-BEERS-1, NUMBER-OF-BEERS-2.
           COMPUTE BOTTLES = BOTTLES - 1.
           WRITE BEERS-OUT FROM LINE1.
           MOVE BOTTLES TO NUMBER-OF-BEERS-3.
           WRITE BEERS-OUT FROM LINE2.




    (defun beersong (n)
     "Does the n-beers song."

    (progn (insert (int-to-string n) " bottle" (cond ((= n 1) "")
                                                     (t "s"))
                                             " of beer on the wall,\n")     
           (insert (int-to-string n) " bottle" (cond ((= n 1) "")
                                                    (t "s"))
                                            " of beer,\n")
           (insert "take one down and pass it around,\n")
           (insert (cond ((= n 1) "no more")
                        (t (int-to-string (- n 1))))
                  " bottle" (cond ((= n 2) "")
                                  (t "s"))
                  " of beer on the wall.\n\n")
           (cond ((> n 1) (beersong (- n 1))))))
  Apl   SmallTalk   Prolog
xmpapl 




   tableDeMultilication

    | fenetre |
   " table de multiplication "
    fenetre := TextWindow  windowLabeled: 'Table de Multiplication '
        frame: ( 210 @ 30 extent: 400 @(Display extent //2)y ).
    fenetre  cr ;
        nextPutAll: ' Table de ' ;
        nextPutAll: (self printString) ;
        cr ;
        cr .
    1 to: 10 do:   [ :ifois |
        fenetre
              nextPutAll: (ifois printString);
              nextPutAll: ' fois ' ;
              nextPutAll: (self printString) ;
              nextPutAll: ' = ' ;
              nextPutAll: ((ifois * self) printSting);
             cr.
    ].

    Menu message: 'Cliquez en gauche ici pour terminer'.
    fenetre close.

   ^nil



    initialize([Stench,Breeze,Glitter,no,no]) :-
      initialize_world(fig62),
      initialize_agent,
      stench(Stench),
      breeze(Breeze),
      glitter(Glitter).



    execute(_,[no,no,no,no,no]) :-
      agent_health(dead), !,         % agent must be alive to execute actions
      format("You are dead!~n",[]).

    execute(_,[no,no,no,no,no]) :-
      agent_in_cave(no), !,         % agent must be in the cave
      format("You have left the cave.~n",[]).

    execute(goforward,[Stench,Breeze,Glitter,Bump,no]) :-
      decrement_score,
      goforward(Bump),        % update location and check for bump
      update_agent_health,    % check for wumpus or pit
      stench(Stench),         % update rest of percept
      breeze(Breeze),
      glitter(Glitter).
  Awk   Perl   Rexx 

   # traitement des lignes non vides

   (NF>0) {
             if (FNR<6) { printf "     " }
             for (col=1;col<=nbc;col++) { num[ col ] = 0 }
             idt = $1 blanc ;
             printf("%-12s ",substr(idt,1,12) ) > ftmp
             if (FNR<6) { printf("%-12s ",substr(idt,1,12) ) }
             $1 = "" ; rep = $0 ; $0 = rep ;

   # Mise à jour des totaux par colonne

             for (col=1;col<=nbc;col++) { num[ $col ] =  1 ; tot[ $col  ]++ } # pour
             for (col=1;col<=nbc;col++) {
                  printf num[ col ] " " > ftmp
                  if (FNR<6) { printf num[ col ] " " }
             } # fin pour
             print " " > ftmp
             if (FNR<6) {
                print " "
                if (nbc>150) { print " " }
                if (FNR==5) { print "  ..."}
             } # fin si


  # création du fichier structure

  open(FDBF,">$fDbase") or die(" impossible d'écrire dans $fDbase") ;
  binmode FDBF ;

  open(FSTR,">$fstr") or die(" impossible d'écrire dans $fstr") ;
  my $i = 1 ;
  my $ligStr = "" ;
  while ($i<=$nbc) {
      $ligStr .= sprintf("%-15s",$nomCol[$i])." " ;
      if ($i==1) { print "Premières lignes du fichier structure $fstr :\n" ; } ;
      if ($i==1) { $ligStr .= "C " ; } else { $ligStr .= "N " ; } ;
      $ligStr .= sprintf("%2d"  ,$longCol[$i])." " ;
      $ligStr .= sprintf("%1d"  ,$decCol[$i]) ;
      print FSTR "$ligStr\n" ;
      if ($i<=5) { print  "     $ligStr\n" ; } ;
      $ligStr = "" ;
      $i++ ;
  } ; # fin pour i
  close(FSTR) ;

  my $lonCcar = 0 ;
  my $lonCnum = 0 ;

  # parcours du fichier structure

  $ndc = 0 ;
  open(FSTR,"<$fstr") or die(" impossible de lire dans $fstr") ;

  while (<FSTR>) {  $ndc++  ;
    ($m1,$m2,$m3,$m4) = split(" ",$_) ;
    $m1           =~ s/[a-z]/[A-Z]/ ;
    $nomCol[$ndc] = uc($m1) ;
    $m2           =~ s/[a-z]/[A-Z]/g ;
    $m2           = uc($m2) ;
    $typCol[$ndc] = substr($m2."?",0,1) ;
    $longCol[$ndc] = $m3 ;
    $decCol[ndc]  = $m4 ;
    if ($typCol[$ndc] eq "C") { $lonCcar += $longCol[$ndc] } ;
    if ($typCol[$ndc] eq "N") { $lonCnum += $longCol[$ndc] } ;

  } ; # fintant que



    /* classification hiérarchique */

    md. = 0  /* matrice des distances      */
    du. = 0  /* distances ultramétriques ? */
    de. = 0  /* distances des enfants      */
    et  = 0  /* numéro d'étape             */
    nomEsp. = "?" /* nom des espèces */

    do while lines(nomfic)>0
       lig = linein(nomfic)
       if substr(word(lig,1),1,1)='#' then iterate
          et  = et + 1
          nomEsp.et = word(lig,1)
          do j = 1 to words(lig)-1
             jj = j-1 /* car le premier mot est le nom de l'espèce */
             md.et.jj  = word(lig,j)
             md.jj.et  = md.et.jj
             if dbg=1 then say " mat ." et "." jj " = " md.et.jj
          end /* fin pour j */
    end /* fin de tant que */
    nbl = et

    call lineout nomfic
  Maple   Tcl/Tk   Php 

    symdep  := args[1][1] ;      # symbole de départ
    regprod := args[1][2] ;      # règles de production
    lprod   := regprod ;         # règles de subst. associées à regprod
    nbprod  := nops(regprod) ;   # nombre de règles
    varis   := sort(convert(indets(map(indets,regprod)),list),lexorder) ;
    nbvar   := nops(varis) ;     # nombre de variables
    if nops(args[1])>2 and whattype(args[1][3]) = set then
       varis  := sort(args[1][3],lexorder) ; nbvar := nops( varis ) ;
    fi ;
    vectg   := array(1..nbvar) ; # vecteur de gauche
    vectg   := map(x->degree(symdep,x),convert(varis,list)) ;
    vectd   := [1 $ nbvar]     ; # vecteur de droite
    valvar  := array(1..nbvar) ; # interp. numérique des symboles

    if nargs < 2 then lprint(` Syntaxe unionL( systeme_L1, systeme_L2 ) `) ;
    else
      l1 := args[1] ;
      l2 := args[2] ;
      lv := indets(map(indets,l1[2])) ;
      lv := lv union indets(map(indets,l2[2])) ;
      lv := sort(convert(lv,list),lexorder) ;
      if nargs>2 then parms := args[3] else parms := {} ; fi ;
      m1 := Ls2Mat( [ l1[1], l1[2], lv ] , parms ) ;
      m2 := Ls2Mat( [ l2[1], l2[2], lv ] , parms ) ;
      mp := Mat2Ls( evalm(m1+m2) , parms ) ;
      RETURN( [ l1[1] * l2[1] , mp[2] , lv ] ) ;
   fi ;



   proc tailleWin { parm } {

     # utilise tout l'écran pour un affichage maximal
     # ou à 80% pour un affichage réduit

       set ww     [winfo screenwidth  .] ;
       set wh     [winfo screenheight .] ;
       set decale 0
       if { $parm == 0 }  {
          set ww     [expr round($ww*0.8)] ;
          set wh     [expr round($wh*0.8)] ;
          set decale 30
       } ; # fin si
       set ghm "wm geometry . $ww" ;
       append  ghm "x$wh+$decale+$decale" ;
       eval    $ghm

   } ; # fin proc tailleWin

   proc changeSpecs { } {

   global nfi ldf chemin ordf  specsf ;
   # change les spécifs de fichier

     set especsf $specsf
     catch { destroy   .fspec }
     toplevel          .fspec
     wm title          .fspec " File specifications "
     wm geometry       .fspec "+100+200"
     label             .fspec.la   -font { System 14 bold } -text " Fichiers ? " -bg blue -fg yellow
     entry             .fspec.en   -font { System 14 bold } -textvariable especsf
     bind              .fspec.en  <Return> { finSpecs $especsf }
     pack .fspec.la -side left
     pack .fspec.en -side right
     focus -force      .fspec.en

   } ; # fin proc changeSpecs



    <?

    # ouverture de la base

    mysql_connect("xxxxxx","yyyyyyy","zzzzz") ;
    $res  = mysql_selectdb("aaaaaaa") ;

    $jour1 = "lundi" ; $jour2 = "mardi" ;

    # remise à zéro de la base

    $err = 0 ;

    if ($nom=="reseT") { # remise à zéro !!

       $res  = mysql_query("delete from soutStages") ;

    } ;

    # on regarde si l'heure est disponible

    $qry = "select * from soutStages where jour=$jour and heure=$heure and minute=$minute " ;
    $res = mysql_query($qry) ;

    $nbr = 0 ;
    while ($ligr=mysql_fetch_array($res)) {
         $nbr++ ;
         $lap = $ligr["nom"];
         echo "<h1>horaire déjà pris par : $lap </h1>" ;
    } ; # fin tant que

    # insertion dans la base

    $qr   = "REPLACE INTO soutStages VALUES( " ;
    $qr  .= "'$nom', '$pre', '$jour', '$heure', '$minute' " ;
    $qr  .= ") " ;
    $res  = mysql_query("$qr") ;
  Pascal   C   Java 

    PROGRAM maxOcc ;

    const tailleM = 100 ;
    type  elemenT = integer ;
    type  tablo   = array[1..tailleM] of elemenT ;
    var

    nbElt      : integer ;
    indb       : integer ;
    monT       : tableau ;
    valMax     : elemenT ;
    nbMax      : elemenT ;
    eltCourant : elemenT ;


    BEGIN

    (* # on parcourt le tableau *)
    (* # sans utiliser le dernier élément déja comptabilisé *)

    for indb := 1 to nbElt-1 do begin
         eltCourant := monT[ indb ] ;
         if eltCourant  >  valMax
            then begin  (* # nouveau maximum local *)
                  valMax := eltCourant ;
                  nbMax := 1 ;
            end else begin
                  if eltCourant  =  valMax
                     then begin  (* # une fois de plus le maximum *)
                           nbMax := nbMax  +  1 ;
                  end ; (* # nouvelle occurence du maximum *)
         end ; (* # nouveau maximum *)
    end ; (* # indb de1a 10 *)

    END.





 if (!(jukesquick || kimquick || jinneiquick)) {
    prod = (double *)Malloc(sites*sizeof(double));
    prod2 = (double *)Malloc(sites*sizeof(double));
    prod3 = (double *)Malloc(sites*sizeof(double));
    for (i = 0; i < endsite; i++) {
      memcpy(xx1, p->x[i], sizeof(sitelike));
      memcpy(xx2, q->x[i], sizeof(sitelike));
      xx1freqa = xx1[0] * freqa;
      xx1freqc = xx1[(long)C - (long)A] * freqc;
      xx1freqg = xx1[(long)G - (long)A] * freqg;
      xx1freqt = xx1[(long)T - (long)A] * freqt;
      sum1 = xx1freqa + xx1freqc + xx1freqg + xx1freqt;
      sum2 = freqa * xx2[0] + freqc * xx2[(long)C - (long)A] +
             freqg * xx2[(long)G - (long)A] + freqt * xx2[(long)T - (long)A];
      prod[i] = sum1 * sum2;
      prod2[i] = (xx1freqa + xx1freqg) *
                 (xx2[0] * freqar + xx2[(long)G - (long)A] * freqgr) +
          (xx1freqc + xx1freqt) *
          (xx2[(long)C - (long)A] * freqcy + xx2[(long)T - (long)A] * freqty);
      prod3[i] = xx1freqa * xx2[0] + xx1freqc * xx2[(long)C - (long)A] +
         xx1freqg * xx2[(long)G - (long)A] + xx1freqt * xx2[(long)T - (long)A];
    }
    tt = 0.1;
    delta = 0.1;
    it = 1;
    while (it < iterations && fabs(delta) > 0.00002) {
      slope = 0.0;
      if (tt > 0.0) {
        lz = -tt;
        for (i = 0; i < categs; i++) {
          tbl[i].z1 = exp(tbl[i].ratxv * lz);
          tbl[i].y1 = 1.0 - tbl[i].z1;
          tbl[i].z1zz = exp(tbl[i].rat * lz);
          tbl[i].z1yy = tbl[i].z1 - tbl[i].z1zz;
          tbl[i].z1xv = tbl[i].z1 * xv;
        }
        for (i = 0; i < endsite; i++) {
          idx = category[alias[i] - 1];
          cc = prod[i];
          bb = prod2[i];
          aa = prod3[i];
          slope += weightrat[i] * (tbl[idx - 1].z1zz * (bb - aa) +
                tbl[idx - 1].z1xv * (cc - bb)) /
              (aa * tbl[idx - 1].z1zz + bb * tbl[idx - 1].z1yy +
               cc * tbl[idx - 1].y1);
        }
      }
      if (slope < 0.0)
        delta = fabs(delta) / -2.0;
      else
        delta = fabs(delta);
      tt += delta;
      it++;
    }
    vv = tt * fracchange;
    free(prod);




   import java.io.* ;
   class simja {

   public static void main(String args[]) {

   int     nbobs, nbtos ;
   int     mclass, iobs, itos, clas ;
   double  href, haut, x,som ;
   int[]   tclass ;

   ///////////////////////////////////////////////////////////////
   //                                                           //
   //            no comment !                                   //
   //                                                           //
   ///////////////////////////////////////////////////////////////

       mclass = 0 ;
        iobs = 1 ;
        while ((iobs <= nbobs)) {
          som = 0 ;
          itos = 1 ;
          while ((itos <= nbtos)) {
            x =  Math.random() ;
            som = som + x * x ;
            itos = itos + 1 ;
          } ; // sur itos
          haut = href ;
          clas = 0 ;
          while ((som > haut)) {
             haut = haut + href ;
             clas = clas + 1 ;
          } ; // sur som>haut
          tclass[clas] = tclass[clas] + 1 ;
          if (clas > mclass) {
             mclass = clas ;
          } ; // clas > mclass
          iobs = iobs + 1 ;
        } ; // sur iobs

        for (int indi=1; indi<=mclass; indi++) {
           System.out.println(formatEntier( indi, 3 )+" : "+formatEntier(tclass[indi], 5 )) ;
        } ; // indi

   } // fin de la méthode main()
   } // fin de la classe simj
     

 

Suite de l'exposé : exemples réels de programmes exécutable sur Internet

 

 

        retour au plan de l'exposé  

 

  retour gH    Retour à la page principale de   (gH)