» Задачи на Turbo Pascal 7.0

Люди, спасибо за хелп, хоть и за неоказанную, но я уверена, вы хотели
Все зачеты и курсовую сегодня уже сдала, а по теме ничего даже не спросили, просто пролистали и вставили 5!
Сама удивляюсь....

Милые программисты!!!
Моя последняя надежда только на вас,я уже просто выбилась из сил!
Помогите,пожалуйста,кто чем сможет!
Я никак не могу решить вот эти злосчастные задачи по Turbo Pascal:
№1.
Вводится последовательность целых чисел. Найти два наименьших числа. Вывести их. Вывести предыдущее значение второго наименьшего числа и последующее значение первого наименьшего числа.
    
№2.
В целочисленном одномерном массиве расположить чётные элементы в порядке возрастания, а нечётные - в порядке убывания.

№3.(задача на обработку строк)
Дана строка символов до точки. Группы символов в ней между группами пробелов считаются словами. Определить, сколько слов начинается, и заканчивается одной и той же буквой.

№4. (задача на работу с файлами)
Прочитать файл FIRST и найти сумму цифр, встречающихся в нём.
1 4 5 7 9 0
0 2 4 6 5 B
1 4 8 3
7 C
4
5

P.S. Заранее очень-очень благодарю всех,кто попытается хоть немного мне помочь!!!
Ведь всё-таки сессия на носу!))))))))

№ 1:

Код:
program prog1;
const n=10; {количество чисел в последовательности}
var i, num, FirstMin, SecondMin: integer;
begin
for i:=1 to n do
begin
Write('Введите число № ',i,'=');
Readln(num);
if i=1 then
begin
FirstMin:=num;
SecondMin:=num;
end
else
if FirstMin>num then
begin
SecondMin:=FirstMin;
FirstMin:=num;
end
else
if SecondMin>num then
SecondMin:=num;
end;
Writeln('Первое минимальное число=',FirstMin);
Writeln('Второе минимальное число=',SecondMin);
inc(FirstMin);
Writeln('Последующее значение первого минимального числа=',FirstMin);
dec(SecondMin);
Writeln('Предыдущее значение второго минимального числа=',SecondMin);
end.

№ 2:

Цитата:

{считаем, что вхлдной массив лежит в файле 02.txt
в первой строке - число элементов массива,
во второй строке через пробел - сами элементы

Пример:

7
7 6 3 2 1 5 6

}
var
f: text; {входной файл}
a: array[1..1000] of integer; {сортируемый массив}
n: integer; {число используемых элементов в массиве}
i, j: integer; {счетчики}
tmp: integer; {временная переменная}
BEGIN
{считываем данные из массива}
assign(f, '02.txt');
reset(f);
readln(f, n);
for i:= 1 to n do
read(f, a[i]);
close(f);

{пузырьковая сортировка четных элементов}
i:= n;
while (i >= 2) do
begin
j:= 2;
while (j < i) do
begin
if (a[j] < a[j+2]) then
begin
tmp:= a[j];
a[j]:= a[j+2];
a[j+2]:= tmp;
end;
j:= j + 2;
end;
i:= i - 2;
end;

{пузырьковая сортировка нечетных элементов}
i:= n;
while (i >= 1) do
begin
j:= 1;
while (j < i) do
begin
if (a[j] > a[j+2]) then
begin
tmp:= a[j];
a[j]:= a[j+2];
a[j+2]:= tmp;
end;
j:= j + 2;
end;
i:= i - 2;
end;

{вывод результатов на экран}
for i:= 1 to n do
writeln(a[i], ' ');
readln;
END.

№ 4:

Цитата:

var
f: text; {текстовый файл}
c: char; {считываемый символ}
sum: integer; {сумма цифр}
BEGIN
assign(f, '04.txt'); {говорим, что файл f имеет имя '04.txt'}
reset(f); {открываем файл на чтение}
while (not eof(f)) do {если eof(f) = true, то мы достигли конца файла
т.е. считываем, пока файл не кончится}
begin
read(f, c); {считываем символ из файла}

{если c - цифра, то добавляем ее в сумму}
if ((c <= '9') and (c >= '0')) then
sum := sum + (ord(c) - ord('0'));

{функция ord(c) возвращает ASCII-код символа c (его номер в ASCII-таблице),
т.е. если из ord от цифры вычесть ord '0', то мы получим цифру
(фича в том, что цифры в ASCII-коде идут по порядку от 0 до 9)}
end;

{закрываем файл, если этого не сделать, вся информация потеряется}
close(f);

{выводим результаты на экран}
writeln('sum = ', sum);
writeln('Press enter to exit.');
readln;
END.

Если что-то непонятно - спрашивай, хоть я и пытался откомментировать как можно подробнее.

P.S. А еще можно указывать дату сдачи, после которой помощь бесполезна.

Удачи.

№3
Текст:

Program Prog3;
var str,sl:String;
r,j:Integer;
Function Slovo(n:Integer):String; {выделяем слово, начиная с символа под номером n}
var i:Integer;s:String;
begin
s:='';
i:=n;
Repeat
s:=s+str[i];
inc(i);
Until (str[i]=' ') or (str[i]='.');
Slovo:=s;
end;
begin
Write('stroka=',str);
Readln(str);
r:=0; {r - искомое количество слов}
j:=1;
While str[j]<>'.' do
begin
If str[j]<>' ' then
begin
sl:=Slovo(j);
j:=j+length(sl);
If Upcase(sl[1])=Upcase(sl[Length(sl)]) then inc(r); {если первая буква прописная}
end else inc(j);
end;
Write('Количество слов=',r);
Readln
end.

Функция Upcase пригодна только для латинских букв, при необходимости можно ввести
функцию для обработки и русских, и латинских букв:
Function UpcaseRus(ch: Char): Char;
begin
if (ch>='a') and (ch<='z') then
UpcaseRus:=chr(ord('A')+ord(ch)-ord('a')) {A,a - латинские}
else if (ch>='а') and (ch<='п') then
UpcaseRus:=chr(ord('A')+ord(ch)-ord('a')) {A,a - русские}
else if (ch>='р') and (ch<='я') then
UpcaseRus:=chr(ord('Р')+ord(ch)-ord('р'));
end;

есть 2 задачи.. сказано решить на delphi но думаю и на паскале покатит
заранее огромное спасибо.
1) Пусть необходимо построить оптимальное расписание занятий для одной группы на неделю (5дней). Неодходимо расставить 17пар занятий. В день нельзя ставить более 4пар. Занятия ведут 8 преподавателей, для каждого из которыз заданы день и номер пары когда он свободен и может проводить занятия. Расписание считается оптимальным есои занятие распределены равномерно по дням недели, нет "окон" у групп и у преподавателей, занятия у преподавателей максимально сконцентрированны в один день. решить нужно используя дерево

2) Дана карта заданная в виде двумерного массива, где 0 - море, 1 - часть острова, найти самый большой остров по площади. решить нужно используя дерево

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

Блин парни помогите! Экзамен на носу.
Вообщем нужно написать программу содержащую процедуру для ввода с клавиатуры в переменную А типа массив матрицы 10*10. При вводе пользователь должен видеть индексы вводимого элемента, например "А[2.5]=".
Умоляю плиз. Экзамен 21.01.06
Ну не врубаюсь я в эти массивы, даже задание толком понять не могу.

grek99

Код: program ar;
var A: array [1..10,1..10] of real;
i,j: integer;
begin
for i:=1 to 10 do
for j:=1 to 10 do
begin
write('Введите A[',i,'.',j,']=');
readln(A[i,j]);
end;
end.

"А типа массив матрицы 10*10"
если А - матрица н*м, то что-то вроде этого:
------------------------------------------------
program MatrProject;
{$APPTYPE CONSOLE}

uses
SysUtils;

const
strFillMatrix = 'Fill Matrix:';
strCurrItem = 'Current Matrix Item: ' ;
strIntError = 'Only int items are allowed.';
strResultMatrix = 'View entered Matrix: ';
strCloseConfirm = 'Press ENTER to close';
nRows = 4;
nCols = 4;

type Matrix_Rel = array[1..nCols] of integer;

var
Matrix:array[1..nRows] of Matrix_Rel;

procedure FillMatrix(var fillMatrix:array of Matrix_Rel);
var curRow:integer;
curCol:integer;
begin
curRow:=0;
curCol:=0;
while(curRow < nRows) do
begin
while(curCol < nCols) do
begin
inc(curCol);
writeln(strCurrItem,'[',curRow,',',curCol,']');

//surround with TRY...except if necessary
readln(fillMatrix[curRow,curCol]);

{---------------
for example:
try
readln(fillMatrix[curRow,curCol]);
except
on EInOutError do
begin
writeln(strIntError);
dec(curCol);
end;
end;
------------------}

end;
curCol:=0;
inc(curRow);
end;
end;

procedure ShowMatrix(showMatrix:array of Matrix_Rel);
var curRow:integer;
curCol:integer;
begin
curRow:=0;
curCol:=0;
while(curRow < nRows) do
begin
while(curCol < nCols) do
begin
inc(curCol);
write(showMatrix[curRow,curCol],' ');
end;
writeln;
curCol:=0;
inc(curRow);
end;
end;

begin
writeln(strFillMatrix);
FillMatrix(Matrix);

writeln;
writeln(strResultMatrix);
ShowMatrix(Matrix);

writeln(strCloseConfirm);
readln;
end.
----------------------------------------------------

если А- массив матрриц н*м, то придется изменить немного (извини, у самого (как видишь) времени особо сейчас нету).
всего хорошего.

Спасибо огромное gpi и Bender_R. Сижу разбираюсь.

А с этой не поможите?
Написать программу содержащую процедуру для форматированного вывода на монитор матрицы размером 10x10. предварительно записанной в массиве Mass [m.n]. Интервал между строчными элементами массива должен быть равен трем символам.
И кто может разьясните что от меня требуется - не пойму никак:
Написать программу для вычисления суммы ряда v=3+E ((-1)^n/(5n-1)^3) с точностью e=10(-4).
E - знак энной интегральной суммы
e - эпсила

grek99
подправь немного то, что я выложил. Извини, писал в блокноте и откомпилить не было возможности:

type Matrix_Rel = array[1..nCols] of integer;
var
Matrix:array[1..nRows] of Matrix_Rel;


Добавлено:
вывод матрицы (точнее что-то вроде того):
//-------------------------------------------------
program MatrProject;
{$APPTYPE CONSOLE}

uses
SysUtils,Math;

const
strFillMatrix = 'Fill Matrix:';
strCurrItem = 'Current Matrix Item: ' ;
strIntError = 'Only int items are allowed.';
strResultMatrix = 'View entered Matrix: ';
strItemShift = ' ';
strCloseConfirm = 'Press ENTER to close';
nRows = 4;
nCols = 2;

type Matrix_Rel = array[1..nCols] of integer;

var
MaxItemLen:integer = 0;
CurItemLen:integer = 0;
Matrix:array[1..nRows] of Matrix_Rel;



function GetItemStrLen(checkItem:integer):integer;
var strBuf:string;
begin
strBuf := inttostr(checkItem);
result := length(strBuf);
end;



procedure CalcItemStrLen(checkItem:integer);
var bufLen:integer;
begin
bufLen := GetItemStrLen(checkItem);

MaxItemLen := max(bufLen,MaxItemLen);
end;



function GetShift(checkItem:integer):string;
var bufLen:integer;
lenDiff:integer;
shiftStr:string;
begin
bufLen := GetItemStrLen(checkItem);
lenDiff:=MaxItemLen - bufLen + 1;
SetLength(shiftStr,lenDiff);
{ почему-то косорез....
SetString(shiftStr,PChar(' '),lenDiff);
пойдем в лоб...
}
for bufLen:=1 to lenDiff do
shiftStr[bufLen]:=' ';

GetShift := shiftStr;
end;



procedure FillMatrix(var fillMatrix:array of Matrix_Rel);
var curRow:integer;
curCol:integer;
curItem:integer;
begin
curRow:=0;
curCol:=0;
while(curRow < nRows) do
begin
while(curCol < nCols) do
begin
inc(curCol);
writeln(strCurrItem,'[',curRow,',',curCol,']');

try
readln(curItem);
CalcItemStrLen(curItem);

fillMatrix[curRow,curCol]:=curItem;
except
on EInOutError do
begin
writeln(strIntError);
dec(curCol);
end;
end;
end;

curCol:=0;
inc(curRow);
end;
end;



procedure ShowMatrix(showMatrix:array of Matrix_Rel);
var curRow:integer;
curCol:integer;
curItem:integer;
begin
curRow:=0;
curCol:=0;
while(curRow < nRows) do
begin
while(curCol < nCols) do
begin
inc(curCol);
curItem := showMatrix[curRow,curCol];

write(strItemShift, curItem, GetShift(curItem));
end;

writeln;
curCol:=0;
inc(curRow);
end;
end;



begin
writeln(strFillMatrix);
FillMatrix(Matrix);

writeln;
writeln(strResultMatrix);
ShowMatrix(Matrix);

writeln(strCloseConfirm);
readln;
end.

to Bender_R:
А попроще никак?
И у меня используемые модули не находит.

to grek99
честно говоря нет времени особо. а вообще здесь вроде не сложно - модифицированная первая задача. просчет относительно самого "длинного" элемента матрицы. Я компилил в delphi 7 ($APPTYPE CONSOLE) - ничего другого не нашел / турбо паскаля поблизости нет - он вреден для зрения
попробуй убрать все из uses; в GetShift ничего не возвращать, а в цикле по lenDiff выводить пробелы (закомменть SetLength и вынеси вызов метода из write ); явно перепиши max в CalcItemStrLen. может тогда турбо паскаль согласится с написанным.

grek99
Печать матрицы:

Код: program PrintMatrix;
const m=10;
n=10;
RightDigits=2;{число знаков после запятой}
var Mass: array [1..m,1..n] of real;
i,j,MaxDigits: integer;
k: longint;
MaxNumber: real;
begin
MaxNumber:=0;
for i:=1 to m do
for j:=1 to n do
begin
write('Введите Mass[',i,'.',j,']=');
readln(Mass[i,j]);
{определение числа с максимальным количеством знаков до запятой}
if Mass[i,j]<0 then
begin
{если число отрицательное,
то умножаем его модуль на 10 для учёта знака минус}
if abs(Mass[i,j]*10)>abs(MaxNumber) then
MaxNumber:=abs(Mass[i,j]*10);
end
else
begin
if Mass[i,j]>MaxNumber then
MaxNumber:=Mass[i,j];
end
end;
{определяем число знаков до запятой у числа с максимальным
количеством знаков до запятой}
MaxDigits:=0;
k:=1;
repeat
inc(MaxDigits);
k:=k*10;
until (Trunc(MaxNumber) div k)=0;
for i:=1 to m do
begin
for j:=1 to n do
if j<>n then
write(Mass[i,j]:MaxDigits+RightDigits+1:RightDigits,' ')
else
writeln(Mass[i,j]:MaxDigits+RightDigits+1:RightDigits);
end
end.

Товарищи
Мне очень нужна помощь
не мог бы кто нибудь из вас написать мне код программы которая строит графики разных функций,(это я в общем то написал) и самое главное ассимптоты у функций вида 1/х и tan(x) очень надо

grek99
Не знаю, может быть и не правильно, давно это было, но думаю, что сумму ряда нужно вычислять так:

Код: program calc;
const e=0.0001;
var i: integer;
v: real;

function r(n:integer): real;
var tempVar: integer;
tempVar1: real;
begin
if (n mod 2)=1 then
tempVar:=-1
else
tempVar:=1;
tempVar1:=5*n-1;
r:=tempVar/tempVar1/tempVar1/tempVar1;
end;

begin
v:=3;
i:=1;
repeat
v:=v+r(i);
inc(i);
until abs(r(i))<e;
writeln('Сумма ряда равна ',v:18:5);
end.

Ребята!!!
Очень вас прошу, помогите пожалуйста!
Проверьте, почему программа работает некорректно? И попробуйте исправить, если сможете! Это СРОЧНЕЕ не бывает !!!
ЗАВТРА ЗАЧЁТ !!!!!!!!!!!!!!!!!!!!!!!

Вот это та программа, о которой говорю:

Цитата:

program ChetNechet;
uses crt;
var a:array[1..100] of integer;b,c:array[1..100] of integer;
i,j,n,z,l,y,x,v:integer;
begin clrscr;
Randomize;z:=1;l:=1;
write('Vvedite razmer massiva ');readln(n);writeln;
for i:=1 to n do begin a[i]:=random(10);
if a[i] mod 2<>0 then begin b[z]:=a[i];inc(z);inc(y);end
else begin c[l]:=a[i];inc(l);inc(x);end;write(a[i],' ');end;writeln;
for i:=y downto 2 do for z:=1 to z-1 do
if b[z]<b[z+1] then begin
v:=b[z]; b[z]:=b[z+1]; b[z+1]:=v; end;
for i:=x downto 2 {1 to x-1} do for l:=1 to l-1 do
if c[l]>c[l+1] then begin
v:=c[l]; c[l]:=c[l+1]; c[l+1]:=v; end;
writeln;writeln('Poluchennyi massiv: ');writeln;
for l:=1 to x do write(c[l],' ');for z:=1 to y do write(b[z],' ');
readkey;
end.

А вообще условие задачи было такое:

"В целочисленном одномерном массиве расположить чётные элементы в порядке возрастания, а нечётные - в порядке убывания."

Sashechkaa

Код: program ChetNechet;
uses crt;
var a:array[1..100] of integer;
b,c:array[1..100] of integer;
i,j,n,z,l,{y,x,}v:integer;
begin
clrscr;
Randomize;
z:=0; {так}
l:=0; {надо}
write('Vvedite razmer massiva ');
readln(n);
writeln;
for i:=1 to n do
begin
a[i]:=random(10);
if {a[i] - ошибочка}i mod 2<>0 then
begin
inc(z); {нужно переместить вверх}
b[z]:=a[i];
{inc(y);} {а кто будет инициализировать переменную
да и не нужна она}
end
else
begin
inc(l);
c[l]:=a[i];
{inc(x);} {аналогично}
end;
write(a[i],' ');
end;
writeln;
{for i:=y downto 2 do
for z:=1 to z-1 do - круто!!!
if b[z]<b[z+1] then
begin
v:=b[z];
b[z]:=b[z+1];
b[z+1]:=v;
end;}
for i:=z downto 2 do
for j:=1 to i-1 do
if b[j]<b[j+1] then
begin
v:=b[j];
b[j]:=b[j+1];
b[j+1]:=v;
end;
{ for i:=x downto 2} {1 to x-1} {do
for l:=1 to l-1 do
if c[l]>c[l+1] then
begin
v:=c[l];
c[l]:=c[l+1];
c[l+1]:=v;
end; }
for i:=l downto 2 do
for j:=1 to i-1 do
if c[j]>c[j+1] then
begin
v:=c[j];
c[j]:=c[j+1];
c[j+1]:=v;
end;
writeln;
writeln('Poluchennyi massiv: ');
writeln;
for i:=1 to l do write(c[i],' ');
writeln;
for i:=1 to z do write(b[i],' ');
readkey;
end.

gpi !!!!!!!!!!!!!!!!!!!!!!!!;)

Спасибочки тебе огромнейшее,твоя задача замечательная и работает КАК НАДО!!!
Ты меня очень-очень выручил!
Спасибо!!!
Ты ГЕНИЙ!!!;)

И ещё:
РЕБЯТА: SLONPTS, MINOS14 и GPI вам пламенный привет и БОЛЬШААААААААЯ БЛАГОДАРНОСТЬ от меня за предыдущие задачи.
Извините,что сразу не написала:просто не было выхода в Интернет.
Спасибо вам большое!!!
Вы мне здорово помогли и натолкнули на многие идеи.
Так что ещё раз СПАСИБО ВАМ, СПАСИБО, СПАСИБО!!!;)

Вы не представляете, это так приятно,что вы сразу же откликнулись мне на помощь!
Ведь моя оставшаяся надежда была возложена только на ВАС!

Вы молодцы, ребята,продолжайте пожалуйста в том же духе.
Потому что это так правильно и нужно, что даже трудно описать словами!!!
Ну вот вроде и всё сказала.
ПОКА!
P.S. gpi !!!
Шутку я оценила и возможно скоро форум действительно будет заполнен моими клонами SashechkaB,SashechkaC,SashechkaD.....................................
Ну да ладно,это я ЛЮБЯ!

Народ проблема такая:
Есть две проги - первая как я понял правильная
1:

Цитата:

Var
s,y: real;
p1,p2: real;
n:integer;
begin
y:=3; n:=1; s:=0; p2:=1;
repeat
p1:= (5*n-1);
p2:= p2*(-1);
s:= p2/(p1*p1*p1);
y:= y+s;
n:= n+1;
until s>0.001;
writeln('rezultat ',y:5:4);
readln;
end.

2:

Цитата:

var n:integer;
E,v,x,p:real;
begin

x:=1;
n:=1;
E:=0;
while E<0.001 do

begin

p:=(5*n-1);
x:=x*(-1);
E:=E+(x/(p*p*p));
n:=n+1;
end;
v:=E + 3;
writeln('v=',v:5:4);
writeln ('e=',e:5:4);
readln;
end.

А вот с этой проблемка - ответ с первой не сходится.
Формулировка задания такое:
Написать программу для вычисления суммы ряда v=3+E((-1)^n/(5*n-1)^3) с точностью e=10^ -4;
Где E - это знак энной интегральной суммы т.е. n изменяется от 1 до + бесконечности.


Добавлено:
Может кто поможет?

Цитата:

n:=1;
E:=0;
while E<0.001 do

begin

p:=(5*n-1);
x:=x*(-1);
E:=E+(x/(p*p*p));
n:=n+1;
end;
v:=E + 3;
writeln('v=',v:5:4);
writeln ('e=',e:5:4);
readln;
end.

Здесь я затупил и убрал неправильные выводы. Кстати программа работает все равно не верно (алгоритм не универсален), так как условие если я понял код программы вычислить с точностью до заданного Е, тогда надо сравнивать ABS(Е1-Е2) где Е1 это предыдущий результат а Е2 текущий, объяснять почему так надо долго. Хотя в твоем случае имеем быстро убывающую прогрессюю, то можно и не делать так. Однако нашел еще один глюк надо сравнивать в любом случае ABS(E) иначе на первом ходе мы имеем Е меньше нуля (даже в первом коде) и следовательно ответ неверный, короче много ошибок.

Цитата:

Очень красивый кусок, Е изначально равно 0 то есть по умолчанию МЕНЬШЕ 0.0001 твой цикл заканчивается так и не начавшись. В отличие от repeat until который выполняется минимум 1 раз всегда. Дай другое значени Е. Кстати программа работает все равно не верно (алгоритм не универсален), так как условие если я понял код программы вычислить с точностью до заданного Е, тогда надо сравнивать ABS(Е1-Е2) где Е1 это предыдущий результат а Е2 текущий, объяснять почему так надо долго. Хотя в твоем случае имеем быстро убывающую прогрессюю, то можно и не делать так. Однако нашел еще один глюк надо сравнивать в любом случае ABS(E) иначе на первом ходе мы имеем Е меньше нуля (даже в первом коде) и следовательно ответ неверный, короче много ошибок.

Дело все в том что это по ходу в задании косяк, у меня даже в excel получается такой же ответ как и в 1ом коде, на счет while я так понимаю что условие звучит так:
while(в то время как) E<0.001 то цикл продолжается, а Е присвоено значение 0, так что цикл выполняется также как минимум один раз. На счет точности как мне обьяснили - Энная интегральная сумма не должна быть меньше 10^ -4 т.е 0,001.

grek99

var n:integer;
E,v,V0,x,p:real;

begin
x:=1;
n:=1;
E:=99999;
V := 3;
while E>0.001 do
begin
V0 := V;
p := (5*n-1);
x := x*(-1);
V := V+(x/(p*p*p));
E := abs(V-V0);
n := n+1;
end;
writeln('v=',v:6:5);
writeln ('e=',e:5:4);
readln;
end.

Здравствуйте умные люди!!! Помогите завтра сдавать задачи не могу решить. Вы мой последний шанс!!!!!! Вот они проклятые:
1. Данные о направлении ветра (сев,юж,вост,зап) и силе ветра за декаду ноября хранятся в одномерном массиве. Определить сколько дней дул южный ветер с силой превышающей 8м/с.
2. Составить программу подсчета числа всех натуральных чисел меньших заданного М, квадрат суммы цифр которых равен Х.
3. Дан целочисленный массив В[1..5,1..5]. Вычислить сумму элементов этого массива, расположенных выше левой диагонали.
Зарнее спасибо!

Добавлено:

Цитата:

Ну пожалуйста!!!! Очень надо хотябы первые две.

EVenom

№2
program prog2;
var M:Real;
x,S,n,code,i,a:Integer;
n_str:String;
begin
Write('Vvedite M: ');
Readln(M);
Write('Vvedite x: ');
Readln(x);
n:=1;
While n<M do
begin
Str(n,n_str);
S:=0;
For i:=1 to Length(n_str) do
begin
val(n_str[i],a,code);
S:=S+sqr(a);
end;
if S=x then Writeln(n);
inc(n);
end;
Readln;
end.

ОГРОМНОЕ СПАСИБО MINOS14. Теперь я не сомневаюсь что есть добрые люди. №3 я сделал осталось №1. Если можешь реши мне ее или хотя бы мысли подкинь. Только не считай это за хамство просто очень надо!!!

EVenom
№1
Код: program wind;
const days=10;
direction=2;
str_direction='южном';
speed=8;
var wind_mas: array [1..days*2] of real;
i, num_of_days: integer;
begin
writeln('Направления ветра:');
writeln('1 - северный');
writeln('2 - южный');
writeln('3 - восточный');
writeln('4 - западный');
for i:=1 to days do
begin
write('Введите код направления ветра для дня ',i,' - ');
readln(wind_mas[i*2-1]);
write('Введите скорость ветра для дня ',i,' - ');
readln(wind_mas[i*2]);
end;
num_of_days:=0;
for i:=1 to days do
if (wind_mas[i*2-1]=direction) and (wind_mas[i*2]>speed) then
inc(num_of_days);
writeln('Ветер в '+str_direction+' направлении со скоростью, превышающей ',
speed,' м/с дул ',num_of_days,' дней');
end.

Спасибо вам огромнейшее особенно создателям сайта, MINOS14, GPI. Теперь я буду знать где сидят настоящие программеры.