Solution de probleme Informatique Bac Scientifique

Houssem

عضو نشيط
إنضم
26 نوفمبر 2005
المشاركات
149
مستوى التفاعل
39
:ahlan:

voila le probleme executable !!

كود:
program bac2009_Scientifique_theorique;
uses wincrt;
const
  min=2;
  max=20;
type
   
  tab=array [1..max] of integer;
  var
  v1,v2,v3:tab;
  n,m,c:integer;

  procedure lecture (var m,n:integer);
  var
  i:integer;
  begin
  repeat
  write('N=');
  readln(n);
  until n in [min..max];

  repeat
  write('M=');
  readln(m);
  until m in [min..max];
  end;


  procedure remplir(var t:tab; taille:integer);
  var
  i:integer;
  begin
  for i:= 1 to taille do
  repeat
  write(i, ' Taper un entier: ');
  readln(t[i]);
  until (t[i]>t[i-1]) or(i=1);

  writeln;writeln;
  end;

  procedure afficher(t:tab; taille:integer);
  var
  i:integer;
  begin
  writeln; writeln;

  for i:= 1 to taille do
  write(t[i]:4);

  writeln; writeln;
  end;

  procedure fusionner(v1,v2:tab; var v3:tab; n,m:integer; var c:integer);
  var
  i,c1,c2:integer; 
  begin
   
  c:=1;
  c1:=1;
  c2:=1;

  repeat
  if v1[c1]<v2[c2] then
  begin
  v3[c]:=v1[c1];
  c1:=c1+1;
  end
  else if v2[c2]<v1[c1] then
  begin
  v3[c]:=v2[c2];
  c2:=c2+1;
  end

  else begin
  v3[c]:=v2[c2];
  c1:=c1+1;
  c2:=c2+1;
  end ;
  c:=c+1;

  until (c1>n) or (c2>m);

  if c1>n then
  for i:=c2 to m do
  begin
  v3[c]:=v2[i];
  c:=c+1;
  end
  else
  for i:=c1 to n do
  begin
  v3[c]:=v1[i];
  c:=c+1;
  end;
end;


   

begin
  lecture(m,n);
  remplir(v1,n);
  remplir(v2,m);

  afficher(v1,n);
  afficher(v2,m);



  fusionner(v1,v2,v3,n,m,c);

  writeln('c''est bon');
  afficher(v3,c-1);


end.

الشكر لأبو فراس و سي رؤووف :kiss:
 

mouez_by

عضو مميز
إنضم
9 أفريل 2006
المشاركات
1.036
مستوى التفاعل
1.314
:ahlan:

voila le probleme executable !!

كود:
program bac2009_Scientifique_theorique;
uses wincrt;
const
  min=2;
  max=20;
type
   
  tab=array [1..max] of integer;
  var
  v1,v2,v3:tab;
  n,m,c:integer;

  procedure lecture (var m,n:integer);
  var
  i:integer;
  begin
  repeat
  write('N=');
  readln(n);
  until n in [min..max];

  repeat
  write('M=');
  readln(m);
  until m in [min..max];
  end;


  procedure remplir(var t:tab; taille:integer);
  var
  i:integer;
  begin
  for i:= 1 to taille do
  repeat
  write(i, ' Taper un entier: ');
  readln(t[i]);
  until (t[i]>t[i-1]) or(i=1);

  writeln;writeln;
  end;

  procedure afficher(t:tab; taille:integer);
  var
  i:integer;
  begin
  writeln; writeln;

  for i:= 1 to taille do
  write(t[i]:4);

  writeln; writeln;
  end;

  procedure fusionner(v1,v2:tab; var v3:tab; n,m:integer; var c:integer);
  var
  i,c1,c2:integer; 
  begin
   
  c:=1;
  c1:=1;
  c2:=1;

  repeat
  if v1[c1]<v2[c2] then
  begin
  v3[c]:=v1[c1];
  c1:=c1+1;
  end
  else if v2[c2]<v1[c1] then
  begin
  v3[c]:=v2[c2];
  c2:=c2+1;
  end

  else begin
  v3[c]:=v2[c2];
  c1:=c1+1;
  c2:=c2+1;
  end ;
  c:=c+1;

  until (c1>n) or (c2>m);

  if c1>n then
  for i:=c2 to m do
  begin
  v3[c]:=v2[i];
  c:=c+1;
  end
  else
  for i:=c1 to n do
  begin
  v3[c]:=v1[i];
  c:=c+1;
  end;
end;


   

begin
  lecture(m,n);
  remplir(v1,n);
  remplir(v2,m);

  afficher(v1,n);
  afficher(v2,m);



  fusionner(v1,v2,v3,n,m,c);

  writeln('c''est bon');
  afficher(v3,c-1);


end.

الشكر لأبو فراس و سي رؤووف :kiss:
بالنسبة لطريقة ترتيب كان من الممكن اختزالها اكثر لو استعملت

case of

بالذهاب الى محتوى الجدولين والمقارنة مباشرة مع initialisatin de v3i على v2i
 

yazid_abdelli...

عضو مميز
إنضم
22 أوت 2008
المشاركات
1.251
مستوى التفاعل
297
analyse + algorithme
non pas programme pascal
un peux de patience wtawa tji lcorrection officielle
 

kawi2006

عضو مميز
إنضم
2 أفريل 2007
المشاركات
661
مستوى التفاعل
248
il y a des autres solutions plus simplifier qui cà
en tous cas merci pour vos efforts
:satelite:
 

zouabi16

عضو فعال
إنضم
25 نوفمبر 2008
المشاركات
327
مستوى التفاعل
305
حطولنا البروبلام تو نطلعولو ألف طريقة

were is the problem i want to see it:easter:
 
أعلى