hg S’enregistrer Bac Tunisie Algorithmique et programmation : BAC INFORMATIQUE En Tunisie forum informatique Tunisie

Bac Tunisie Algorithmique et programmation : BAC INFORMATIQUE En Tunisie  forum informatique Tunisie Index du Forum

hg Bac Tunisie Algorithmique et programmation TIC réseaux php javascript sql access activités programmation c
hg
FAQ FAQ Rechercher Rechercher Membres Membres Groupes Groupes Profil Profil Se connecter pour vérifier ses messages privés Messages Privés Connexion Connexion


 Forum de l'excellence et l'excellence en innovation 
Pour participer à notre Forum, vous devez
 
inscrire sur notre forum a partir d'ici
 
  NB :
Les membres ''zéro messages'' seront supprimés automatiquement après un nombre de jours donné !!!!
             
   
 
  
forum d'aide informatique : internet, réseau, programmation informatique ...
Section scientifique : Maths, Sciences et technique -> 4ème année ->
 
 
Poster un nouveau sujet   Répondre au sujet    Bac Tunisie Algorithmique et programmation : BAC INFORMATIQUE En Tunisie forum informatique Tunisie Index du Forum -> Algorithmique & programmation -> (¯`·._.·[Devoirs et séries']·._.·´¯)
hg Sujet précédent :: Sujet suivant   hd
Auteur Message
KARIMOS
Administrateur

Hors ligne

Inscrit le: 02 Nov 2008
Messages: 1 710
Masculin
Point(s): 5 479
Moyenne de points: 0

Posté le: Mar 7 Avr - 11:47 (2009)    Sujet du message: Section scientifique : Maths, Sciences et technique -> 4ème année -> Répondre en citant

PublicitéSupprimer les publicités ?
Exercice 01 bac 2000 (théorique) :
Un entier naturel est dit parfait s’il est égal a la somme de tous ses diviseurs autres que lui-même.
Exemple :
6 est un nombre parfait car il vérifie 6 = 1 + 2 + 3 où 1, 2 et 3 sont les diviseurs de 6 autres que 6.
On se propose de chercher tous les entiers parfaits compris entre deux valeurs données m et n telles que 2<m<n.
Questions :
1- Analyser ce problème en le décomposant en modules.
2- Analyser chacun de ces modules.
3- En déduire l’algorithme de résolution relatif à chacun de ces modules ainsi que celui du programme principal.
solution:
program bac2000;
uses wincrt;
var m,n,i:integer;

 procedure saisi(var m,n:integer);
 begin
 repeat
 write('donner un entier superieur a 2');
 readln(m);
 write('donner un autre entier superieur au 1er');
 readln(n);
 until ((m>2) and (n>m)) ;
 end;

 function parfait ( x:integer):boolean;
 var j,s:integer;
 begin
 parfait:= false;
 s:=0;
 for j:= 1 to (x div 2) do
 if x mod j =0 then s:= s+j ;
 if s=x then parfait := true;
 end;

begin
saisi(m,n);
for i:=m to n do
if parfait(i) then write(i,' ');
end.


 
Revenir en haut
KARIMOS
Administrateur

Hors ligne

Inscrit le: 02 Nov 2008
Messages: 1 710
Masculin
Point(s): 5 479
Moyenne de points: 0

Posté le: Mar 7 Avr - 11:48 (2009)    Sujet du message: Section scientifique : Maths, Sciences et technique -> 4ème année -> Répondre en citant

program bac2001;
uses wincrt;
type tab= array[1..100]of integer;
var n: word;
    i:integer ;
    t:tab;
    ch:string;

procedure saisi(var n:word);
begin
repeat
write('donner un entier positif');
readln(n);
until n>0;
end;
procedure remplirt( ch:string;var t:tab; l:integer);
var s,e,j:integer;
begin
S:=0;
    for j:=1 to l do
    begin
    val(ch[j],s,e);
    t[j]:= s;
    end;
end;
procedure tri(var t:tab ; l:integer);
var i,j,m,ind:integer;
begin
for i:=1 to l-1 do
begin

ind:=i ;
m:=t[i];
for j:=i to l do
    if t[j]> m then begin
                         m:=t[j];
                          ind:= j;
                     end;
m:=t[i];
t[i]:=t[ind];
t[ind]:=m;
end;
end;
function con(t:tab; l:integer):string;
var i:integer;
    
    c,v:string;
begin
v:='';
for i:=1 to l do
begin
str(t[i],v);
c:=c+v;
end;
con:=c;
end;
begin
saisi(n);
str(n,ch);
remplirt(ch,t,length(ch));
tri(t,length(ch));
ch:= con(t,length(ch));
write(ch);
end.


 
Revenir en haut
KARIMOS
Administrateur

Hors ligne

Inscrit le: 02 Nov 2008
Messages: 1 710
Masculin
Point(s): 5 479
Moyenne de points: 0

Posté le: Mar 7 Avr - 11:48 (2009)    Sujet du message: Section scientifique : Maths, Sciences et technique -> 4ème année -> Répondre en citant

program bac2002;
uses wincrt;
type tab=array[1..1000]of real;
var t:tab;
    n,j:integer;
procedure saisien(var n:integer);
begin
repeat
writeln('donner un entier n');
readln(n);
until ((n>=10) and (n<= 50));
end;
procedure saisiet(var t: tab;n:integer);
var i:integer;
begin
for i:=1 to n do
repeat
writeln('donner la note de t[',i,']');
readln(t[i]);
until ((t[i]<=20) and (t[i]>=0));
end;
 function moyenne (t:tab; n:integer):real;
 var i:integer;
     s: real;
 begin
      moyenne:=0;
    s:=0;
    for i:=1 to n do
    s:= s+t[i];
    moyenne:= s/n;
 end;        
 function nb(t:tab; n,s,r:integer):integer;
 var i,f:integer;
 begin
 f:=0;
  for i:= 1 to n do
  if ((t[i] >= s) and ( t[i]<r )) then f := f + 1;
  nb:=f;
  end;
   function nb1(t:tab; n,s,r:integer):integer;
 var i,f:integer;
 begin
f:=0;
  for i:= 1 to n do
  if ((t[i]>=s) and (t[i]<=r))then f:= f + 1;
  nb1:=f;
  end;
begin                                 
saisien(n);
saisiet(t,n);
for j:=1 to n do
write(t[j]:1:2,'|');
writeln('');
writeln ('la moyenne arithmétique est', moyenne(t,n):1:2);
writeln('le nombre de moyenne de [0,10[ est: ', nb(t,n,0,10));
writeln('le nombre de moyenne de [10,12[ est: ', nb(t,n,10,12));
writeln('le nombre de moyenne de [12,14[ est: ', nb(t,n,12,14));
writeln('le nombre de moyenne de [14,16[ est: ', nb(t,n,14,16));
writeln('le nombre de moyenne de [16,20] est: ', nb1(t,n,16,20));
end.


 
Revenir en haut
KARIMOS
Administrateur

Hors ligne

Inscrit le: 02 Nov 2008
Messages: 1 710
Masculin
Point(s): 5 479
Moyenne de points: 0

Posté le: Mar 7 Avr - 11:48 (2009)    Sujet du message: Section scientifique : Maths, Sciences et technique -> 4ème année -> Répondre en citant

program bac2003;
uses wincrt;
type tab=array[1..51]of integer;
var t:tab;
    n,m:integer;
procedure saisirn(var n:integer);
begin
repeat
write('donner un entier');
readln(n);
until n in [6..49];
end;
procedure saisirt(var t:tab; n:integer);
var i:integer;
begin            
for i:=1 to n do
t[i]:= i;
end;
procedure saisirm(var m:integer);
begin
repeat
write('donner un entier');
readln(m);
until m<n;
end;
function nb(t:tab; n,m:integer):integer;
var k,i,j,l:integer;
begin
k:=0;
if(t[1]<>m) then begin
                      repeat
                      i:=1;
                      l:=t[i];
                      for j:=1 to l do
                      t[j]:=t[j+1];
                      t[j+1]:=l;
                      k:=k+1;
                      until t[1]=m;
                 end;
nb:=k;
end;


begin
saisirn(n);
saisirt(t,n);
saisirm(m);
write('nombre d''operation necessaire est ',nb(t,n,m));
end.


 
Revenir en haut
KARIMOS
Administrateur

Hors ligne

Inscrit le: 02 Nov 2008
Messages: 1 710
Masculin
Point(s): 5 479
Moyenne de points: 0

Posté le: Mar 7 Avr - 11:49 (2009)    Sujet du message: Section scientifique : Maths, Sciences et technique -> 4ème année -> Répondre en citant

program bac2004;
uses wincrt;
type tab=array[1..10] of string;
var t:tab;
    n:integer;
    ch:string;
procedure saisirn(var n:integer);
begin
repeat
readln(n) ;                      
until n in[2..10];
end;

procedure saisirt(var t:tab; n:integer);
var i:integer;
begin
for i:=1 to n do
repeat
readln(t[i]);
until length(t[i])=n;
end;

procedure saisir(var ch:string);
begin
repeat
readln(ch);
until length(ch)=n;
end;

function unelement(ch:string; t:tab; n:integer):boolean;
var l:boolean;
    i:integer;
begin
l:=false;
i:=1;
repeat
    if t[i]= ch then l:=true;
    i:=i+1;
until ((i>n) or (l=true));
    unelement:=l;
end;

function unelementinverse(ch:string; t:tab; n:integer):boolean;
var l:boolean;
    i:integer;
    ch1:string;
begin
     ch1:='';
     for i:=1 to length (ch) do
     ch1:= ch[i]+ch1;
l:=false;
i:=1;
repeat
    if t[i]= ch1 then l:=true;
    i:=i+1;
until ((i>n) or (l=true));
    unelementinverse:=l;
end;

function con(ch:string; t:tab; n:integer):integer;
var l:boolean;
    i,j:integer;
    ch1:string;
begin
l:=false;
i:=1;

repeat
       ch1:='';
      for j:=1 to n do
      ch1:=ch1+t[j][i];
            
    if ch1= ch then l:=true;
    i:=i+1;
until ((i>n) or (l=true));
if i>n then con:= 0 else con:=(i-1);
end;
   function coninverse(ch:string; t:tab; n:integer):integer;
var l:boolean;
    i,j:integer;
    ch1:string;
begin
l:=false;
i:=1;

repeat
ch1:='';
      for j:=1 to n do
      ch1:=t[j][i]+ch1;

    if ch1= ch then l:= true;
    i:=i+1;
until ((i>n) or (l =true));

if i > n then coninverse:= 0 else coninverse := (i - 1);
end;

begin
saisirn(n);
saisirt(t,n);
saisir(ch);
if ( unelement(ch,t,n))then writeln ('c''est un element du tableau')
 ELSE if ( unelementinverse(ch,t,n))then writeln ('c''est l''inverse d''un element du tableau')
ELSE  if ( con(ch,t,n)<>0)then writeln ('c''est la concaténation du',con(ch,t,n),'caractères des elément du tableau')
    ELSE if ( coninverse(ch,t,n)<>0)then begin write ('c''est la concaténation du',coninverse(ch,t,n));
                                          writeln('caractères des elément du tableau a l''inverse');
                                          end
    ELSE WRITE('la chaine n''existe pas');
end.


 
Revenir en haut
KARIMOS
Administrateur

Hors ligne

Inscrit le: 02 Nov 2008
Messages: 1 710
Masculin
Point(s): 5 479
Moyenne de points: 0

Posté le: Mar 7 Avr - 11:49 (2009)    Sujet du message: Section scientifique : Maths, Sciences et technique -> 4ème année -> Répondre en citant

program bac2005;
uses wincrt;
type tab=array[1..21]of char;
var t:tab;
    m,n,f,d:integer;

procedure saisim(var m:integer);
begin
repeat
writeln('donner m ');
readln(m);
until m in[10..20];
end;

procedure saisit(var t:tab;m:integer);
var i:integer;
begin
for i:=1 to m do
repeat
writeln('donner t[',i,']');
readln(t[i]);
until upcase (t[i]) in ['F','D','N'];
end;

function nb( t:tab;m:integer;c:char):integer;
var i,l:integer;
begin
l:=0;
for i:=1 to m do
if (UPCASE(t[i])=upcase(c)) then l:=l+ 1;
nb:=l;
end;

begin
saisim(m);
saisit(t,m);
n:=nb(t,m,'n');
f:=nb(t,m,'f');
d:=nb(t,m,'d');
if (n > m/2)then write('décision reportée')
else if f>d then write('décision acceptée')
else write('décision refusée');
end.


 
Revenir en haut
KARIMOS
Administrateur

Hors ligne

Inscrit le: 02 Nov 2008
Messages: 1 710
Masculin
Point(s): 5 479
Moyenne de points: 0

Posté le: Mar 7 Avr - 11:49 (2009)    Sujet du message: Section scientifique : Maths, Sciences et technique -> 4ème année -> Répondre en citant

program bac2006;
uses wincrt;
type tab=array[1..100]of integer;
var t1,t2,inter:tab;
    n,m:integer;

procedure saisin(var n:integer);
begin
repeat
write('donner n');
readln(n);
until n in[3..99];
end;

procedure saisit(var t:tab; n:integer);
var i,j:integer;
    b:boolean;
begin
for i:=1 to n do
repeat
b:=false;
write('t[',i,']');
readln(t[i]);
for j:=1 to i-1 do
if t[j]= t[i] then b:=true;
until b=false;
end;

function existe (k:integer; t:tab;n:integer):boolean;
var i:integer;
    l:boolean;
begin
l:=false;
i:=1;
repeat
if t[i]=k then l:=true;
i:=i+1;
until ((i>n) or (l=true));
existe:=l;
end;

procedure remplir(t1,t2:tab; var t3:tab; n:integer; var m:integer);
var i,j:integer;
begin
m:=0;
for i:=1 to n do
if existe(t1[i],t2,n) then begin
                                m:=m+1;
                                t3[m]:=t1[i];
                           end;
end;
 
procedure affiche(t:tab;n:integer);
var i:integer;
begin
for i:=1 to n do
write(t[i],'|');
writeln('');
end;

begin
saisin(n);
saisit(t1,n);
saisit(t2,n);
remplir(t1,t2,inter,n,m);
affiche(t1,n);
affiche(t2,n);
affiche(inter,m);
end.


 
Revenir en haut
KARIMOS
Administrateur

Hors ligne

Inscrit le: 02 Nov 2008
Messages: 1 710
Masculin
Point(s): 5 479
Moyenne de points: 0

Posté le: Mar 7 Avr - 11:50 (2009)    Sujet du message: Section scientifique : Maths, Sciences et technique -> 4ème année -> Répondre en citant

program bac2007;
uses wincrt;
var ch:string;

procedure saisich(var ch:string);
begin
repeat
write('donner une chaine');
readln(ch);
until length(ch)>5;
end;
procedure accent(var ch:string);
var i:integer;
begin
for i:=1 to length(ch) do
case ch[i] of
'à','â':ch[i]:='a';
'é','è','ê':ch[i]:='e';
'ù','û':ch[i]:='u' ;
'ô':ch[i]:='o';
'ç':ch[i]:='c';
'î':ch[i]:='i';
end;
end;
function existe(c:char;ch:string;i:integer):boolean;
var k:integer;
     s:boolean;
begin
s:=false;
k:=1;
repeat
if upcase(c)=upcase(ch[k]) then s:=true;
k:=k+1;
until ((k=i) or (s=true));
existe:=s;
end;

function lettre(ch:string):string;
var k:string;
    i,j:integer;
    s:boolean;
begin
k:='';
for i:= 1 to length(ch) do
if upcase(ch[i]) in ['A'..'Z'] then k:=k+ch[i];
 i:=2;
repeat
if existe(k[i],k,i) then delete(k,i,1)
else i:=i+1;
until i>length(k);
lettre:=k;
end;

function existe1(c:char;ch:string;i:integer):boolean;
var k:integer;
     s:boolean;
begin
s:=false;
k:=1;
repeat
if c=ch[k] then s:=true;
k:=k+1;
until ((k=i) or (s=true));
existe1:=s;
end;

function autre(ch:string):string;
var k:string;
    i,j:integer;
    s:boolean;
begin
k:='';
for i:= 1 to length(ch) do
if not(upcase(ch[i]) in ['A'..'Z']) then k:=k+ch[i];
 i:=2;
repeat
if existe1(k[i],k,i) then delete(k,i,1)
else i:=i+1;
until i>length(k);
autre:=k;
end;
begin
saisich(ch);
accent(ch);
writeln('les caracteres qui sont des lettres sans repetition sont:', lettre(ch));
writeln('les autres caractéres sont',autre(ch));
end.


 
Revenir en haut
KARIMOS
Administrateur

Hors ligne

Inscrit le: 02 Nov 2008
Messages: 1 710
Masculin
Point(s): 5 479
Moyenne de points: 0

Posté le: Mar 7 Avr - 11:50 (2009)    Sujet du message: Section scientifique : Maths, Sciences et technique -> 4ème année -> Répondre en citant

program bac2008;
uses wincrt;
var ch:string;
    l:integer;
    i:char;
procedure saisich(var ch :string);
begin
repeat
write('donner une chaine');
readln(ch);
until length(ch) in[1..100];
end;

function nb(m:char;ch:string):integer;
var i,k:integer;
begin
k:=0;
for i:=1 to length (ch) do
if upcase(ch[i])=m then k:=k+1;
nb:=k;
end;

function nb1(ch:string):integer;
var i,k:integer;
begin
k:=0;
for i:=1 to length (ch) do
if not(upcase(ch[i]) in ['A'..'Z']) then k:=k+1;
nb1:=k;
end;

begin
saisich(ch);
writeln('le nombre total des caractères est :',length(ch),'dont:');
for i:='A' to 'Z' do
begin
if (nb(i,ch)<>0) then writeln(nb(i,ch),' fois de ',i);
end;
write('et',nb1(ch),'caractères non alphabétique');
end.


 
Revenir en haut
sallem


Hors ligne

Inscrit le: 25 Nov 2008
Messages: 8
Masculin
Point(s): 85
Moyenne de points: 0

Posté le: Sam 11 Avr - 22:53 (2009)    Sujet du message: Section scientifique : Maths, Sciences et technique -> 4ème année -> Répondre en citant

merci bcq pour ce travail

 
Revenir en haut
aymen_tn


Hors ligne

Inscrit le: 10 Sep 2009
Messages: 10
Masculin
Point(s): 120
Moyenne de points: 0

Posté le: Lun 14 Sep - 13:36 (2009)    Sujet du message: Section scientifique : Maths, Sciences et technique -> 4ème année -> Répondre en citant

:ahlan: :ahlan:

 
Revenir en haut
KARIMOS
Administrateur

Hors ligne

Inscrit le: 02 Nov 2008
Messages: 1 710
Masculin
Point(s): 5 479
Moyenne de points: 0

Posté le: Jeu 29 Avr - 12:24 (2010)    Sujet du message: Section scientifique : Maths, Sciences et technique -> 4ème année -> Répondre en citant

:ahlan:

 
Revenir en haut
r.nsiri
recent membre
recent membre

Hors ligne

Inscrit le: 09 Jan 2009
Messages: 262
Masculin
Point(s): 304
Moyenne de points: 0

Posté le: Jeu 29 Avr - 22:07 (2010)    Sujet du message: Section scientifique : Maths, Sciences et technique -> 4ème année -> Répondre en citant

merci bien pour le partage Okay Okay Okay Okay Okay Okay Okay Okay Okay Okay Okay Okay
_________________
Cordialement


 
Revenir en haut
hydra55


Hors ligne

Inscrit le: 15 Aoû 2009
Messages: 1
Masculin
Point(s): 8
Moyenne de points: 0

Posté le: Sam 1 Mai - 17:12 (2010)    Sujet du message: Section scientifique : Maths, Sciences et technique -> 4ème année -> Répondre en citant

merci infiniment pour ce travail

 
Revenir en haut
riadhinfo


Hors ligne

Inscrit le: 04 Avr 2010
Messages: 1
Point(s): 1
Moyenne de points: 0

Posté le: Lun 3 Mai - 09:11 (2010)    Sujet du message: Section scientifique : Maths, Sciences et technique -> 4ème année -> Répondre en citant

Merci pour vos efforts 

 
Revenir en haut
Contenu Sponsorisé






Posté le: Aujourd’hui à 05:10 (2016)    Sujet du message: Section scientifique : Maths, Sciences et technique -> 4ème année ->

 
Revenir en haut
Montrer les messages depuis:   
bg bd
Poster un nouveau sujet   Répondre au sujet    Bac Tunisie Algorithmique et programmation : BAC INFORMATIQUE En Tunisie forum informatique Tunisie Index du Forum -> Algorithmique & programmation -> (¯`·._.·[Devoirs et séries']·._.·´¯) Toutes les heures sont au format GMT + 1 Heure
 
Page 1 sur 1

 
Sauter vers:  
Index | créer forum gratuit | Forum gratuit d’entraide | Annuaire des forums gratuits | Signaler une violation | Conditions générales d'utilisation