Помогите найти ошибку в программе

Новые сообщения · Правила

Страница 1 из 3 1 2 3 »
Модератор форума: Berestovskiy

Форум ПРОГРАММИСТОВ » ПРОГРАММИРОВАНИЕ » Паскаль » Помогите найти ошибку в программе (...)

У двовимірному масиві зберігається інформаціяпро зарплату n співробітників фірми щомісяця за рік (у першому стовпці - засічень, у другому - за лютий і т.п.). Визначити номер місяця з найбільшою
середньою зарплатою.

Чому не виводить максимальний місяць? Де помилився?(

№1 | Автор: Zikot4 | 2015-02-03, 23:51 | Репутация: [ + 0 ]

Задача №1.Дана строка. Удалить из нее все пробелы. Помогите здесь исправить ошибки:
Program 1;
Uses crt;
var
s1:string;
i,l:integer;
begin
clrscr;
writeln('введите строку');
readln(s1);
l:length(s1);
while(pos(' ',s1)=1) do delete(s1,1,1);
writeln('строка без пробелов');
write(s1);
end.

Задача №2. Вычислить y=∑ 1/i

Задача №3. Найти, сколько элементов массива удовлетворяет условию: c<=a[i]<=d

№2 | Автор: MetalHeart | 2015-02-03, 23:51 | Репутация: [ + 0 ]

Code

Program metod_prostyh_iteraciy;
uses crt;
const Eps=1E-15;
var M,x1,x2,x0,q,a,b:real;
     i,n,k:integer;
function fi(x:real):real;
begin
  fi:=8*(-sin(x))-1;
end;

begin
   writeln('isxodnaia f-cia  f=8*cos(x)-x-6');
   write('a=');readln(a);
   write('b=');readln(b);
   n:=round((b-a)/0.01+1);
   x1:=a;
   q:=abs(fi(x1));
    for i :=2 to n do
     begin
      x1:=x1+0.01;
       if abs(fi(x1))>q then q:=abs(fi(x1));
     end;
      writeln('qmax=', q:0:15);
    k:=1;
    repeat
     x2:=fi(x1);
     k:=k+1;
     M:=abs(x2-x1);
    until
   M<=Eps*(1-q)/q;
   x0:=x2;
   writeln('x0=',x0:0:15);
   writeln('k=',k:0);
end.

Программа вычисляет q, выводит qmax и останавливается, ничего сделать нельзя она рпосто стоит. ПРиходится выходить в виндовс и перезапускать паскаль.

№3 | Автор: president_ml | 2015-02-03, 23:51 | Репутация: [ + 0 ]

Нашел в нете, вставил - ошибка, нашел в источнике - с процедурами ничего не понял.. Помогите, очень надо..

program pokoord;
uses crt;

type VEC=array [1..8] of real;
var E,E1,R:real; I,J,N:integer; Z,Z0,Z9,Z1:VEC;
Function F (X:real):real; (*минимизируемая функция*)
begin Z[i]:=X;
R:=0.9397*Z[1]+0.342*Z[2];
F:=R;
end;
Procedure GOLD(A,B,E:real; var X:real; Function F(X:real):real); (*золотое сечение*)
const G=0.618034;
var X1,X2,F1,F2,F3,R:real;
begin R:=(B-A)*G; X1:=A+R; F1:=F(X1); X2:=B-R; F2:=F(X2);
while R>E do begin R:=R*G;
if F1<F2 then begin
X:=X2+R; X2:=X1; F2:=F1; F1:=F(X); X1:=X
end else begin
X:=X1-R; X1:=X2; F1:=F2; F2:=F(X); X2:=X
end
end
end;
Procedure COORD (N:integer; E,E1:real; var i:integer; var Z,Z0,Z9,Z1:VEC); (*покоординатный спуск*)
var L:integer; X:real;
begin
for i:=2 to N do Z[i]:=Z1[I];
repeat L:=0;
for i:=1 to N do begin GOLD (Z0[i],Z9[i],E1,X,F);
if abs(X-Z1[i])>E then L:=1; Z1[i]:=X
end
until L=0
end;
Begin (*основная программа*)
clrscr;
repeat write('N,E,E1?'); readln(N,E,E1);
for i:=1 to N do begin write('Z0,Z9,Z1 -',I:1,'?');
readln(Z0[i],Z9[i],Z[i])
end;
COORD (N,E,E1,I,Z,Z0,Z9,Z1);
for i:=1 to N do writeln ('Z(',I:1,')=',Z1[i]);
writeln ('F=',R);
until false
readkey;
End.

№4 | Автор: Deim | 2015-02-03, 23:51 | Репутация: [ + 0 ]

подалуйста помоги,эта программа работает но результат не тот..я не знаю что делать((
проверь пожалуйста через программу!((

дана матрица размером n*m
найти номер ее столбца с наименьшим произведением элементов и вывести ее данный номер и его значение
______________________________________________________________________________

Prodram X;
const
Nmax=5;
Mmax=5;
Var
p,n,m,i,j,Pmin:integer;
A:array[1..Nmax,1..Mmax] of integer;
B:array[1..Mmax] of integer;
begin
Write('n=');
ReadLn(n);
write('m=');
ReadLn(m);
For i:=1 to n do
for j:=1 to m do begin
Write('a[',i,',',j,']=');
ReadLn(a[i,j]);
End;
for i:=1 to n do begin
for j:=1 to m do
Write(A[i,j], ' '); в апострофах пробел
WriteLn;
End;
for j:=1 to m do
b[j]:=0;
for i:=1 to n do
for j:=1 to m do
P:=p*a[i,j];
Pmin=b[i];
for i:=2 to n do begin
if pmin <b[i] then Pmin=b[i];
if pmin>p then begin pmin:=p;
End;
for J:=1 to m do
WriteLn('столбец с наименьшим произведением',P);
Readln(p);
WriteLn('значение этого столбца',pmin0;
readLn(Pmin);
End;
readLn;
End.

№5 | Автор: natasha-karacharova | 2015-02-03, 23:51 | Изменено: natasha-karacharova - Сб, 2011-05-14, 20:39 | Репутация: [ + 0 ]

пожалуйста помогите найти ошибку в программе для поиска образа в строке с помощью КМП алгоритма. программа работает верно. все находит правильно но почему то та строка вывода которая стоит после ELSE иногда выходит несколько раз. думаю что это из за бегинов и ендов которые ставить я пока не очень умею, ну или из за неправильно использованной togo. помогите исправить ошибку.
uses crt;
var f:array[1..100] of integer;
s,s1:string;
i,k:integer;
label vse;
begin
clrscr;
writeln('Poisk obraza v stroke KMP algoritm');
write('Vvedite stroku simvolov: ');
readln (s);
write('Vvedite iskomyi nabor simvolov (obraz): ');
readln (s1);
f[1]:=0;
k:=0;
for i:=2 to length(s1) do
begin
while (k>0) and (s1[k+1]<>s1[i]) do
k:=f[k];
if s1[k+1]=s1 [i]then
inc(k);
f[i]:=k;
end;
k:=0;
for i:=1 to length(s) do
begin
while(k>0) and(s1[k+1]<>s[i]) do
k:=f[k];
if s1[k+1]=s [i]then
inc(k);
if k=length(s1) then
begin
write('Podstroika ', s1, ' na meste ', (i-length(s1)+1), ''); goto vse;
end
else write('Net takoi podstroiki');
end;
vse:
readln;
end.

Добавлено (19.01.13, 21:25)
---------------------------------------------
Я разобрался!!!!)
uses crt;
var f:array[1..100] of integer;
s,s1:string;
i,k:integer;
begin
writeln('Poisk obraza v stroke KMP algoritm');
write('Vvedite stroku simvolov: ');
readln (s);
write('Vvedite iskomyi nabor simvolov (obraz): ');
readln (s1);
f[1]:=0;
k:=0;
for i:=2 to length(s1) do
begin
while (k>0) and (s1[k+1]<>s1[i]) do
k:=f[k];
if s1[k+1]=s1 [i]then
inc(k);
f[i]:=k;
end;
k:=0;
for i:=1 to length(s) do
begin
while(k>0) and(s1[k+1]<>s[i]) do
k:=f[k];
if s1[k+1]=s [i]then
inc(k);
if k=length(s1) then
begin
write('Podstroika ', s1, ' na meste ', (i-length(s1)+1), '');
break;
end;
end;
if k<>length(s1) then write('Net takoi podstroiki');
readln;
end.

№6 | Автор: midoze | 2015-02-03, 23:51 | Репутация: [ + 0 ]

program polysort; {многофазная сортировка с n-лентами}
const n=6; {число лент}
type item= record
key:integer;
end;
tape = file of item;
tapeno=1..n;

var leng,rand:integer; {используются для формирования файла}
eot:boolean;
buf:item;
fo:tape; {fo - входная лента со случайными числами}
f:array [1..n] of tape;

procedure list (var f:tape; n:tapeno);
var z: integer;

begin
z:=0;
writeln('tape',n:2);
while not eof(f) do
begin read (f,buf);
write('output', buf.key :5);
z:=z+1;
if z = 25 then
begin writeln ('output'); z:=0
end;
end ;
if z <> 0 then Writeln('output'); reset(f)
end {list} ;
procedure polyphasesort;
var i,j,mx,tn: tapeno;
k, level: integer;
a, d: array [tapeno]of integer;
{а[j]-идеальное число серий на ленте j}
{d[j]-число фиктивных серий на ленте j }
dn,x,min,z: integer;
last: array [tapeno]of integer; {last[i]-Kлюч конечной серии на ленте j}
t,ta: array [tapeno]of tapeno; {карты номеров Аент}

procedure selecttape;
var i: tapeno; z: integer;
begin
if d [j]< d[j+1] then j := j+1 else
begin if d[j]= 0 then
begin level:= level + 1; z:=a[1];

for i:= 1 to n-1 do
begin d [i]:= z + a[i+1]-a[i];
a[i]:=z + a[i+1] end;
end ;
j:= 1 ;
end ;
d [j]:= d[j]-1;
end ;
procedure copyrun;
begin {перепись одной серии c fO на ленту j}
repeat read(fo, buf); write(f[j], buf);
until eof(fo) and (buf.key > fo^.key);
last [j]:= buf.key end ;
begin {распределение начальных серий}
for i := 1 to n-1 do
begin a [i]:= 1; d [i]:= 1: rewrite(f[i]) end ;
level:= 1; j:= 1; a[n]:= 0; d[n]:= 0;
repeat selecttape, copyrun;
until eof(fo) and (j=n-1);
while not eof(f) do
begin selecttape; copyrun
if last[j<=fo^.key then
begin {продолжение прежней серии}
copyrun;
if eof(fo) then d [j]:= d [j]+ 1 else copyrun
end
else copyrun end ;
for i := 1 to n-1 do reset(f[i]);
for i:= 1 to n do t [i]:= i;
Repeat {слияние с t[1] ...t[n- 1] Ha t[n]}
z := a[n-1]; d [n]:= 0; rewrite(f[t[n]]);
repeat к := 0; {слияние одной серии}
for i := 1 to n-1 do
if d [i]> 0 then d [i]:= d[i]-1 else
begin к := k+1; ta [k]:= t[i];
end ;
if k = 0 then d [n]:= d [n]+ 1 else
begin {слияние одного действительного отрезка c t[l]..t [k]}

repeat i:=1; mx := 1;
min := f[ta[1]]^.key;
while i < k do
begin i:= i+1; x := f[ta[i]]^.key;
if x < min then
begin min : = x; mx := i ;
end ;end ;
{ ta [mx]содержит наименьший элемент, пересылка его на t[n]}
read(f[ta[mx]], buf); eot := eof(f[ta[mx]]);
write(f[t[n]], buf);
if (buf .key > f[ta[mx]].key) and eof then
begin {сброс этой ленты}
ta [mx]:= ta[k]; k := k-l ;
end;
until k = 0 end ;
z:= z-1
until z = 0;
reset(f[t[n]]; list(f[t[n]],t[n]);{ переключение ты}
tn := t[n]; dn := d[n]; z := a[n- 1];
for i := n downto 2 do
begin t[t]:=t[i-1]; d [i]:= d[i-1]; a[i]:=a[i-1] - z ;
end ;
t[1] := tn; d [i]:= dn;a[1]:=z; { отсортированный файл находится на t[l]}
list(f[t[1]],t[1]); level := level - 1 ;
until level = 0; end ; {polyphasesort }

begin {формирование случайного файла}
leng :=200; rand := 7789;
repeat rand :=(131071 *rand) mod 2147483647;
buf.key := rand div 2147484; wite(fo, buf);
leng:= leng - 1 ;
until leng = 0;
reset(fo); list(fo, 1);
end.

№7 | Автор: ostryak5 | 2015-02-03, 23:51 | Репутация: [ + 0 ]

Никак не могу понять, почему программа, выводящая на экран тип ПК, не хочет запускаться.
Компилятор говорит, на ошибок нет, но программа не запускается.
Program kod;
uses crt;
var
sss,ss:string;
a:array[0..8] of integer;
slovo,s,i:integer;
function dva:integer;
var
s,s1,s2,s3:integer;
begin
s1:=(a[1]+a[3]+a[5]+a[7]) mod 2;
s2:=(a[2]+a[3]+a[6]+a[7]) mod 2;
s3:=(a[4]+a[5]+a[6]+a[7]) mod 2;
if (s1=1) or (s2=1) or (s3=1) then
begin
s:=s1+s2*2+s3*4;
writeln('oshibka dopushena v pozitcii nomer ',s)
end
else
writeln('oshibok net');
end;
{BEGIN}
procedure podschet;
var
j,p,i,d,m,s:integer;
begin
slovo:=1;
writeln('vvedite posledovatelnost is 0 i 1');
readln(ss);
p:=1;
while (p+6)<=length(ss) do
begin
j:=p;
for i:=j to j+6 do
begin
val(ss[i],d,m);
a[i]:=d;
p:=p+7;
end;
end;
end;
BEGIN
while length(ss)>=7 do
begin
i:=0;
sss:=copy(ss,1,7);
delete(ss,1,7);
while s<length(ss) do
begin
podschet;
i:=i+1;
end;
writeln('dlya ',slovo,'slova:',sss);
slovo:=slovo+1;
readln;
dva;
end;
end.

№8 | Автор: lenaG | 2015-02-03, 23:51 | Репутация: [ + 0 ]

Ребята, помогите, пожалуйста, сделать задание. Несколько дней билась, но получается не совсем правильно.

Постановказадачи. Написать программу для изображения Октаэдра, вращающегосявокруг оси ОY. Ось вращения не должна совпадать с собственной вертикальной осью
фигуры. Применить диметрию.
Описаниеметода решения задачи. Для создания фигурыуказываем координаты вершины и порядок их соединения через ребра. С фигурой
осуществляются преобразования через матрицу 4*4

program octahedron;
uses crt,graph;
type point_position = array [1..3] of real;
type side_position = array [1..3] of point_position;
type oct_coord = array [1..8] of side_position;
const Color: array[1..8] of Integer = (1,2,3,4,5,6,9,10);
{фигура Октаэдр}
const oct: oct_coord= (((100,100,60),(50,100,-40),(100,50,-40)),
((100,100,60),(50,100,-40),(100,150,-40)),
((100,100,-140),(100,50,-40),(50,100,-40)),
((100,100,-140),(100,150,-40),(50,100,-40)),
((100,100,-140),(150,100,-40),(100,50,-40)),
((100,100,-140),(100,150,-40),(150,100,-40)),
((100,100,60),(100,50,-40),(150,100,-40)),
((100,100,60),(150,100,-40),(100,150,-40)));
const p=-0.002;
var
pcos,psin:real;
oct_new,oct_old:oct_coord;
dv,mv,x0, y0: integer;

procedure init;
var i,j,k:integer;

begin
x0 := getMaxX div 2;
y0 := getMaxY div 2;
for i:=1 to High(oct) do
for j:=1 to High(oct) do
for k:=1 to High(oct[i,j]) do
begin
oct_new[i,j,k] := oct[i,j,k];
oct_old[i,j,k] := oct[i,j,k];
end;

end;
{алгоритм робертса}
function robert(side:side_position):boolean;
var
a,b,c:real;
i,j:integer;
begin
c:=0;
robert:=true;
for i:=1 to high(side) do
begin
if i=high(side) then j:=1
else j:=i+1;

c:=c+(side[i,1]-side[j,1])*(side[i,2]+side[j,2]);
end;
if c<=0 then robert:=false;

end;
{процедура получения перспективы в одной точке схода}
procedure modif(x,y,z:real;var x1,y1,z1:real);
begin
x1:=x/(p*y+1);
y1:=y/(p*y+1);
z1:=z/(p*y+1);
end;
{прорисовка/стирание октаэдра в зависимости от флага new}
procedure draw_oct(new: boolean;figure:oct_coord);
var
i,j,k:integer;
area: array [1..3] of PointType;
new_side:side_position;
begin
setcolor(0);
for i:=1 to high(oct_new) do
begin
for k:=1 to high(new_side) do
begin
modif(figure[i,k,1], figure[i,k,2], figure[i,k,3],
new_side[k,1],new_side[k,2],new_side[k,3]);
end;
if robert(new_side) then
if new then setFillStyle(solidfill, Color)
else setFillStyle(solidfill, 0);
for j:=1 to High(new_side) do
begin
area
.X :=x0+ round(new_side[j,1]);
area
.Y := round(new_side[j,2]);
end;
fillpoly(sizeOf(area) div sizeOf(pointtype),area);
end;
end;

{поворот октаэдра}
procedure rotate;
var
i, j: integer;
x_new, z_new: real;
begin
for i:=1 to High(oct_new) do
for j:=1 to High(oct_new[1]) do
begin
oct_old[i,j,1] := oct_new[i,j,1];
oct_old[i,j,3] := oct_new[i,j,3];
x_new:=oct_new[i,j,1]*pcos-oct_new[i,j,3]*psin;
z_new:=oct_new[i,j,1]*psin+oct_new[i,j,3]*pcos;
oct_new[i,j,1]:=x_new;
oct_new[i,j,3]:=z_new;
end;
end;
{основная часть программы}
begin
pcos:=cos(0.05);
psin:=sin(0.05);
dv := detect;
initGraph(dv,mv,'');
init;
repeat
rotate;
draw_oct(false,oct_old);
draw_oct(true,oct_new);
delay(100);
until keypressed;
closegraph;
end.

№9 | Автор: Alexandra | 2015-02-03, 23:51 | Репутация: [ + 0 ]

Дан код, в котором не синтаксических ошибок.Нужно найти и исправить признаки плохого кода(например:Дублирование,сложность методов).Как можно избавиться от большого количества условии IF ,WHILE

Код

1   var
2   ...
3   begin
4   ...
5
6   Result:= Date;
7   K:= Abs(Number);
8
9    // Если дата не задана – прервать вычисления
10   if Date = ''
11   then
12     Exit();
13
14    // Если разница равна 0, не изменять дату
15   if K = 0
16   then
17   Result:= Date
18   else
19   begin
20   // Определить знак разницы
21   if Number > 0 then Sign:= 1 else Sign:= -1;
22
23   // Цикл по количеству дней
24   I:= 1;
25   Date2:= Date;
26   while I <= K do
27   begin
28   Date2:= DateAdd('d'; Date2; Sign);
29   Holiday:= DateIsHoliday(Date2);
30    // Пока день выходной или праздничный, увеличивать общее количество дней на 1
31   while Holiday = True do
32   begin
33   inс(K);
34   inс(I);
35   Date2:= DateAdd('d'; Date2; Sign);
36   Holiday:= DateIsHoliday(Date2);
37   end
38   inс(I);
39   end
40   Result:= Date2;
41   end
42   end

№10 | Автор: gul | 2015-02-03, 23:51 | Репутация: [ + 0 ]

Создайте файл f, компоненты которого являются действительными числами. Составите программу вычисления разности между первым и последним компонентом файла f. Выясните, совпадает ли найденная разность с полусуммой наибольшего и наименьшего компонентов этого файла.
Сказали надо заменить random и не правильно считает что именно не правильно они не

Var
f:file of Real;
i,N:Byte;
A,Max,Min,First,Last:Real;

Begin
Randomize;
N:=50+Random(100);
Assign(f,'C:\Users\fig\Desktop\ Новый текстовый документ.txt');
Rewrite(f);
For i:=1 to N do
begin
A:=(Random-0.3)*100;
Write(f,A);
end;
Close(f);
Reset(f);
Read(f,First);
Min:=First;
Max:=First;
Repeat
if not EoF(f) then
begin
Read(f,Last);
If Last>Max then Max:=Last;
If Last<Min then Min:=Last;
end;
Until EoF(f);
Close(f);
Writeln('Max-Min = ',Max-Min:0:3);
Writeln('(First+Last)/2 = ',(First+Last)/2:0:3);
If (Max-Min)=((First+Last)/2) then
Writeln('Coincides!')
else
Writeln('Not coincides!');
Readln
End.

№11 | Автор: ВАно | 2015-02-03, 23:51 | Репутация: [ + 0 ]

Помогите пожалуйста поправить программу. "Дана матрица размером N * M. Выполнить сдвиг элементов каждой строки влево на количество элементов соответствующее номеру строки.
program abc;
var A:array[1..20,1..50] of integer;
i,j,k:integer;
n, m, buf:integer;
begin
cls;
writeLn ('Вводим масси А:');
writeln('n=,m=');
readln(n ,m);
for i:=1 to n do
for j:=1 to m do
begin
a[i,j]:=random(20);
end;
writeln ('Исходный массив а:');
for i:=1 to n do
begin
for j:=1 to m do
write(A[i,j]:5);
writeLn;
end;
for i:=1 to n do
for j:=1 to m do
a[i,m+1]:=a[i,1];
for i:=1 to n do
for j:=1 to m do
a[i,j]:=a[i,j+i];
writeln('Массив со сдвигом влево');
for i:=1 to n do
begin
for j:=1 to m do
write(A[i,j]:5);
writeLn;
end;
end.

№12 | Автор: Григорий-_1 | 2015-02-03, 23:51 | Изменено: Григорий-_1 - Пн, 2014-12-15, 21:18 | Репутация: [ + 0 ]

Переделывала код из бейсика на паскаль в лазарус, но код не работает, в чём может быть ошибка

Код Бейсика

№13 | Автор: Тимила | 2015-02-03, 23:51 | Изменено: Тимила - Пн, 2014-12-22, 15:30 | Репутация: [ + 0 ]

const N=4; a=0; b=6,283eps=0,00001;
var x1, h, integral: real;
h1:integer;
function f(x1;real):real;
begin
f: sin(x1);
end;
function int(h1:real):real;
var i: integer;
x2,sum: real;
begin
{sum:=(f(a)+f(b))*h\2;}
sum:=0;
while x2<=b do
begin
sum:= sum+ f(x2);
x2:=x2+h;
end;
sum:= sum*h1+(f(a)+f(b))*h1\2;
int:=sum;
end;
h:=(b-a)\N;
n1:=n;
while ABS (int(h)- int(h\2))>eps do
begin
h:=n1*2;
end;
writeln(int h,' ',n1);
end.
Помогите пожалуйста восстановить условие задачи.

№14 | Автор: Udalowam | 2015-02-03, 23:51 | Репутация: [ + 0 ]

1. на ошибки не смотрел, но делал бы самым простым способом - через вторую строку, в которую добавлял все элементы первой без пробелов:

Code

for i:=1 to length(s1) do
if s1[i]<>' ' then
s2:=s2+s1[i];
s1:=s2;

2. смотря какое будет значение i. Но если особо не заморачиваться и i будет не большое то можно просто циклом. При больших значениях результат каждой следующей итерации будет всё ближе к нуля и там возможны варианты, связанные с точностью. Самое простое это вот:

Code

readln(i);
for n:=1 to i do
s:=s+1/i;

3. совсем простое уж:

Code

for i:=1 to n do {n - количество элементов массива}
if (a[i]>=c) and (a[i]<=d) then
k:=k+1;

компилятором не тестировал, сам проверишь.

If you can't make it GOOD make it LOOK GOOD. B.Gates

№15 | Автор: DoVe | 2015-02-03, 23:51 | Репутация: [ + 48 ]

У вас в цикле Repeat - Until x1 и x2 не меняются ни как, соответственно программа зацикливается.
Возможно не хватает строки вроде: x1:=x2;?

№16 | Автор: Fireleo | 2015-02-03, 23:51 | Репутация: [ + 30 ]

Найди код к этому-же заданию, только другой, потому-что часто пишут коды на форумах не компилируя у себя, а сразу в сообщении..

Нужна помощь? Сюда: vkontakte.ru/berestovskiy

№17 | Автор: Berestovskiy | 2015-02-03, 23:51 | Репутация: [ + 211 ]

var
a:array[1..10,1..10]of byte;
n,m,i,j,p,pmin,c:integer;
begin
read(n,m);p:=1;pmin:=32000;
for i:=1 to n do
for j:=1 to m do
read(a[j,i]);
for i:=1 to n do begin
for j:=1 to m do
p:=p*a[i,j];
if pmin>p then begin pmin:=p;c:=i;end;
p:=1;end;
writeln('Столбец с наименьшим произведением: ',c);
write('Значение этого столбца: ',pmin);
end.

"Спасибо" принимается повышением репутации ( Зелёный плюсик:) ). Спасибо

Нужна помощь? Сюда: vkontakte.ru/berestovskiy

№18 | Автор: Berestovskiy | 2015-02-03, 23:51 | Репутация: [ + 211 ]

Может ты не так как-то запускаешь?)

Нужна помощь? Сюда: vkontakte.ru/berestovskiy

№19 | Автор: Berestovskiy | 2015-02-03, 23:51 | Репутация: [ + 211 ]

пробуй следующее

Код

program abc;
var A:array[1..20,1..50] of integer;
i,j,k:integer;
n, m, buf:integer;
begin
cls;
writeLn ('Вводим массив А:');
writeln('n=,m=');
readln(n ,m);
for i:=1 to n do
           for j:=1 to m do begin
               a[i,j]:=random(20);
           end;
writeln ('Исходный массив а:');
for i:=1 to n do begin
       for j:=1 to m do
           write(A[i,j]:5);
       writeLn;
end;
for i:=1 to n do
           for j:=1 to m do
               a[i,j]:=a[i,j+i];
writeln('Массив со сдвигом влево');
for i:=1 to n do begin
       for j:=1 to m do
           write(A[i,j]:5);
       writeLn;
end;
end.

и зачем по два раза гонять массив для заполнения и вывода, а потом еще для смещения элементов и вывода, если можно сразу выводить элементы?

Код

program abc;
var A:array[1..20,1..50] of integer;
i,j,k:integer;
n, m, buf:integer;
begin
cls;
writeLn ('Вводим масси А:');
writeln('n=,m=');
readln(n ,m);
writeln ('Исходный массив а:');
for i:=1 to n do begin
      for j:=1 to m do begin
          a[i,j]:=random(20);
          write(a[i,j]:5);
      end;
      writeLn;
end;
writeln('Массив со сдвигом влево');
for i:=1 to n do begin
      for j:=1 to m do begin
          a[i,j]:=a[i,j+i];
          write(A[i,j]:5);
      end;
      writeLn;
end;
end.

№20 | Автор: =GR@VЕ= | 2015-02-03, 23:51 | Изменено: =GR@VЕ= - Ср, 2014-12-17, 00:36 | Репутация: [ + 0 ]

Форум ПРОГРАММИСТОВ » ПРОГРАММИРОВАНИЕ » Паскаль » Помогите найти ошибку в программе (...)

Страница 1 из 3
1
2
3
»

прикладная математика