Не могу найти ошибку в программе. Паскаль

София · 21.05.2011, 10:54

Форумчане,помогите.Прграмма находит только процент вполнения плана первым предприятием,а у остальных пишет 0.Не могу найти ошибку.Зарание спасибо

Решить задачу,связанную с оценкой экономической деятельности группы предприятий на основе известных данных
-название предприятий
-плановый объем розничного товарооборота
-фактический объем розничного товарооборота
Требуется определить:
1)процент вполнения плана каждым предприятием
2)сумму фактического товарооборота предприятий, выполнивших план
3)наименьший фактический товарооборот
4)упорядочить предприятия по возрастанию процента выполнения плана товарооборота

Прогр.:
program otchet;
uses crt;
var
n:array [1..100] of string;
p,f,v,k,c:array [1..100] of real;
i,im,j,m:integer;
km,s,y1,sum,min:real;
y2:string;
begin
clrscr;
write('Vvedite kolichestvo predpriyatiy= ');
readln(m);
for i:=1 to m do
begin
write('Vvedite nazvanie predpriyatiya ',i,' =' );
readln(n[i]);
write('vvedite planoviy obiom roznichnogo tovarooborota= ');
readln(v[i]);
write('Vvedite fakticheskiy obiom roznichnogo tovarooborota= ');
readln(f[i]);
end;
s:=0;
km:=-999;
for i:=1 to m do
begin
k[i]:=f[i]/v[i]*100;
if k[i]<100 then s:=s+f[i];
if k[i]>km then
begin
km:=k[i];
im:=i;
end;
end;
writeln;
writeln('predpr plan fact proc');
for i:=1 to m do
writeln(n[i],' ',v[i]:10:2,f[i]:10:2,k[i]:10:2);
writeln('naib proc =',km:10:2,' u predpr ',n[im]);
sum:=0;
for i:=1 to m do
begin
If f[i]>=v[i] then
sum:=sum+f[i];
end;
readln;
Write(' summa obioma tovarooborota predpriatii vipolnivshih plan = ',sum:8:2);
readln;
min:=32000;
for i:=1 to m do
begin
If min>f[i] then
min:=f[i];
end;
readln;
Write(' naim obioma tovarooborota = ',min:8:2);
readln;

writeln;
for j:=1 to m-1 do
for i:=1 to m-j do
if k[i] > k[i+1] then
begin
y1:=v[i];
v[i]:=v[j];
v[j]:=y1;
y1:=f[i];
f[i]:=f[j];
f[j]:=y1;
y1:=k[i];
k[i]:=k[j];
k[j]:=y1;
y2:=n[i];
n[i]:=n[j];
n[j]:=y2;
end;
writeln;
writeln('sort po proc ');
for i:=1 to m do
writeln(n[i],' ',k[i]:6:2);
writeln;
end.

Vladimir_S · 21.05.2011, 20:26

Ну вот Вам точно рабочий вариант, слегка даже с косметикой. Основные недостатки Вашей программы:
1. Неправильно описан и реализован "метод пузырька". Исправлено.
2. Желательно в таких случаях использовать не раздельные массивы, а записи. Собственно, тип "запись" для подобных баз данных и предназначен. Оставлено, как есть.
3. Вывод данных желательно организовать так, чтобы независимо от длины названия предприятия, параметры располагались "в столбик". Сделано.

Код:

program otchet;
uses crt;
var
 n:array [1..100] of string;
 p,f,v,k,c:array [1..100] of real;
 i,im,j,m:integer;
 km,s,y1,sum,min:real;
 y2:string;
begin
 clrscr;
 write('Vvedite kolichestvo predpriyatiy= ');
 readln(m);
 for i:=1 to m do
  begin
   write('Vvedite nazvanie predpriyatiya ',i,' = ');
   readln(n[i]);
   write('vvedite planoviy obiom roznichnogo tovarooborota= ');
   readln(v[i]);
   write('Vvedite fakticheskiy obiom roznichnogo tovarooborota= ');
   readln(f[i]);
  end;
 s:=0;
 km:=-999;
 for i:=1 to m do
  begin
   k[i]:=f[i]/v[i]*100;
   if k[i]<100 then s:=s+f[i];
   if k[i]>km then
    begin
     km:=k[i];
     im:=i;
    end;
  end;
 writeln;
 writeln('naimen. predpr, plan, fact, proc:');
 for i:=1 to m do
  begin
   write(n[i]);
   for j:=Length(n[i])+1 to 40 do write(' ');
   writeln(v[i]:10:2,f[i]:10:2,k[i]:10:2);
  end;
 writeln;
 writeln('naib proc =',km:10:2,' u predpr ',n[im]);
 readln;
 sum:=0;
 for i:=1 to m do
  If f[i]>=v[i] then sum:=sum+f[i];
 Write('Summa obioma tovarooborota predpriatii, vipolnivshih plan = ',sum:8:2);
 readln;
 min:=32000;
 for i:=1 to m do
  If min>f[i] then min:=f[i];
 Write('naim obioma tovarooborota = ',min:8:2);
 readln;

 writeln;
 for j:=1 to m-1 do
  for i:=1 to m-j do
   if k[i]>k[i+1] then
    begin
     y1:=v[i];
     v[i]:=v[i+1];
     v[i+1]:=y1;
     y1:=f[i];
     f[i]:=f[i+1];
     f[i+1]:=y1;
     y1:=k[i];
     k[i]:=k[i+1];
     k[i+1]:=y1;
     y2:=n[i];
     n[i]:=n[i+1];
     n[i+1]:=y2;
    end;
 writeln;
 writeln('sort po proc ');
 for i:=1 to m do
  begin
   write(n[i]);
   for j:=Length(n[i])+1 to 40 do write(' ');
   writeln(k[i]:6:2);
  end;
 readln;
end.

Vladimir_S · 21.05.2011, 21:30

А здесь - вариант той же программы, но с записями. Сравните, обратив особое внимание на реализацию метода пузырька:

Код:

program otchet;
uses crt;
type
 Base=Record
  n:string;
  v:real;
  f:real;
  k:real;
 end;
var
 Predp:array [1..100] of Base;
 Pr:Base;
 i,im,j,m:integer;
 km,s,sum,min:real;
begin
 clrscr;
 write('Vvedite kolichestvo predpriyatiy= ');
 readln(m);
 for i:=1 to m do
  with Predp[i] do
   begin
    write('Vvedite nazvanie predpriyatiya ',i,' = ');
    readln(n);
    write('vvedite planoviy obiom roznichnogo tovarooborota= ');
    readln(v);
    write('Vvedite fakticheskiy obiom roznichnogo tovarooborota= ');
    readln(f);
   end;
 s:=0;
 km:=-999;
 for i:=1 to m do
  with Predp[i] do
   begin
    k:=f/v*100;
    if k<100 then s:=s+f;
    if k>km then
     begin
      km:=k;
      im:=i;
     end;
   end;
 writeln;
 writeln('naimen. predpr, plan, fact, proc:');
 for i:=1 to m do
  with Predp[i] do
   begin
    write(n);
    for j:=Length(n)+1 to 40 do write(' ');
    writeln(v:10:2,f:10:2,k:10:2);
   end;
 writeln;
 writeln('naib proc = ',km:10:2,' u predpr ',Predp[im].n);
 readln;
 sum:=0;
 for i:=1 to m do
  If Predp[i].f>=Predp[i].v then sum:=sum+Predp[i].f;
 Write('Summa obioma tovarooborota predpriatii, vipolnivshih plan = ',sum:8:2);
 readln;
 min:=32000;
 for i:=1 to m do
  If min>Predp[i].f then min:=Predp[i].f;
 Write('naim obioma tovarooborota = ',min:8:2);
 readln;

 writeln;
 for j:=1 to m-1 do
  for i:=1 to m-j do
   if Predp[i].k>Predp[i+1].k then
    begin
     Pr:=Predp[i];
     Predp[i]:=Predp[i+1];
     Predp[i+1]:=Pr;
    end;
 writeln;
 writeln('sort po proc ');
 for i:=1 to m do
  with Predp[i] do
  begin
   write(n);
   for j:=Length(n)+1 to 40 do write(' ');
   writeln(k:6:2);
  end;
 readln;
end.

София · 22.05.2011, 10:31

Спасибо!!!Огромное спасибо!!!Вы меня просто спасли!!!Спасибо!!!!!

21.05.2011, 10:54	#1 (permalink)
София Новичок Регистрация: 21.05.2011 Сообщений: 2 Сказал(а) спасибо: 0 Поблагодарили 0 раз(а) в 0 сообщениях Репутация: 10	Не могу найти ошибку в программе. Паскаль Форумчане,помогите.Прграмма находит только процент вполнения плана первым предприятием,а у остальных пишет 0.Не могу найти ошибку.Зарание спасибо Решить задачу,связанную с оценкой экономической деятельности группы предприятий на основе известных данных -название предприятий -плановый объем розничного товарооборота -фактический объем розничного товарооборота Требуется определить: 1)процент вполнения плана каждым предприятием 2)сумму фактического товарооборота предприятий, выполнивших план 3)наименьший фактический товарооборот 4)упорядочить предприятия по возрастанию процента выполнения плана товарооборота Прогр.: program otchet; uses crt; var n:array [1..100] of string; p,f,v,k,c:array [1..100] of real; i,im,j,m:integer; km,s,y1,sum,min:real; y2:string; begin clrscr; write('Vvedite kolichestvo predpriyatiy= '); readln(m); for i:=1 to m do begin write('Vvedite nazvanie predpriyatiya ',i,' =' ); readln(n[i]); write('vvedite planoviy obiom roznichnogo tovarooborota= '); readln(v[i]); write('Vvedite fakticheskiy obiom roznichnogo tovarooborota= '); readln(f[i]); end; s:=0; km:=-999; for i:=1 to m do begin k[i]:=f[i]/v[i]*100; if k[i]<100 then s:=s+f[i]; if k[i]>km then begin km:=k[i]; im:=i; end; end; writeln; writeln('predpr plan fact proc'); for i:=1 to m do writeln(n[i],' ',v[i]:10:2,f[i]:10:2,k[i]:10:2); writeln('naib proc =',km:10:2,' u predpr ',n[im]); sum:=0; for i:=1 to m do begin If f[i]>=v[i] then sum:=sum+f[i]; end; readln; Write(' summa obioma tovarooborota predpriatii vipolnivshih plan = ',sum:8:2); readln; min:=32000; for i:=1 to m do begin If min>f[i] then min:=f[i]; end; readln; Write(' naim obioma tovarooborota = ',min:8:2); readln; writeln; for j:=1 to m-1 do for i:=1 to m-j do if k[i] > k[i+1] then begin y1:=v[i]; v[i]:=v[j]; v[j]:=y1; y1:=f[i]; f[i]:=f[j]; f[j]:=y1; y1:=k[i]; k[i]:=k[j]; k[j]:=y1; y2:=n[i]; n[i]:=n[j]; n[j]:=y2; end; writeln; writeln('sort po proc '); for i:=1 to m do writeln(n[i],' ',k[i]:6:2); writeln; end.

22.05.2011, 10:31	#4 (permalink)
София Новичок Регистрация: 21.05.2011 Сообщений: 2 Сказал(а) спасибо: 0 Поблагодарили 0 раз(а) в 0 сообщениях Репутация: 10	Спасибо!!!Огромное спасибо!!!Вы меня просто спасли!!!Спасибо!!!!!

Ads
Яндекс Member Регистрация: 31.10.2006 Сообщений: 40200 Записей в дневнике: 0 Сказал(а) спасибо: 0 Поблагодарили 0 раз(а) в 0 сообщениях Репутация: 55070