Помощь - Поиск - Пользователи - Календарь
Полная версия: Массив( динамика, файлы)
Форум «Всё о Паскале» > Pascal, Object Pascal > Задачи
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
Цитата(klem4 @ 15.01.2006 17:10) *

Так у тебя она вообще не реализована на солько я вижу, что она делать должна ? искать мин элемент миссива или что ? Если Мин элемент > 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;


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

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

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


1) Что все ? задания я покачто не видел
2) Зачем Вси пихать в одну функцию ?! blink.gif Если так делать то вообще теряется смысл структурного посторения программы ...
punkska
1.
writeln('YC/\OBUE:');
writeln('Найти номер первого минимального элемента среди элементов больших T1,');
writeln('расположенных правее первого элемента равного T2 Упорядочить по неубыванию');
writeln('+---------------+');


2. ... так надо...нужно придумать алгоритм обработки и нахождения мин эл и тп ... наверно можно и разбить на фуекции/прцедуры...
klem4
Цитата
'Найти номер первого минимального элемента среди элементов больших T1,'


Может надо найти первый элемент больший T1 или минимальный элемент после T1? Что значит первый минимальный
punkska
Цитата(klem4 @ 15.01.2006 17:54) *

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

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

т.к 7элемент > T1 и находиться правее T2
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.


unsure.gif wacko.gif
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
unsure.gif виноват...
volvo, может подскажешь что сделать с функцией... пжауйста....
volvo
Читай выше, я добавил
punkska
Огромное СПАСИБО!!!
помог и научил как всегда! good.gif

тебе надо в подпись вставить
Я бы изменил мир, но Бог не дает исходников...
smile.gif good.gif
punkska
может кому пригодиться Нажмите для просмотра прикрепленного файла отчёт ниже

и хотел спрасить как писать тесты...что-то почитал форум ..но так до конца и не понял! =(
Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.