Путь:
Навигация
- work-flow-Initiative форум проекта WFI
- Игровой форум
- Исторический форум
- Форум Компьютеры и сети
- Криптовалютный форум
- ОФД форум, онлайн ККМ, ФЗ-54
- Радиолюбительский форум
- Свободное общение
- Творческий форум
- Форум коллекционеров информации
- Форум об искусстве
Язык [ РУССКИЙ ]
Поиск
Подписка и соц. сети
Новые материалы
- Откатные ворота для гаража и забора устройство, разновидности, применение, достоинства и недостатки 2024-09-17
- Как мостить дорожки из камня 2024-09-17
- Деревянные дома из клееного бруса важная роль усовершенствования сырья 2024-09-07
- Как выбрать кондиционер для квартиры секреты комфортного климата в вашем доме 2024-09-07
- Интернет-магазин брендовой обуви и аксессуаров где стиль и качество встречаются 2024-09-07
- Лазерная коррекция зрения показания и особенности методов 2024-08-01
- ЖК Светский Лес резиденции у моря 2024-08-01
- Техническое обследование зданий и сооружений цели и задачи 2024-07-30
- Причины и важность обращения к адвокату 2024-07-30
- Эффективное похудение и очищение организма 2024-07-30
- Алюминиевые конструкции преимущества и особенности 2024-06-21
- Виды подъемного оборудования и важность его использования 2024-06-15
- Стальные рулонные ворота преимущества и особенности 2024-06-15
- Как заказать лекарства онлайн 2024-06-15
- ПВХ-плитка достоинства материала 2024-06-15
Картинка недели
К началу
В конец
Создать личную галерею (раздел)
Создать личный альбом (с изображениями)
Создать материал
Форум Компьютеры и сети
Оценка раздела:
2
Категории
Задачи с готовым решением на языке pascal
Дата публикации: 2018-01-17 20:17:22Дата модификации: 2018-01-17 20:17:22
Просмотров: 1245
Автор: fantome
Устали от программирования ? надоели эти проклятые задачи ? фантом спешит на помощь !
Задачи с готовым решением по информатике (все задачи на языке pascal):
Оценка материала:
0
Описание материала: Устали от программирования ? надоели эти проклятые задачи ? фантом спешит на помощь !
Задачи с готовым решением по информатике (все задачи на языке pascal):
Остальные материалы раздела: Компьютерный форум
Предыдущая Кто работал со сми2 отзывы и рекомендацииСледующая представлен ИКС основного домена-как бороться, как пересчитать ИКС поддомена
Комментарии Всего: 26
2018-01-17 19:28:01 Пользователь: fantome От имени: fantome 
0
0
{ Ввести стpоку символов. Гpуппу символов, pазделенную с одной или обеих
стоpон одним или несколькими пpобелами и не содеpжащую внутpи себя пpобелов,
назовем словом.
Распечатать все слова четной длины. Если таких слов нет, то выдать
соответствующее текстовое сообщение. }
{ пpимечание ! pаботает только пpи включенном пpинтеpе }
{ если необходимо вывести данные просто на экран, нужно
отменить вывод на печать - просто удалить переменную f из writeln,
убрать назначение файла на печать и его закрытие close(f)}
Program ZD1;
var
f:text; { файл вывода на принтер }
slovo:string; { стpока символов }
slovo2:string; { слово }
tom:integer; { счетчик четных слов, если он pавен нулю,то выводится
сообщение о том, что таких слов нету }
probel:integer;{ счетчик пpобелов }
bin:integer; { длинна слова }
reven:integer; { счетчик количества букв в слове }
i:integer;
dlina :integer;{ длинна стpоки символов }
god:integer; { втоpой счетчик пpобелов }
begin
{ пеpвая часть, pазбивает стpоку символов на слова, если кол-во букв в слове
четное, то слово выводится на печать }
assign(f,'prn'); { назначим файл вывода - пpинтеp }
rewrite(f); { откpоем файл для вывода}
tom:=0; { обнуляем счетчики }
probel:=0; { обнуляем счетчики }
reven:=0; { обнуляем счетчики }
slovo2:=''; { пеpеменная слова пуста }
writeln ('Введите стpоку символов');
readln (slovo);
dlina:=length(slovo); { вычисляем длинну слова, пишем в пеpеменную dlina}
for i:=1 to dlina do { Цикл, от 1 до конца стpоки символов }
if slovo[i]<>' ' { пока символ не pавен пpобелу }
then
begin
reven:=reven+1; { счетчик слов +1 }
slovo2:=slovo2+slovo[i]; { в пеpеменную слова пpибавляем букву }
end
else { если символ pавен пpобелу }
begin
if reven mod 2=0 { если кол-во букв в слове четное, то }
then
begin
writeln (f,slovo2);{ выводим полученное слово на печать }
tom:=tom+1; { счетчик четных слов +1 }
end;
reven:=0; { обнуляем счетчик букв }
slovo2:=''; { очищяем пеpеменную слова }
end;
{ втоpая часть, необходима, т.к пеpвая часть не учитывает последнего слова }
slovo2:=''; { очищаем пеpеменную слова }
for i:=1 to dlina do { Цикл, от 1 до конца стpоки символов }
if slovo[i]=' ' { если символ pавен пpобелу }
then
probel:=probel+1; { счетчик пpобелов +1 }
for i:=1 to dlina do { Цикл, от 1 до конца стpоки символов }
begin
if slovo[i]=' ' { если символ pавен пpобелу }
then
god:=god+1; { втоpой счетчик пpобелов +1}
if god=probel { если счетчик пpобелов 2 = пеpвому }
then
slovo2:=slovo2+slovo[i+1]; {в пеpеменную слова
пpибавляем букву, +1 нужен, чтобы не учитывался
пpобел }
end;
{втоpая часть pаботает по следующему пpинципу: сначала машина считает
сколько пpобелов содеpжит стpока символов, потом если кол-во
пpобелов (счетчик 2) будет pавно кол-ву пpобелов (счетчик 1) - это
будет знаком тому, что мы подошли к последнему слову, потом мы заносим
в пеpеменную слово последнее слово, пpобел нужно убиpать потому
что он будет учитываться как часть последнего слова}
{тpетья часть}
bin:=length(slovo2); { заносим длинну последнего в пеpеменную bin }
if bin mod 2<>0 { ! если число букв не четное !, то }
{ --------- }
then
begin
writeln (f,slovo2); { выводим слово на печать }
tom:=tom+1; { счетчик четных слов +1 }
end;
if tom=0 { если счетчик четных слов=0, то }
then
writeln ('Слов четной длинны нет !');
close (f);
readln;
end.
2018-01-17 19:31:49 Пользователь: fantome От имени: fantome
0
0
{Программа для нахождения наибольшего
общего делителя двух целых чисел}
{(по алгоритму Евклида)}
program nodd;
var chislo1, {первое число}
chislo2, {второе число}
nod, {наибольший общий делитель}
r:integer; {остаток отделения 1-го числа на 2-е}
begin
Writeln ('Введите два целых числа:');
Readln (chislo1,chislo2); {ввод двух чисел с клавиатуры}
while (chislo1 mod chislo2)<>0 do {цикл выполняется пока остаток <> 0}
begin
r:=chislo1 mod chislo2; {вычисление остатка 1-го числа на 2-ое}
chislo1:=chislo2; {присваиваем 2-е число 1-му}
chislo2:=r; {присваиваем остаток от деления 2-му числу}
end;
nod:=chislo2; {присваиваем 2-е число переменной nod}
Writeln ('НОД: ',nod); {Вывод НОД}
Readln;
end.
2018-01-17 19:35:37 Пользователь: fantome От имени: fantome
0
0
{Посчитать факториал заданного числа N! Предполагается, что результат превысит
разрядную сетку преставления целых чисел (например, n=1000), но при этом все цифры
результата должны быть выведены на печать}
var x:array[1..32403]of integer;
l,n,c,i,j:integer;
begin
write('Введите факториал');
readln(n);
x[1]:=1;
l:=1;
for j:=1 to n do
begin
c:=0;
for i:=1 to l do
begin
x[i]:=x[i]*j+c;
c:=x[i] div 10;
x[i]:=x[i] mod 10;
end;
if c<>0 then
repeat
inc(l);
x[l]:=c mod 10;
c:=c div 10;
until c=0;
end;
for i:=l downto 1 do write(x[i]);
writeln;
readln;
end.
2018-01-17 19:44:32 Пользователь: fantome От имени: fantome
0
0
{ Написать программу, которая заполняет массив A(10,10) случайными
целыми числами из интервала [-38,56]. Определить и вывести на печать
строку массива, сумма элементов которой минимальна. }
uses crt;
const n=10;
m=10;
type dmyarray=array [1..n,1..m] of integer;
omyarray=array [1..n] of integer;
var a:dmyarray;
{ первая часть, создаем массив }
procedure dinit (var a:dmyarray);
var i,j:integer;
begin
randomize;
for i:=1 to n do
begin
for j:=1 to m do
a[i,j]:=random(95)-38;
end;
end;
{вторая часть, выводим массив на экран}
procedure dprint (a:dmyarray);
var i,j:integer;
begin
for i:=1 to n do
begin
for j:=1 to m do
write (a[i,j]:5);
writeln;
end;
end;
{ третья часть, сначала определяем в какой строке минимальная сумма элементов
и одновременно заносим в переменную номер этой строки,
потом выводим эту строку }
procedure nomer (a:dmyarray);
var i:integer; { строка }
j:integer; { столбец }
k:integer; { сумма минимальных элементов }
min:integer; { самая минимальная сумма элементов }
l:integer; { номер строки, сумма элементов которой минимальна }
begin
l:=0; { обнуляем счетчики }
min:=0; { обнуляем счетчики }
k:=0; { обнуляем счетчики }
for i:=1 to n do
begin
for j:=1 to m do
if a[i,j]<0 { если элемент массива<0, то }
then
k:=k+a[i,j]; { сумма мин. элементов + мин.элемент }
if k<min { если сумма мин.элементов меньше самой минимальной
суммы элементов, то }
then
begin
min:=k; { самая минимальная сумма элементов, автоматически
приравнивается к сумме мин. элементов, т.е. идет
поиск самой минимальной суммы элементов }
l:=i; { к l приравниваем i, в итоге получаем номер строки,
сумма элементов которой минимальна }
end;
k:=0; { обнуляем k, т.к общий цикл не закончен }
end;
writeln (' Строка массива, сумма элементов которой минимальна: ');
for j:=1 to 10 do
write (a[l,j]:5); { вывод строки сумма элементов кторой минимальна }
end;
begin
repeat
clrscr;
writeln ('Массив 10x10');
dinit(a);
dprint(a);
writeln;
nomer (a);
writeln;
writeln;
write ('*** Esc - выход, anykey - продолжить ***');
writeln;
until readkey=#27;
end.
2018-01-17 19:48:11 Пользователь: fantome От имени: fantome
0
0
{ Дана матpица натуpальных чисел A[M,N], где M и N - заданные натуpальные числа. Все элементы матpицы
pазличные. Сфоpмиpовать одномеpный массив B[N], в котоpом B[j] pавен сpеднему аpифметическому
значению наибольшего и наименьшего элемента в j-ом столбце матpицы A. }
type dmyarray=array [1..25,1..25] of integer;
omyarray=array [1..25] of real;
var a:dmyarray;
b:omyarray;
n,m:integer;
procedure dinit (var a:dmyarray);
var i,j:integer;
begin
randomize;
for i:=1 to n do
for j:=1 to m do
a[i,j]:=-38+random(95);
end;
procedure dprint (a:dmyarray);
var i,j:integer;
begin
for i:=1 to n do
begin
for j:=1 to m do
write (a[i,j]:4);
writeln;
end;
end;
procedure oinit (var b:omyarray);
var bin,j,i:integer;
min,max:real;
begin
max:=0;
min:=0;
for j:=1 to n do
begin
for i:=1 to m do
begin
if min>a[i,j] then min:=a[i,j];
if max<a[i,j] then max:=a[i,j];
end;
b[j]:=(min+max)/2;
min:=0;
max:=0;
end;
writeln;
for j:=1 to n do
write (b[j]:8:1);
end;
begin
writeln ('Введите M');
readln (m);
writeln ('Введите N');
readln (n);
writeln;
writeln (' Матpица MxN: ');
writeln;
dinit(a);
dprint(a);
writeln;
writeln (' Массив B[N]: ');
oinit (b);
readln;
end.
2018-01-17 19:51:39 Пользователь: fantome От имени: fantome
0
0
{Дан массив натуральных чисел. Найти сумму элементов, кратных данному К.}
const n=20;
type myarray=array [1..n] of integer;
var a:myarray;
c:integer;
procedure init1 (var a:myarray);
var i:integer;
begin
randomize;
for i:=1 to n do
a[i]:=-13+random(27);
end;
procedure print (a:myarray);
var i:integer;
begin
for i:=1 to n do
write (a[i]:6);
writeln;
end;
procedure nomer (a:myarray);
var c,s,i:integer;
begin
s:=0;
writeln ('Введите К');
readln (c);
for i:=1 to n do
if a[i] mod c=0 then s:=s+a[i];
writeln (' Сумма ',s);
readln;
end;
begin
init1(a);
writeln('Массив');
print(a);
nomer(a);
readln;
end.
2018-01-17 21:54:56 Пользователь: fantome От имени: fantome
0
0
{Даны действительные числа а1 а2 а3 а4 а5, поменять местами наибольший и наименьший элементы}
const n=5;
type myarray=array[1..n] of integer;
var i:longint;
l,s:integer;
a:myarray;
procedure init(var a:myarray);
var i:integer;
begin
for i:=1 to n do
read (a[i]);
readln;
end;
procedure maza(a:myarray);
var s,q,w,i,b,l:integer;
begin
i:=1;
s:=0;
q:=a[i];
w:=a[i];
for i:=1 to n do
if q<a[i] then q:=a[i];
for i:=1 to n do
if w>a[i] then w:=a[i];
for i:=1 to n do
begin
if a[i]=q then write (w,' ');
if a[i]=w then write (q,' ');
if (a[i]<>q) and (a[i]<>w) then write (a[i],' ');
end;
end;
begin
writeln ('Введите числа числа чеpез пpобел');
init (a);
maza (a);
readln;
end.
2018-01-17 22:23:05 Пользователь: fantome От имени: fantome
0
0
{Даны целые числа а1, а2...аn. Вывести на печать только те
числа, для которых выполняется a от i<=i }
const n=20;
type myarray=array [1..n] of integer;
var a:myarray;
c:integer;
procedure init1 (var a:myarray);
var i:integer;
begin
randomize;
for i:=1 to n do
a[i]:=-13+random(27);
end;
procedure print (a:myarray);
var i:integer;
begin
for i:=1 to n do
write (a[i]:6);
writeln;
end;
procedure nomer (a:myarray);
var c,s,i:integer;
begin
s:=0;
for i:=1 to n do
if a[i]<=i then write (a[i],' ');
readln;
end;
begin
init1(a);
writeln('Массив');
print(a);
writeln ('Новый массив');
nomer(a);
end.
2018-01-17 22:44:59 Пользователь: fantome От имени: fantome
0
0
{Определить номера тех строк целочисленной матрицы a[N,K],
которые совпадают с массивом D[K]. Если таких строк нет,
выдать соответствующее сообщение.
Т.к. совпадения очень редки, то 2-й массив генерируется
как 1-я строка 1-го массива, если изменить генерацию,
то совпадение придется ждать долго, если не обходимо просто
уменьшете 1-й массив заменив значения m и n}
const n=10;
m=10;
type dmyarray=array [1..n,1..m] of integer;
omyarray=array [1..n] of integer;
var a:dmyarray;
b:omyarray;
c:integer;
procedure dinit (var a:dmyarray);
var i,j:integer;
begin
randomize;
for i:=1 to n do
begin
for j:=1 to m do
a[i,j]:=5+random(25); {Генерация 2-х мерного массива}
end;
end;
procedure dprint (a:dmyarray);
var i,j:integer;
begin
for i:=1 to n do
begin
for j:=1 to m do
write (a[i,j]:5);
writeln;
end;
end;
procedure oinit (var b:omyarray); {Тут генерится 2-й массив}
var i:integer;
begin
randomize;
for i:=1 to n do
b[i]:=5+random(25); {Тут задаются какие числа будут в массиве}
end;
procedure oprint (b:omyarray);
var i:integer;
begin
for i:=1 to n do
write (b[i]:6);
writeln;
end;
procedure nomer (a:dmyarray;b:omyarray);
var j,i,c,v:integer;
begin
v:=0;
for j:=1 to n do
begin
c:=0;
for i:=1 to m do
if a[j,i]=b[i] then
begin
c:=c+1;
if c=5 then
begin
writeln ('Номера совпадающих строк: ',j:5);
v:=v+1;
end;
end;
end;
if v=0 then writeln (' Таких строк нет ')
end;
begin
writeln ('Матpица 10x10');
dinit(a);
oinit (b);
dprint(a);
writeln;
writeln('Одномеpный массив');
oprint(b);
nomer (a,b);
readln;
end.
2018-01-17 22:45:47 Пользователь: fantome От имени: fantome
0
0
{Даны натуральные числа а1, а2,...,аn. Указать те числа,
у которых остаток от деления на M равен L (0<=L<=M-1). }
const n=20;
type myarray=array [1..n] of integer;
var a:myarray;
m:integer;
procedure init1 (var a:myarray);
var i:integer;
begin
randomize;
for i:=1 to n do
a[i]:=-13+random(27);
end;
procedure print (a:myarray);
var i:integer;
begin
for i:=1 to n do
write (a[i]:6);
writeln;
end;
procedure nomer (var a:myarray);
var l,m,i:integer;
begin
l:=m-1;
for i:=1 to n do
if a[i]>0 then
if a[i] mod m<=l then write (' ',a[i],' ');
end;
begin
init1(a);
writeln('Массив');
print(a);
writeln ('Введите M');
readln (m);
writeln ('Результат ');
nomer(a);
readln;
end.
2018-01-17 22:46:23 Пользователь: fantome От имени: fantome
0
0
{ Расположить столбцы матрицы D[M,N] в порядке возрастания элементов k-ой строки (1<=k<=M). }
const n=5;
m=5;
type dmyarray=array [1..n,1..m] of integer;
omyarray=array [1..n] of integer;
var a:dmyarray;
procedure dinit (var a:dmyarray);
var i,j:integer;
begin
randomize;
for i:=1 to n do
begin
for j:=1 to m do
a[i,j]:=5+random(25);
end;
end;
procedure dprint (a:dmyarray);
var i,j:integer;
begin
for i:=1 to n do
begin
for j:=1 to m do
write (a[i,j]:5);
writeln;
end;
end;
2018-01-17 22:46:54 Пользователь: fantome От имени: fantome
0
0
{Матрица A[N,M](M кратно 4) разделена по вертикали на две
половины. Определить сумму элементов каждого столбца левой половины
и сумму элементов каждого четного столбца правой половины матрицы А.}
const n=8;
m=10;
type dmyarray=array [1..n,1..m] of integer;
omyarray=array [1..n] of integer;
var a:dmyarray;
procedure dinit (var a:dmyarray);
var i,j:integer;
begin
randomize;
for i:=1 to n do
begin
for j:=1 to m do
a[i,j]:=5+random(25);
end;
end;
procedure dprint (a:dmyarray);
var i,j:integer;
begin
for i:=1 to n do
begin
for j:=1 to m do
write (a[i,j]:6);
writeln;
end;
end;
procedure nomer (a:dmyarray);
var j,i,b,s:integer;
begin
writeln(' Результат ');
for j:=1 to m div 2 do
begin
s:=0;
for i:=1 to n do
s:=s+a[i,j];
write (s:6);
end;
for j:=m div 2+1 to m do
begin
s:=0;
if j mod 2 =0 then
for i:=1 to n do
s:=s+a[i,j];
write (s:6);
end;
end;
begin
writeln ('Матpица 5x10');
dinit(a);
dprint(a);
writeln;
nomer (a);
readln;
end.
2018-01-17 22:47:28 Пользователь: fantome От имени: fantome
0
0
{Дана квадратная целочисленная матрица порядка n.
Сформировать результирующий одномерный массив, элементами которого
являются строчные суммы тех строк, которые начинаются с k
идущих подряд положительных чисел.}
const n=5;
m=5;
type dmyarray=array [1..n,1..m] of integer;
omyarray=array [1..n] of integer;
var a:dmyarray;
b:omyarray;
procedure dinit (var a:dmyarray);
var i,j:integer;
begin
randomize;
for i:=1 to n do
begin
for j:=1 to m do
a[i,j]:=5+random(25);
end;
end;
procedure dprint (a:dmyarray);
var i,j:integer;
begin
for i:=1 to n do
begin
for j:=1 to m do
write (a[i,j]:5);
writeln;
end;
end;
{procedure oinit (var b:omyarray; a:dmyarray);
var i,j,s:integer;
begin
for i:=1 to n do
b[i]:=s;
end;
}
procedure oprint (b:omyarray; v:integer);
var i:integer;
begin
for i:=1 to v do
write (b[i]:6);
writeln;
end;
procedure nomer (a:dmyarray);
var v,i,j,k,s:integer;
b:omyarray;
begin
writeln ('Введите К');
readln (k);
for j:=1 to n do
begin
s:=0;
if a[j,1]=k then
for i:=1 to n do
s:=s+a[j,i];
if s<>0 then
begin
inc(v);
b[v]:=s;
writeln(b[v]);
end;
end;
oprint(b,v);
end;
begin
writeln ('Матpица 5x5');
dinit(a);
dprint(a);
nomer (a);
writeln;
{writeln('Одномеpный массив');}
{oprint(b);}
readln;
end.
2018-01-17 22:48:12 Пользователь: fantome От имени: fantome
0
0
{При поступлении в вуз абитуриенты, получившие двойку
на первом экзамене, ко второму не допускаются. В массиве
A[n] записаны оценки экзаменующихся, полученные на первом
экзамене. Подсчитать, сколько человек недопущено ко
второму экзамену.}
const n=20;
type myarray=array [1..n] of integer;
var a:myarray;
c:integer;
procedure init1 (var a:myarray);
var i:integer;
begin
randomize;
for i:=1 to n do
a[i]:=2+random(4);
end;
procedure print (a:myarray);
var i:integer;
begin
for i:=1 to n do
write (a[i]:6);
writeln;
end;
procedure nomer (a:myarray);
var s,i:integer;
begin
s:=0;
for i:=1 to n do
if a[i] =2 then s:=s+1;
writeln (' Кол-во учеников получивших двлйки ',s);
end;
begin
init1(a);
writeln('Массив');
print(a);
nomer(a);
readln;
end.
2018-01-17 22:48:41 Пользователь: fantome От имени: fantome
0
0
{В целочисленной последовательности есть нулевые элементы.
Создать массив из номеров этих элементов}
const n=20;
type myarray=array [1..n] of integer;
var a:myarray;
procedure init1 (var a:myarray);
var i:integer;
begin
randomize;
for i:=1 to n do
a[i]:=-13+random(27);
end;
procedure print (a:myarray);
var i:integer;
begin
for i:=1 to n do
write (a[i]:6);
writeln;
end;
procedure nomer (a:myarray);
var s,i:integer;
begin
s:=0;
for i:=1 to n do
if a[i]=0 then write ( i,' ');
readln;
end;
begin
init1(a);
writeln('Массив');
print(a);
writeln ('Новый массив');
nomer(a);
readln;
end.
2018-01-17 22:49:14 Пользователь: fantome От имени: fantome
0
0
{В последовательности действительных чисел a1,a2,...,an есть только положительные и отрицательные элементы.
Вычислить произведение отрицтельных элементов Р1 и произведение положительных элементов Р2.
Сравнить модуль Р2 с модулем Р1, указать, какое из произведений по модулю больше.}
const n=10;
type myarray=array [1..n] of integer;
var a:myarray;
procedure init1 (var a:myarray);
var i:integer;
begin
randomize;
for i:=1 to n do
a[i]:=-12+random(37);
end;
procedure print (a:myarray);
var i:integer;
begin
for i:=1 to n do
write (' ',a[i]);
writeln;
end;
procedure nomer (var a:myarray);
var i,p1,p2:longint;
begin
p1:=1;
p2:=1;
for i:=1 to n do
if a[i]>0 then p1:=p1*a[i]
else p2:=p2*a[i];
writeln (' ',p1,' ',p2);
p1:=abs(p1);
p2:=abs(p2);
if p1>p2 then writeln ('p1 по модулю > p2')
else writeln ('p2 по модулю > p1');
end;
begin
init1(a);
writeln('Массив');
print(a);
nomer(a);
readln;
end.
2018-01-17 22:50:00 Пользователь: fantome От имени: fantome
0
0
{Дан массив действительных чисел. Среди них есть равные.
Найти первый максимальный элемент массива и заменить его нулем.}
const n=10;
type myarray=array [1..n] of longint;
var a:myarray;
procedure init1 (var a:myarray);
var i:integer;
begin
randomize;
for i:=1 to n do
a[i]:=-7+random(27);
end;
procedure print (a:myarray);
var i:integer;
begin
for i:=1 to n do
write (' ',a[i]);
writeln;
end;
procedure nomer (var a:myarray);
var i,s,b:integer;
begin
b:=0;
s:=a[1];
for i:=1 to n do
if a[i]>=abs(s) then s:=a[i];
for i:=1 to n do
if a[i]>=abs(s) then a[i]:=0;
for i:=1 to n do
write (' ',a[i]);
end;
begin
init1(a);
writeln('Массив');
print(a);
nomer(a);
readln;
end.
2018-01-17 22:50:29 Пользователь: fantome От имени: fantome
0
0
{Дана последовательность целых чисел a1,a2,...,an.
Выяснить, какое число встречается раньше - положительное
или отрицательное.}
const n=20;
type myarray=array [1..n] of integer;
var a:myarray;
procedure init1 (var a:myarray);
var i:integer;
begin
randomize;
for i:=1 to n do
a[i]:=-13+random(27);
end;
procedure print (a:myarray);
var i:integer;
begin
for i:=1 to n do
write (a[i]:6);
writeln;
end;
procedure nomer (a:myarray);
var s,i:integer;
begin
s:=0;
i:=1;
if a[i]=0 then inc(i);
if a[i]>0 then write ('Положительное')
else writeln ('Отpицательное');
readln;
end;
begin
init1(a);
writeln('Массив');
print(a);
nomer(a);
end.
2018-01-17 22:51:10 Пользователь: fantome От имени: fantome
0
0
{В массиве целых чисел с количеством элементов n найти
наиболее часто встречающееся число. Если таких чисел
несколько, то определить наименьшее из них.}
const n=10;
type myarray=array [1..n] of longint;
var a:myarray;
procedure init1 (var a:myarray);
var i:integer;
begin
randomize;
for i:=1 to n do
a[i]:=-5+random(14);
end;
procedure print (a:myarray);
var i:integer;
begin
for i:=1 to n do
write (' ',a[i]);
writeln;
end;
procedure nomer (var a:myarray);
var i,s,b,k,j:integer;
begin
s:=1;
b:=0;
k:=0;
for i:=1 to n do
if a[s]=a[i] then
begin
writeln (' ',a[i]);
b:=b+1;
end;
if b>1 then writeln (' Наименьшее ',a[i]);
end;
begin
init1(a);
writeln('Массив');
print(a);
nomer(a);
readln;
end.
2018-01-17 22:51:40 Пользователь: fantome От имени: fantome
0
0
{Каждый солнечный день улитка, сидящая на дереве, поднимается вверх на 2см, а каждый
пасмурный день опускается на 1 см. В начале набдюдения улитка находилась в А см от
земли а В-метровом дереве. Имеется 30-элементный массив, содержащий сведения о том,
был ли соответствующий день наблюдения пасмурным или солнечным.
Написать программу, определяющую местоположение улитки к концу 30-го дня набдюдения.}
const n=30;
type myarray=array [1..n] of integer;
var a:myarray;
procedure init1 (var a:myarray);
var i:integer;
begin
randomize;
for i:=1 to n do
a[i]:=0+random(2);
end;
procedure print (a:myarray);
var i:integer;
begin
for i:=1 to n do
write (' ',a[i]);
writeln;
end;
procedure nomer (var a:myarray);
var i,am,bm:integer;
begin
writeln ('Введите Am');
readln (am);
writeln ('Введите Bm');
readln (bm);
bm:=bm*100;
for i:=1 to n do
if a[i]=1 then am:=am+2
else am:=am-1;
if am>bm then write ('Улитка упала с деpева');
write (' ',' К концу 30-го дня улитка будет находится в ',am, ' ','см от земли');
writeln;
end;
begin
init1(a);
writeln('Массив');
print(a);
nomer(a);
readln;
end.
2018-01-17 22:52:26 Пользователь: fantome От имени: fantome
0
0
{Дана последовательность целых чисел a1,a2,...,an. Выяснить, будет ли она возрастающей.}
const n=5;
type myarray=array[1..n] of integer;
var i,s:longint;
l:integer;
a:myarray;
procedure init(var a:myarray);
var i:integer;
begin
for i:=1 to n do
read (a[i]);
readln;
end;
procedure maza(a:myarray);
var i,b,l:integer;
begin
l:=0;
for i:=2 to n do
begin
b:=i-1;
if a[b]<a[i] then l:=l+1
else l:=l-1;
end;
if l=4 then writeln ('Возpастающая')
else writeln ('Не возpастающая');
end;
begin
writeln ('Введите числа числа чеpез пpобел');
init (a);
maza (a);
readln;
end.
2018-01-17 22:52:50 Пользователь: fantome От имени: fantome
0
0
{Дана послдовательность натуральных чисел a1,a2,...,an.
Создать массив из четных чисел этой последовательности.
Если таких чисел нет, то выдать сообщение об этом.}
const n=20;
type myarray=array [1..n] of integer;
var a:myarray;
procedure init1 (var a:myarray);
var i:integer;
begin
randomize;
for i:=1 to n do
a[i]:=-13+random(27);
end;
procedure print (a:myarray);
var i:integer;
begin
for i:=1 to n do
write (a[i]:6);
writeln;
end;
procedure nomer (a:myarray);
var l,i:integer;
begin
for i:=1 to n do
if a[i] mod 2=0 then
begin
write (' ', a[i] ,' ');
l:=l+1;
end;
if l=0 then writeln ('Четных чисел нет ');
readln;
end;
begin
init1(a);
writeln('Массив');
print(a);
writeln ('Новый массив');
nomer(a);
readln;
end.
2018-01-17 22:53:28 Пользователь: fantome От имени: fantome
0
0
{Дан массив из n четырехзначных натуральных чисел.
Вывести на экран только те, у которых сумма первых двух
цифр равна сумме двух последних.}
const n=100;
type myarray=array [1..n] of integer;
var a:myarray;
c:integer;
procedure init1 (var a:myarray);
var i:integer;
begin
randomize;
for i:=1 to n do
a[i]:=1000+random(9999);
end;
procedure print (a:myarray);
var i:integer;
begin
for i:=1 to n do
write (a[i]:6);
writeln;
end;
procedure nomer (a:myarray);
var c,s,p,q,i:integer;
begin
for i:=1 to n do
begin
c:=a[i] div 100;
s:=(c div 10) + (c mod 10);
p:=a[i] mod 100;
q:=(p div 10)+(p mod 10);
if s=q then write (a[i]:6);
end;
end;
begin
init1(a);
writeln('Массив');
print(a);
writeln ('Результат');
nomer(a);
readln;
end.
2018-01-17 22:54:04 Пользователь: fantome От имени: fantome
0
0
{Дана последовательность действительных чисел a1,a2,...,an.
Заменить все ее члены, большие данного Z, этим числом.
Подсчитать количество замен.}
const n=20;
type myarray=array [1..n] of integer;
var a:myarray;
procedure init1 (var a:myarray);
var i:integer;
begin
randomize;
for i:=1 to n do
a[i]:=-13+random(27);
end;
procedure print (a:myarray);
var i:integer;
begin
for i:=1 to n do
write (a[i]:6);
writeln;
end;
procedure nomer (a:myarray);
var z,l,i:integer;
begin
l:=0;
writeln ('Введите число ');
readln (z);
for i:=1 to n do
begin
if a[i]>z then
begin
write (z);
inc(l);
end
else write (' ',a[i],' ');
end;
writeln;
writeln ('Было замен ', l);
readln;
end;
begin
init1(a);
writeln('Массив');
print(a);
nomer(a);
readln;
end.
2018-01-17 22:54:28 Пользователь: fantome От имени: fantome
0
0
{Дан массив действительных чисел, размерность которого N.
Подсчитать, сколько в нем отрицательных, положительных и
нулевых элментов.}
const n=20;
type myarray=array [1..n] of integer;
var a:myarray;
procedure init1 (var a:myarray);
var i:integer;
begin
randomize;
for i:=1 to n do
a[i]:=-13+random(27);
end;
procedure print (a:myarray);
var i:integer;
begin
for i:=1 to n do
write (a[i]:6);
writeln;
end;
procedure nomer (a:myarray);
var p,o,t,i:integer;
begin
p:=0;
o:=0;
t:=0;
for i:=1 to n do
begin
if a[i]>0 then inc(p);
if a[i]<0 then inc(o);
if a[i]=0 then inc(t);
end;
writeln ('Положительные - ',p);
writeln ('Отpицательные - ',o);
writeln ('Нулевые - ',t);
end;
begin
init1(a);
writeln('Массив');
print(a);
nomer(a);
readln;
end.
2018-01-17 22:54:51 Пользователь: fantome От имени: fantome
0
0
{Имеется n судей, которые ставят оценки.
Найти среднюю оценку.}
program njudge;
var n, {кол-во судей}
i, {переменная цикла}
m, {кол-во не нулевых элементов}
j:integer; {кол-во совпадающих элементов}
min, {минимальная оценка}
max, {максимальная оценка}
sumsred,{средняя оценка}
sum:real; {сумма всех оценок}
marks: array[1..10] of real;{}
begin
Writeln ('Введите количество судей');
Readln (n);
for i:=1 to n do
Readln (marks[i]);
{проверка, если все оценки совпадают}
for i:=1 to n do
if marks[1]=marks[i] then
begin
inc(j);
end;
if j=n then Writeln ('Средняя оценка ',marks[1]);
{поиск минимальной оценки}
min:=marks[1];
for i:=1 to n do
if min>marks[i] then min:=marks[i];
{поиск максимальной оценки}
max:=marks[1];
for i:=1 to n do
if max<marks[i] then max:=marks[i];
{выбрасывание из учета макс. и мин. оценки}
for i:=1 to n do
if marks[i]=min then marks[i]:=0;
for i:=1 to n do
if marks [i]=max then marks[i]:=0;
{вычисление средней оценки}
m:=0;
sum:=0;
for i:=1 to n do
if marks[i]<>0 then inc(m);
for i:=1 to n do
sum:=sum+marks[i];
if j<>n then
begin
sumsred:=sum/m;
Writeln ('Средняя оценка ',n,' судей');
Writeln ('равна: ',sumsred);
end;
Readln;
end.
Оставить комментарий
Похожие материалы:
Похожие разделы:
Соседние разделы
https://wfi.lomasm.ru/русский.компьютерный_форум/задачи_с_готовым_решением_на_языке_pascal