Технический форум - Помогите с Pascal

Технический форум (http://www.tehnari.ru/)

- Помощь студентам (http://www.tehnari.ru/f41/)

- - Помогите с Pascal (http://www.tehnari.ru/f41/t86525/)

Помогите с Pascal

Помогите пожалуйста с Pascal, хотя бы несколько задач
1. Составить программу в которой в разных местах отображаются разного цвета цифры. Вывод цифр сопровождается определенным звуком.
2. Написать программу выдающую информацию:
- кол-во иногородних, прибывших в клинику
- список пациентов старше Х лет с диагнозом У. Значения Х,У вводятся с клавиатуры.
3. Вывести на печать элементы целочисленных матриц N(5,6) и M(4,5), кратные трем. (с помощью функции или процедуры)
4. Вычислить сумму совершенных чисел, не превосходящих заданного числа М. Определение совершенного числа оформить подпрограммой функцией.
5. В тексте предложения заменить символ " " (пробел) на символ ",". Конечные символы удалить. Определить длину предложения, если в тексте встречается несколько " " подряд, вместо них поставить один символ ",".
6. Вставить число А после К элемента массива. (К и А вводятся с клавиатуры).
7. Создайте матрицу 5х5, значение каждого элемента которой равно сумме номера строки и столбца, на пересечении которых он находится и вычислите сумму элементов каждой строки.
8. Вставить первую строку после строки в которой находится первый встречный максимальный элемент.
9. Найдите наибольшие элементы и их порядковые номера в массивах Х(15) и У(12).
10. Удалить из массива максимальный элемент, если все элементы разные.

10)

Код:

program Array1;

var

i:integer;

N:integer;

a: array [1..10] of integer;

max:integer;

begin

writeln('Введите N (N<=10)');

 readln(N);

 writeln('Введите значение массива');

 for i:=1 to N do read(a[i]);

 max:=1;

 for i:=2 to N do if a[i]>a[max] then max:=i;

 dec(N);

 for i:=max to N do a[i]:=a[i+1];

writeln(' Ответ ');

 for i:=1 to N do write(a[i],' ');

end.

Код:

program Matrix1;

var

j,i:integer;

Sum:integer;

a: array [1..5,1..5] of integer;

begin

// Решение

 for i:=1 to 5 do begin

 for j:=1 to 5 do a[i,j]:=i+j;

 end;

// Ответ

writeln;

writeln('Ответ');

 for i:=1 to 5 do begin

 writeln;

 Sum:=0;

 for j:=1 to 5 do begin write(a[i,j],' '); inc(Sum,a[i,j])end;

 write('сумма строки = ',Sum);

 end;

end.

Код:

program Matrix1;

var

j,i:integer;

N: array [1..5,1..6] of integer;

M: array [1..4,1..5] of integer;

begin

// Решение

 for i:=1 to 5 do

 for j:=1 to 6 do N[i,j]:=random(100);

 for i:=1 to 4 do

 for j:=1 to 5 do M[i,j]:=random(100);

writeln;

writeln(' элементы кратные трем из N[] ');

 for i:=1 to 5 do  begin

 writeln;

 for j:=1 to 6 do if (N[i,j]mod 3)=0 then write(' N[',i,',',j,']=',N[i,j]);

 end;

writeln;

writeln(' элементы кратные трем из M[] ');

 for i:=1 to 4 do begin writeln;

 for j:=1 to 5 do if (M[i,j]mod 3)=0 then write(' M[',i,',',j,']=',M[i,j]);

end;

end.

6) подобную задачу можно найти <ССЫЛКА УДАЛЕНА>

Замечание:

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

С пожеланием всяческих благ
Модератор.

4) четвертое задание явно выбивается по своей сложности из обшей массы.

Цитата:

Сообщение от interacia (Сообщение 883288)

4) четвертое задание явно выбивается по своей сложности из обшей массы.

Да Господь с Вами, что же тут сложного?! За основу можно взять, например, мою программку отсюда: http://www.tehnari.ru/f41/t73493/#post734620 (для Turbo/Free Pascal формат Integer следует заменить на Longint). Дальше там тривиально.

Задача 1. Алгоритм реализован для графического режима TurboPascal, так как версия компилятора нигде не оговаривалась

Код:

uses crt, graph;

var gd,gm,ch:integer;

s:string;

begin

randomize;

initgraph(gd,gm,'c:\tp7\bgi');

cleardevice;

repeat

ch:=random(10);

str(ch,s);

setcolor(random(16));

sound(random(10)*20+100);

outtextxy(random(630)+5,random(450)+10, s);

delay(200);

nosound;

until keypressed;

s:=readkey;

end.

При выполнении программы на экран выводится случайная цифра от 0 до 9 случайным цветом от 0 до 15 в случайной координате экрана. Выход из программы осуществляется после нажатия любой клавиши.

Цитата:

Сообщение от AlexZir (Сообщение 883406)

При выполнении программы на экран выводится случайная цифра от 0 до 9 случайным цветом от 0 до 15 в случайной координате экрана.

А поверещать, как того условие требует? :D

Пожалуйста :D

Та же задача для текстового режима решается следующим образом:

Код:

uses crt;

var ch:integer;

begin

randomize;

clrscr;

repeat

ch:=random(10);

textcolor(random(15)+1);

sound(random(10)*20+100);

gotoxy(random(80),random(25));

writeln(ch);

delay(200);

nosound;

until ch=9;

readln

end.

Здесь печать цифр прекращается после вывода цифры 9.

4) задание
// самый грубый способ вычисления.

Код:

Var

 N,k:integer;

 M,V:longInt;

Function Ideal(W:Integer):Boolean;

var

 i,Sum:longInt;

begin

 Sum:=0;

 For i:=1 to W-1  do

  If (W mod i)=0 then Inc(Sum,i);

 Ideal:=(Sum=W);

end;

Begin

 Write('M= ');

 Readln(M);

 V:=0;

 For k:=2 to M do if Ideal(k) then V:=V+k;

Write('Сумма = ',V);

End.

Свойства совершенных четных чисел
1) Все чётные совершенные числа (кроме 6) являются суммой кубов последовательных нечётных натуральных чисел: 1^3+3^3+5^3 …

Еще свойство
2) могут быть представлены в виде n(2n−1) для некоторого натурального числа n.

Еще свойство
3) Все чётные совершенные числа, кроме 6 и 496, заканчиваются в десятичной записи на 16, 28, 36, 56 или 76.

Еще свойство
4) Все чётные совершенные числа в двоичной записи содержат сначала p единиц, за которыми следует p—1 нулей (следствие из их общего представления).

Это ещё не всё.

Эти свойства могут быть положены в основу облегчения алгоритма.

Для примера 1-ое свойство
Код

Код:

Var

 N,k:integer;

 j,M,V:longInt;

Function Ideal(W:Integer):Boolean;

var

 i,Sum:longInt;

begin

 Sum:=0;

 For i:=1 to W-1  do

  If (W mod i)=0 then Inc(Sum,i);

 Ideal:=(Sum=W);

end;

Begin

 Write('M= ');

 Readln(M);

 V:=0;

 k:=1;

 j:=3;

 if M>=6 then

begin

  V:=6;

 while k<=M do

 begin

 if Ideal(k) then V:=V+k;

 k:=k+j*j*j;

 inc(j,2);

 end;

end

 else V:=0;

Write('Сумма = ',V);

End.

Между кодами существенная разница в производительности.

Если бы задача имела бы какое ни будь прикладное значение то эффективней использовать массив с уже просчитанными значениями.
Несколько первых значений
6, 28, 496, 8128, 33550336, 8589869056, 137438691328, 2305843008139952128, 2658455991569831744654692615953842176, 19156194260823610729479337808430363813099732154816 9216

Цитата:

Сообщение от interacia (Сообщение 883462)

самый грубый способ вычисления.

Спасибо на добром слове. :D
Между прочим, Вы совершенно напрасно заменили верхнюю границу поиска делителей с (W div 2), как у меня, на (W-1). Немного поразмыслив, Вы поймёте, что не может быть точным делителем число, превышающее половину делимого, а потому проверка от половины до значения самогО делимого - абсолютно лишняя трата времени. Это если уж заниматься эффективностью, оптимальностью, производительностью и т.п.