Помогите с Pascal

[Programmistka]

Помогите с Pascal

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

 

[interacia]

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.

 

[interacia]

7)

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.

 

[interacia]

3)

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) подобную задачу можно найтиhttp://interacia.net/index.php/2011-02-15-18-33-42/begin40/84-array----90-111----.html <ССЫЛКА УДАЛЕНА>
[mod2]Дорогой участник, поверьте, мы с глубочайшим уважением относимся к Вашей деятельности на форуме и очень не хотели бы Вас наказывать, но вот уже не первый раз Вы грубо нарушаете наши Правила, выкладывая ссылки на свой сайт. Подобное у нас строго запрещено. Правила едины для всех и подлежат неукоснительному соблюдению.

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

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

 

[Vladimir_S]

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

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

 

[AlexZir]

Задача 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 в случайной координате экрана. Выход из программы осуществляется после нажатия любой клавиши.

 

[Vladimir_S]

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

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

 

[AlexZir]

Пожалуйста

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

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.

 

[interacia]

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, 191561942608236107294793378084303638130997321548169216

 

[Vladimir_S]

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

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

 

[Vladimir_S]

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

Уже лучше, только вот частоты я бы тоже давал разные. Например, выбрав случайным образом цвет, я бы затем через Case сопоставил бы этому цвету свою частоту. Так веселее.

 

[interacia]

Извиняюсь. По поводу замены (W div 2) на (W-1) это рудиментарный остаток от изучения и тестирования функции (забыл назад поставить как было).
А под выражением «самый грубый способ вычисления.» имелось ввиду не ваша функция (

Function Ideal(W:Integer):Boolean;

)
А тот факт что подача аргумента в неё никак не обсчитывается.
For k:=2 to M do
То есть подаются все числа подряд. Тогда как во втором примере уже до вызова функции (

Function Ideal(W:Integer):Boolean;

) отсеивается солидная доля чисел. Что более так сказать элегантно.

И еще раз выражением «самый грубый способ вычисления.» никого не хотел обидеть или поддеть. Скорее показать наличие альтернатив.

 

[Vladimir_S]

И еще раз выражением «самый грубый способ вычисления.» никого не хотел обидеть или поддеть.

Да я вообще-то так, больше посмеяться. Никаких обид.

 

[AlexZir]

Владимир, лично для меня веселее было бы, если б топикстартер самостоятельно реализовала эти задачи )

Но персонально для вас внес изменения код, как говорится, любой каприз...

 

[Vladimir_S]

Владимир, лично для меня веселее было бы, если б топикстартер самостоятельно реализовала эти задачи

Лёша, ну золотые слова!

Но персонально для вас внес изменения код, как говорится, любой каприз...

Вот спасибо - а то я всё думаю: чего мне в этой жизни не хватало? Оказывается, от оно чо... А вообще думал сам нарисовать ей программку, да так и не собрался: уж очень не люблю эту CRT-шную дурь с цветом текста да строками-столбцами. Сам никогда не пользуюсь.

 

[AlexZir]

Лишнее это, мишура одна, но преподавателям почему-то нравится Они же, как дети малые, в основном на все блестящее да мигающее реагируют )