Association Tunisienne pour l'Informatique Scolaire Index du Forum

Association Tunisienne pour l'Informatique Scolaire
BACCALAUREAT INFORMATIQUE et CAPES INFORMATIQUE

 FAQFAQ   RechercherRechercher   MembresMembres   GroupesGroupes   S’enregistrerS’enregistrer 
 ProfilProfil   Se connecter pour vérifier ses messages privésSe connecter pour vérifier ses messages privés   ConnexionConnexion 

correction bac pratique 2012 08h30-->10h

 
Poster un nouveau sujet   Répondre au sujet    Association Tunisienne pour l'Informatique Scolaire Index du Forum -> Bac Sciences de l'Informatique -> BAC 2008 - 2009 - 2010 - 2011 - 2012 -> BAC PRATIQUE 2012
Sujet précédent :: Sujet suivant  
Auteur Message
club_africain
7- Membre

Hors ligne

Inscrit le: 30 Sep 2011
Messages: 5
Emploi: Professeur
Localisation: Mannouba
Lycée/collège: route chouigui
Point(s): 0

MessagePosté le: Ven 25 Mai 2012 - 01:28    Sujet du message: correction bac pratique 2012 08h30-->10h Répondre en citant

program decomposition;
uses wincrt;
type fiche=file of integer;
tab=array[1..100]of integer;
var f1:fiche;
    f2:text;
    t:tab;
    N,p:integer;
procedure saisie(var N,p:integer);
begin
repeat
writeln('n=');
readln(n);
until n in[3..99];
repeat
writeln('donner le nombre des chiffres composants nombres à saisir');
readln(p);
until p in [3..5];
end;
procedure remplir1(var f1:fiche;N,p:integer);
var a,i:integer;
    ch:string;

begin
for i:=1 to N do
begin
repeat
writeln('donner un nombre');
readln(a);
str(a,ch);
until length(ch)=p;
write(f1,a);
end;
end;
procedure facteurs(a:integer;var k:integer;var t:tab);
var
    i:integer;
begin
i:=2;
k:=0;
repeat
if a mod i=0 then
begin
k:=k+1;
t[k]:=i;

a:=a div i;
end
else
i:=i+1;
until a=1;
end;
function frequence (t:tab;k:integer):string;
var ch,ch1,ch2:string;
    i,j,c:integer;
    begin
ch:='';
j:=1;
repeat
i:=j;
c:=1;
repeat

j:=j+1;
if t[j]=t[i] then

c:=c+1;

 
until (j=k) or (t[j]<>t[i]);
str(c,ch1);
str(t[i],ch2);
ch:=ch+ch1+ch2;

until i=k;
frequence:=ch;
end;
procedure remplir2(var f1:fiche;var f2:text;N:integer);
var a,i,k:integer;
    ch:string;
    t:tab;
   
begin
reset(f1);
for i:=1 to N do
begin
read(f1,a);
facteurs(a,k,t);
ch:=frequence(t,k);
writeln(f2,ch);
end;
end;
procedure affiche(var f2:text);
var ch:string;
begin
reset(f2);
while not eof(f2) do
begin
readln(f2,ch);
writeln(ch);
end;
end;
begin
assign(f1,'c:\nombres.dat');
rewrite(f1);
assign(f2,'c:\facteurs.txt');
rewrite(f2);
saisie(N,p);
remplir1(f1,N,p);
remplir2(f1,f2,n);
affiche(f2);
end.
_______________________________________________________________________________________________________
la programmation est un art soyez les artistes


Revenir en haut
Publicité






MessagePosté le: Ven 25 Mai 2012 - 01:28    Sujet du message: Publicité

PublicitéSupprimer les publicités ?
Revenir en haut
club_africain
7- Membre

Hors ligne

Inscrit le: 30 Sep 2011
Messages: 5
Emploi: Professeur
Localisation: Mannouba
Lycée/collège: route chouigui
Point(s): 0

MessagePosté le: Ven 25 Mai 2012 - 01:33    Sujet du message: correction bac pratique 2012 08h30-->10h Répondre en citant

bon courage pour le bac théorique
_______________________________________________________________________________________________________
la programmation est un art soyez les artistes


Revenir en haut
bibani
6- Professeur

Hors ligne

Inscrit le: 16 Mai 2009
Messages: 32
Emploi: Professeur
Localisation: Mednine
Lycée/collège: midoun
Sexe: Masculin
Point(s): 5

MessagePosté le: Ven 25 Mai 2012 - 11:00    Sujet du message: correction bac pratique 2012 08h30-->10h Répondre en citant

{sujet bac pratique 24 mai 2012 8h30}
program s24mai2012_8h30;
uses wincrt;
type
    fnombres= file of longint;
var
   n,p:integer;
   f1:fnombres;
   f2:text;
procedure saisie(var n,p:integer);
begin
    repeat
          write('n:');readln(n);
    until (2<n) and (n<100);
    repeat
          write('p:');readln(p);
    until (2<p) and (p<6);
end;
procedure remplir_nombres(n,p:integer;var f1:fnombres);
var
   i:integer;
   x:longint;
   ch:string;
begin
    rewrite(f1);
    for i:=1 to n do
    begin
        repeat
           write('x:');readln(x);
           str(abs(x),ch);
        until length(ch)=p;
        write(f1,x);
    end;
    close(f1);
end;
procedure affichage(var f2:text);
var
   ch:string;
begin
    reset(f2);
    while not eof(f2) do
    begin
        readln(f2,ch);
        writeln(ch);
    end;
    close(f2);
end;
function facteur_premier(x:longint):string;
var
   d,nb,i:integer;
   ch,chnb,cht:string;
   t:array[1..20] of integer;
   taille:integer;
begin
    d:=2;
    taille:=0;
    repeat
        if x mod d =0 then
                         begin
                              taille:=taille+1;
                              t:=d;
                              x:=x div d;
                         end
                       else
                         begin
                            d:=d+1 
                         end;
    until x=1;
 
    ch:='';
    nb:=1;
    i:=2;
    repeat
        if t=t then
                             begin
                                nb:=nb+1;
                                i:=i+1;
                             end
                       else
                             begin
                               str(nb,chnb);
                               str(t,cht);
                               ch:=ch+chnb+cht;
                               nb:=1;
                               i:=i+1;
                            end;
    until i>taille;
     str(nb,chnb);
     str(t,cht);
     ch:=ch+chnb+cht;
    facteur_premier:=ch;
end;
procedure remplir_facteurs(n:integer;var f1:fnombres; var f2:text);
var
   i:integer;
   x:longint;
   comp:string;
begin
    reset(f1);
    rewrite(f2);
    for i:=1 to n do
    begin
        read(f1,x);
        comp:=facteur_premier(x);
        writeln(f2,comp);
    end;
    close(f1);
    close(f2);
end;
{pp}
begin
    saisie(n,p);
    assign(f1,'c:\bac2012\nombres.dat');
    remplir_nombres(n,p,f1);
 
    assign(f2,'c:\bac2012\facteurs.txt');
    remplir_facteurs(n,f1,f2);
    affichage(f2);
end.


Revenir en haut
Contenu Sponsorisé






MessagePosté le: Aujourd’hui à 08:58    Sujet du message: correction bac pratique 2012 08h30-->10h

Revenir en haut
Montrer les messages depuis:   
Poster un nouveau sujet   Répondre au sujet    Association Tunisienne pour l'Informatique Scolaire Index du Forum -> Bac Sciences de l'Informatique -> BAC 2008 - 2009 - 2010 - 2011 - 2012 -> BAC PRATIQUE 2012 Toutes les heures sont au format GMT + 1 Heure
Page 1 sur 1

 
Sauter vers:  

Index | Creer un forum | Forum gratuit d’entraide | Annuaire des forums gratuits | Signaler une violation | Conditions générales d'utilisation
Powered by phpBB © 2001, 2005 phpBB Group
Traduction par : phpBB-fr.com