Массив( динамика, файлы) Опции

[punkska]

Lab3.pas

 program laba2;
uses Crt;
type
 Mas=array[1..1] of integer;
 dinmas=^mas;
var
 n:integer;
 A:dinmas;
{$I A01.inc}
{$I A02.inc}
{$I A03.inc}
{$I DUMP.inc}
begin
clrscr;
writeln('LABA 2');
writeln('+--------------+');
writeln('YC/\OBUE:');
writeln('Найти номер первого минимального элемента среди элементов больших T1,');
writeln('расположенных правее первого элемента равного T2 Упорядочить по неубыванию');
writeln('+---------------+');
writeln;

n:=takesize;
GetMem(A,sizeof(real)*n);
EnterMassive(A,n);
showMassive(A,n);

showResults(findmin(A,n));
{showResults(dump1(A,n));}

sorting(A,n);
showMassive(A,n);

writeln('+---------------+');
Freemem(A,sizeof(real)*n);
writeln('THE END.');
readln;
end. 

A01.inc

function takesize:integer;
var
 i:integer;
begin
 writeln('KO/\U4ECTBO ELEMEHTOB MACCUBA:');
 repeat
  readln(i);
 until i>0;
 takesize:=i;
end;

procedure EnterMassive(var A:dinmas; const n:integer);
var
 i:integer;
begin
 writeln;
 writeln('BBEgUTE MACCUB:');
 i:=0;
 repeat
  i:=i+1;
  write(i,' element = ');
  readln(A^[i]);
 until i=n;
end;

A03.inc

procedure ShowMassive(var A:dinmas; const n:integer);
var
 i:integer;
begin
 writeln;
 writeln('BBEgEHHb|U MACCUB:');
 i:=0;
 repeat
  i:=i+1;
  write(A^[i],' ');
 until i=n;
 writeln;
end;

procedure showResults(doJob:integer);
begin
 writeln;
 if( doJob=0 ) then
  writeln('takix elementov net')
 else
  writeln('number <0 = ',doJob);
 writeln;
end;

A02.pas

procedure sorting(var A:dinmas; const n:integer);
var
 j,i:integer;
 endof:boolean;
 add:integer;
begin
 writeln;
 writeln('COPTUPOBKA MACCUBA...');
 for i:=2 to n do
 begin
  j:=i;
  endof:=true; 
  while( j>1 ) and endof do
   if (A^[j]<A^[j-1]) then
   begin
    add:=A^[j-1];


function findmin(var A:dinmas; const n:integer):integer;

помогите с функцией findmin ..а то что-то не идёт....

[klem4]

Так у тебя она вообще не реализована на солько я вижу, что она делать должна ? искать мин элемент миссива или что ? Если Мин элемент > T1 то еще один параметр надо передавать в ф-ю ..

[punkska]

Так у тебя она вообще не реализована на солько я вижу, что она делать должна ? искать мин элемент миссива или что ? Если Мин элемент > T1 то еще один параметр надо передавать в ф-ю ..

да элемет больший T1...я думал надо как-то всё в одну функцию вбить....

[klem4]

Примерно так :

function FindMin(A : DinMas; const n : integer; T1 : integer) : integer;
var
   i,nmin : integer;
begin
   nmin := 0;
   for i := 1 to n do
      if (A^[i] > T1) and ((nmin = 0 ) or (A^[i] < A^[nmin])) then nmin := i;
   FindMin := nmin;
end;

?

[punkska]

 function findmin(var A:dinmas; const n:integer):integer;
var
 i,count:integer;
 ist,ismin:boolean;
 min:integer;
 T1, T2 :integer;
begin
 writeln;
 writeln('Vvedite element T1:');
 readln(T1);
 writeln('Vvedite element T2:');
 readln(T2);
 writeln('find nomer min elementa:');
 count:=0;
 ist:=false;
 ismin:=false;
 i:=0;
 repeat
 i:=i+1;
  if( ist=false ) then
  begin
   if( (A^[i]=T1)  then
   begin
    ist:=true;
    repeat
     if(A^[i+1]>=T2) then
     begin
      ismin:=true;
      min:=A^[i+1];
      count:=i+1;
     end;
     i:=i+1;
    until ( (i=n) or (ismin=true) );
   end;
  end
  else
  begin
   if ( (A^[i]<min) and (A^[i]>=T1) ) then
   begin
    min:=A^[i];
    count:=i;
   end;
  end;
 until i=n;
 findmin:=count;
end;

вот быстро вбил...получился бред какой-то...сам запутался ...)))

Примерно так :

мммм....надо всё в одну функцию вдолбить....вот тока что-то пока не идёт...

[klem4]

мммм....надо всё в одну функцию вдолбить....вот тока что-то пока не идёт...

1) Что все ? задания я покачто не видел
2) Зачем Вси пихать в одну функцию ?! Если так делать то вообще теряется смысл структурного посторения программы ...

Сообщение отредактировано: klem4 - 15.01.2006 17:33

[punkska]

1.

writeln('YC/\OBUE:');
writeln('Найти номер первого минимального элемента среди элементов больших T1,');
writeln('расположенных правее первого элемента равного T2 Упорядочить по неубыванию');
writeln('+---------------+'); 

2. ... так надо...нужно придумать алгоритм обработки и нахождения мин эл и тп ... наверно можно и разбить на фуекции/прцедуры...

[klem4]

'Найти номер первого минимального элемента среди элементов больших T1,'

Может надо найти первый элемент больший T1 или минимальный элемент после T1? Что значит первый минимальный

[punkska]

Может надо найти первый элемент больший T1 или минимальный элемент после T1? Что значит первый минимальный

T1=5
T2=6
[ 1 2 3 4 5 6 8 7 1 2 4 3 7]
мин = 8

т.к 7элемент > T1 и находиться правее T2

Сообщение отредактировано: punkska - 15.01.2006 18:02

[klem4]

На сколько я понял вот что тебе нужно,проверяй ...

procedure FindMin(A : DinMas; const n : integer; T1,T2 : integer) ;
var
   i : integer;
begin
   i := 1;
   while (A^[i] <> T2) and (i <= n) do inc(i);
   if i > n then begin
      writeln('no1');
      halt;
   end
     else begin
        inc(i);
        while(A^[i] <= T1) and (i <= n ) do inc(i);
        if i > n then writeln('no2')
          else writeln(i);
    end;
end;

[punkska]

ммм ни как не пойму...

вот подпрвил...тепрь и сортировка и нахождение минимального не работают=(
Посмотрите опытным глазом на код

Исходный код

program laba2;
uses Crt;
type
Mas=array[1..1] of integer;
dinmas=^mas;
function takesize:integer;
var
i:integer;
begin
writeln('KO/\U4ECTBO ELEMEHTOB MACCUBA:');
repeat
readln(i);
until i>0;
takesize:=i;
end;

procedure EnterMassive(var A:dinmas; const n:integer);
var
T1,T2:integer;
i:integer;
begin
Writeln ('Vvedite T1');
Readln(T1);
Writeln ('Vvedite T1');
Readln(T2);
writeln;
writeln('BBEgUTE MACCUB:');
i:=0;
repeat
i:=i+1;
write(i,' element = ');
readln(A^[i]);
until i=n;
end;

procedure sorting(var A:dinmas; const n:integer);
var
j,i:integer;
endof:boolean;
add:integer;
begin
writeln;
writeln('COPTUPOBKA MACCUBA...');
for i:=2 to n do
begin
j:=i;
endof:=true; {leave for?}
while( j>1 ) and endof do
if (A^[j]<A^[j-1]) then
begin
add:=A^[j-1];
A^[j-1]:=A^[j];
A^[j]:=add;
j:=j-1;
end
else
endof:=false;
end;
end;

procedure ShowMassive(var A:dinmas; const n:integer);
var
i:integer;
begin
writeln;
writeln('BBEgEHHb|U MACCUB:');
i:=0;
repeat
i:=i+1;
write(A^[i],' ');
until i=n;
writeln;
end;

procedure showResults(doJob:integer);
begin
writeln;
if( doJob=0 ) then
writeln('takix elementov net')
else
writeln('number <0 = ',doJob);
writeln;
end;

procedure FindMin(A : DinMas; const n : integer; T1,T2 : integer) ;
var
i : integer;
begin
i := 1;
while (A^[i] <> T2) and (i <= n) do inc(i);
if i > n then begin
writeln('no1');
halt;
end
else begin
inc(i);
while(A^[i] <= T1) and (i <= n ) do inc(i);
if i > n then writeln('no2')
else writeln(i);
end;
end;



var
n:integer;
A:dinmas;
T1,T2:integer;
begin
clrscr;
writeln('LABA 2');
writeln('+--------------+');
writeln('YC/\OBUE:');
writeln('Найти номер первого минимального значения среди положительных элементов,');
writeln('располоденный правее первого элемента равного нулю.Упорядочить по неубыванию');
writeln('+---------------+');
writeln;

n:=takesize;
GetMem(A,sizeof(real)*n);
EnterMassive(A,n);
showMassive(A,n);
FindMin(A,n,T1,T2);
{showResults(dump1(A,n));}

sorting(A,n);
showMassive(A,n);

writeln('+---------------+');
Freemem(A,sizeof(real)*n);
writeln('THE END.');
END.

[volvo]

А это что, должно работать? По-моему, ты должен получать GPF при запуске... Ты как с динамическими переменными обращаешься?

type
  Mas=array[1..1] of integer; { <-- Здесь - Integer !!! }
  dinmas=^mas;

...

var
  A: dinmas; { <-- Это - тоже, соответственно массив Integer-ов }
begin
  ...
  n:=takesize;
  GetMem(A,sizeof(real)*n); { <-- А это? }
  ...
end.

Даже если сбоя СЕЙЧАС не происходит - он может появиться в любую минуту...

P.S.
Кроме этого, можно поинтересоваться, чему ты ДУМАЕШЬ в процедуре FindMin равняется T1 и T2?
Смотри:

procedure EnterMassive(var A:dinmas; const n:integer);
var
  T1,T2:integer; { <-- Переменные описаны ЛОКАЛЬНО !!! }
  i:integer;
...

Локальные переменные просто уничтожаются при завершении работы процедуры, следовательно при входе в FindMin у тебя T1 = 0 и T2 = 0... Так как в массиве таких элементов нет, программа завершает работу, все логично...

[punkska]

виноват...
volvo, может подскажешь что сделать с функцией... пжауйста....

[volvo]

Читай выше, я добавил

[punkska]

Огромное СПАСИБО!!!
помог и научил как всегда!

тебе надо в подпись вставить
Я бы изменил мир, но Бог не дает исходников...

[punkska]

может кому пригодиться  Lab2.rar ( 1.42 килобайт ) Кол-во скачиваний: 257
отчёт ниже

и хотел спрасить как писать тесты...что-то почитал форум ..но так до конца и не понял! =(

Сообщение отредактировано: punkska - 15.01.2006 21:07