rsmms
Newbie | Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
Здравствуйте! Уважаемые специалисты, посмотрите пожалуйста, что в этих программах не так. Спасибо.
Подробнее...
Добавлено:
Здравствйте, уважаемые специалисты! Посмотрите пожалуйста, что не так в этих задачах?
Руководство фирмы анализирует работу за последние К лет. Одна из задач, кото-рая решается, заключается в определении самого длительного промежутка времени, в тече-ние которого некий обобщенный показатель М работы фирмы был постоянный. Написать программу определения и вывода на экран данного временного интервала (указать год нача-ла и год конца данного участка).
Код:
program_4;
uses crt;
type
rec=record;
god: integer;
M: real;
end;
const MAXP=30;
var
Mas: array[1..MAXP] of Rec;
N: integer;
YO, YT: integer;
i, j, d: integer;
IskY, IskD: integer;
f: boolean;
begin
clrscr;
write('Vvedite god nachala analiza: ');
readln(YO);
repeat
write('Vvedite prodolgitelnost sroka analiza (ne bolshe',MAXP,' let): ');
readln(N);
if (N<1) or (N>MAXP) then
writeln('Vvedeno nedopustimoe znachenie');
until(N>=1) and (N<=MAXP);
clrscr;
writeln('Vvod xnachenia parametra M za razlichnye goda');
for i:=1 to N do
begin
mas[i].God:=YO+i-1;
write('Vvedite znachenie M za', Mas[i].God,'god');
readln(mas[i].M);
end;
IskY:=1;
IskD:=1;
d:=1;
f:=false;
for i:=2 to N do
begin
if Mas[i].M=Mas[i-1].M then
begin
if f=false then
begin
f:=true;
d:=2;
YT:=i-1;
end;
else
d:=d+1;
end;
else
if f=true then
begin
f:=false;
if d>IskD then
begin
IskD:=D;
IskY:=YT;
end;
d:=1;
end;
end;
if(f=true) and (d>IskD) then
begin
IskD:=d;
IskY:=YT;
end;
write('Samyi dlinnyi period postoyanstva M: ');
write(Mas[IskY].God,'-:-');
writeln(Mas[IskY+IskD-1].God);
writeln('pri M=', Mas[IskY].M:7:2);
readln;
end.
|
Создать типизированный файл, элементами которого являются целые числа. Про-грамма должна содержать встроенную подпрограмму-функцию для организации безопасного ввода целых чисел. Прочитать файл в массив, размещаемый в динамической памяти. Найти произведение отрицательных элементов массива.
Код:
program_5;
uses crt;
type
FInt=File of integer;
Str60=string[60];
Dim=array[1..1000] of integer;
function inp_file(filename: str60; n: integer): boolean;
var
f: FInt;
i, tmp: integer;
begin
assign(f,filename);
{$I-}
rewrite(f);
if IOResult<>0 then
inp_file:=false
else
begin
for i:=1 to n do
begin
write(i,'chislo: ');
read(tmp);
write(f,tmp);
end;
end;
var
F: Fint;
i,n: integer;
fname: str60;
A: ^DIM;
proizv: longint;
begin
clrscr;
write('Vvedite imya sozdavaemogo faila: ');
readln(fname);
repeat
write('Vvedite kol-vo chisel: ');
readln(n);
until (n>0) and (n<=1000);
if (inp_file(fname,n)=false) then
begin
writeln('Ne udalos sozdat fail dannyh');
exit;
end;
else
begin
readln;
GetMem(A, n*sizeof(integer));
assign(f,fname);
reset(f);
for i:=1 to n do
read(f, A^[i]);
close(f);
writeln('Is faila',fname,'v massiv schitany chisla: ');
proisv:=1;
for i:=1 to n do
begin
write(A^[i]:6);
if A^[i]<0 then
proizv:=proizv*A^[i];
end;
writeln;
writeln('Proizvedenie otric. elementov: ',proizv);
FreeMem(A, n*sizeof(integer));
writeln;
end;
readln;
end.
|
Написать рекурсивную функцию сложения двух чисел, используя только прибав-ление единицы.
Код:
program_6;
use crt;
function sum(a,b: integer): integer;
begin
if b=0 then
sum:=a
else
if b<0 then
sum:=sum(a-1, b+1)
else
sum:=sum(a+1, b-1);
end;
var
a,b,s: integer;
begin
clrscr;
write('a=');
readln(a);
write('b=');
readln(b);
s:=sum(a,b);
writeln('a+b=',s);
readln;
end.
|
Создайте две произвольные очереди Q и Р. Добавьте из очереди Р в очередь Q три элемента. Выведите очередь Q на экран.
Код:
program_7;
uses crt;
type
PtrNode=^Node;
Node=record;
Info: integer;
Next: PtrNode;
end;
procedure prn_q(G: PtrNode);
var
y: PtrNode;
begin
t:=G;
while t<>Nil do
begin
write(t^.info:5);
t:=t^.Next;
end;
var
Q,P: PtrNode;
HQ,HP: PtrNode;
Tek: PtrNode;
n1,n2,i: integer;
begin
clrscr;
Q:=Nil;
HQ:=Nil;
repeat
write('Vvedite kol-vo elementov v ocheredi Q:');
readln(n1);
until n1>0;
i:=0;
while i<n1 do
begin
New(Tek);
Tek^.Next:=random(100);
Tek^.Next:=Nil;
if Q=Nil then
begin
Q:=Tek;
HQ:=Tek;
end;
else
begin
HQ^.Next:=Tek;
HQ:=Tek;
end;
i:=i+1;
end;
writeln('Sozdana ochered Q:');
prn_q(Q);
P:=Nil;
HP:=Nil;
repeat
write('Vvedite kol-vo elementov v ocheredi P (ne menche 4): ');
readln(n2);
until n2>=4;
i:=0;
while i<n2 do
begin
New(Tek);
Tek^.Info:=random(100);
Tek^.Next:=Nil;
if P=Nil then
begin
P:=Tek;
HP:=Tek;
end;
else
begin
HP^.Next:=Tek;
HP:=Tek;
end;
i:=i+1;
end;
writeln('Sozdana ochered P: ');
prn_q(P);
for i:=1 to 3 do
begin
Tek:=P;
HQ^.Next:=Tek;
HQ:=Tek;
P:=P^.Next;
HQ^.Next:=Nil;
end;
writeln('Ochered P posle udaleniya iz nee 3-h elementov: ');
prn_q(P);
writeln('Ochered Q posle dobavleniya v nee 3-h elementov iz ocheredi P: ');
prn_q(Q);
readln;
end.
|
|
..но проблемы не решило - зависает так же и там же... зато, это меня на нормальную мысль натолкнуло - я смотрю там куча функций еще вызывается с графикой - надо везде инициализацию проверить! ну, пошел этим и заниматься! 
