Gotoxy(yy, xx); writeln(a);
End;
End;
End.
сяца продавец доставлялна дом 4 л молока в день. В марте молоко стоило х руб за литр Спервого апреля цена молока увеличилась до [x+a] руб за литр Сколько надо заплатить продавцу за все доставленное молоко в конце апреля? Кол-во покупаемого молока осталось прежним}
Uses crt;
var march,april,payment:real;
Begin;
Clrscr;
writeln('Введите стоимость отпускаемого молока в марте');
Readln(march);
writeln('Введите стоимость отпускаемого молока в апреле');
Readln(april);
payment:= march * 4 * 31 + april * 4 * 30;
writeln('Вы должны заплатить с 1-го марта по 30-е апреля включительно ',payment:7:2, ' руб.')
End.
{56 }
Uses crt;
var x,y,i,j,s:integer;
Begin
Clrscr;
writeln('Введите размер таблицы (x,y)');
Readln(x);
Readln(y);
Clrscr;
for i:=1 to x do;
for j:=1 to y do;
s(i,j):=(j+(i-1)*y)*(j+(i-1)*y);
locate i*2,j*4: writeln(s(i,j));
Next j;
Next i;
End.
{57 }
Uses crt;
var x,y,i,j,s:integer;
Begin
Clrscr;
writeln('Введите размер таблицы (x,y)');
Readln(x);
Readln(y);
Clrscr;
for i:=1 to x do;
for j:=1 to y do;
s(i,j):=(j+(i-1)*y)*2;
locate i*2,j*4: writeln(s(i,j));
Next j;
Next i;
End.
{58. }
Uses crt;
var i,k,pol,numberofpol,chplace,plus,zero,minus,forabout:integer;
a:array[1..10000] of integer;
Begin
Clrscr;
write ('Введите размер массива ');
Read(i);
Begin
writeln('Введите элементы массива');
FOR k := 1 TO i do
Begin
readln(a[k]);
End;
FOR k := 1 TO i do
IF a[k] > 0 THEN
Begin
pol := pol + a[k]; numberofpol := numberofpol + 1;
End;
End;
writeln('Среднее арифмет.положительных элементов равно ', pol / numberofpol:7:2);
writeln('Среднее арифмет. элементов на отрезке [1,2] равно', (a[1] + a[2]) / 2:7:2);
FOR k := 1 TO i do
Begin
IF a[k] > 0 THEN plus := plus + 1;
IF a[k] = 0 THEN zero := zero + 1;
IF a[k] < 0 THEN minus := minus + 1;
End;
writeln('Положительных ', plus, ' отрицательных ', minus, ' равных нулю ', zero);
FOR k := 1 TO i do
Begin
IF round(a[k]) = 1 THEN forabout := forabout + 1;
End;
writeln('Элементов приближенно равных 1 насчитано ', forabout);
End.
{59. Сформировать массив из положительных элементов}
Uses crt;
var i,k,pr,size,max:integer;
b:array[1..10] of integer;
a:array[1..10] of integer;
Begin;
Clrscr;
pr:= 1;
writeln('Введите размер массива');
Readln(size);
writeln('Введите элементы массива');
FOR i := 1 TO size do
Begin
readln(b[i]);
End;
Begin
IF b[i] > 0 THEN
Begin
k := k + 1;
a[k] := b[i];
End;
End;
FOR i := 1 TO k do
Begin
pr := pr * a[i];
End;
writeln('Произведение положительных эл.массива ', pr);
writeln('Cформираванный массив A(I):');
FOR i := 1 TO k do
Begin
writeln(a[i]);
End;
End.
{60. Заменить все элементы массива стоящие до максимального нулями}
Uses crt;
var i,size,num,max:integer;
a:array[1..10000] of integer;
Begin;
ClrScr;
writeln('Введите размер массива');
Readln(size);
FOR i := 1 TO size do
Begin
Clrscr;
writeln('Введите элементы массива');
readln(a[i]);
End;
max := a[1];
Clrscr;
writeln('Введенный массив');
FOR i := 1 TO size do
Begin
writeln(a[i]);
IF a[i] > max THEN
Begin
num := i-1;
max:=a[i];
End
End;
FOR i := 1 TO num do
Begin
a[i] := 0;
End;
writeln('Сформированный массив');
FOR i := 1 TO size do
Begin
writeln (a[i]);
End;
End.
{62. Заменить все элементы массива стоящие после минимального нулями}
Uses crt;
var i,size,min,num:integer;
a:array[1..10000] of integer;
Begin;
Clrscr;
writeln('Введите размер массива');
Readln(size);
writeln('Введите элементы массива');
FOR i := 1 TO size do
Begin
readln(a[i]);
End;
min := a[1];
FOR i := 2 TO size do
Begin
IF a[i] < min THEN
Begin
num := i + 1;min:=a[i];
End;
End;
FOR i := num TO size do
Begin
a[i] := 0;
End;
writeln('Сформированный массив:');
FOR i := 1 TO size do
Begin
writeln(a[i]);
End;
End.
{63. Определить сколько элементов массива <,>,= X}
Uses crt;
var x,i,size,more,less,mid:integer;
a:array[1..10000] of integer;
Begin
CLrscr;
writeln('Введите размер массива');
Readln(size);
writeln('Введите элементы массива');
FOR i := 1 TO size do
Begin
readln(a[i])
End;
writeln('Введите число x');
Readln(x);
FOR i := 1 TO size do
Begin
IF a[i] > x THEN more := more + 1;
IF a[i] < x THEN less := less + 1;
IF a[i] = x THEN mid := mid + 1;
End;
writeln('Больше числа Х в массиве элементов ',more);
writeln('Меньше числа Х в массиве элементов ',less);
writeln('Равных числу Х в массиве элементов ', mid);
End.
{64. Сколько в массиве Т(м) элементов меньших суммы всех элементов}
Uses crt;
var i,size,summa,num:integer;
t:array[1..10000] of integer;
Begin;
Clrscr;
writeln('Введите размер массива');
Readln(size);
writeln('Введите элементы массива');
FOR i := 1 TO size do
Begin
readln(t[i]);
End;
FOR i := 1 TO size do
Begin
summa := summa + t[i];
End;
FOR i:= 1 TO size do
Begin
IF t[i] < summa THEN num := num + 1;
End;
writeln('В массиве элементов меньше суммы всех элементов ', num);
End.
{65. Напечатать сумму, произведение и номера полож элементов после последнего нулевого элемента }
Uses crt;
var i,size,num,summa,pr,k:integer;
x:array[1..10000] of integer;
n:array[1..10000] of integer;
Begin;
Clrscr;
writeln('Введите размер массива');
Readln(size);
FOR i := 1 TO size do
Begin
Clrscr;
writeln('Введите элементы массива');
readln(x[i]);
End;
writeln('Введенный массив');
FOR i := 1 TO size do
Begin
writeln(x[i]);
IF x[i] = 0 THEN num := i;
End;
if num=0 then
Begin
writeln('Нулевые элементы не найдены');
Halt;
End;
pr := 1;
FOR i := num + 1 TO size do
Begin
IF x[i] > 0 THEN
Begin
summa := summa + x[i]; pr := pr * x[i]; k := k + 1; n[k] := i;
End;
End;
writeln('Номера положительных элементов после последнего 0');
FOR i := k TO size do
Begin
writeln(n[i]);
End;
writeln('Сумма положительных элементов после последнего 0 равна ', summa);
writeln('Произведение положительных элементов после последнего 0 равна ', pr);
End.
{66. Найти сумму и кол-во элементов в массиве Т после первого нулевого элемента}
Uses crt;
var i,num,size,summa,k:integer;
t:array[1..10000] of integer;
Begin;
Clrscr;
writeln('Введите размер массива');
Readln(size);
FOR i := 1 TO size do
Begin
Clrscr;
writeln('Введите элементы массива');
readln(t[i]);
End;
writeln('Введенные элементы');
for i:=1 to size do
Begin
writeln(t[i]);
End;
FOR i := 1 TO size do
Begin
IF t[i] = 0 THEN
num := i;
FOR k := num + 1 TO size do
Begin
summa := summa + t[k];
End;
writeln('Сумма элементов после первого 0 равна ', summa);
writeln('Количество элементов после первого 0 равна ', size - i);
Halt;
End;
End.
{67. Напечатать сумму отрицательных элементов массива А после первого нулевого элемента}
Uses crt;
var i,size,num,summa:integer;
a:array [1..10000] of integer;
Label 1;
Begin;
Clrscr;
writeln('Введите размер массива');
Readln(size);
writeln('Введите элементы массива');
FOR i := 1 TO size do
Begin
readln(a[i]);
End;
FOR i := 1 TO size do
Begin
IF a[i] = 0 THEN
Begin
num := i; GOTO 1;
End;
End;
1:
FOR i := num + 1 TO size do
Begin
IF a[i] < 0 THEN summa := summa + a[i];
End;
writeln('Сумма отрицательных элементов после первого 0 равна ', summa);
End.
{68 Вывести номер координаты пункта В наиболее удаленного от пункта А}
Uses crt;
var maxx,maxy,i,m,x,y,n:integer;
bx:array[1..1000] of integer;
by:array[1..1000] of integer;
bx1:array[1..1000] of integer;
by1:array[1..1000] of integer;
Begin;
Clrscr;
writeln('Введите координаты пункта А(x и y через Enter) ');
Readln(x);
Readln(y);
writeln('Введите количество пунктов В');
Readln(m);
Clrscr;
FOR i := 1 TO m do
Begin
gotoxy(1,1);writeln('Введите координаты пунктов B(x и y через Enter)');
readln(bx[i]);
readln(by[i]);
End;
FOR i := 1 TO m do
Begin
bx1[i] := SQR(bx[i]*bx[i]);
by1[i] := SQR(by[i]*by[i]);
IF (bx1[i] > x) AND (by1[i] > y) AND (bx1[i] > maxx) AND (by1[i] > maxy) THEN
Begin
maxx := bx1[i]; maxy := by1[i]; n := i;
End;
End;
Clrscr;
writeln('Точка A ',x,',',y);
writeln('Точки B ');
for i:=1 to m do
Begin
writeln(bx[i],',',by[i]);
End;
writeln('Наиболее удалена точка с координатами ', bx[n], ',', by[n]);
End.
{69. Найти общее кол-во нулевых элементов в массивах Х(м) У(к)}
Uses crt;
var i,m,k,num,numm,nn:integer;
x:array[1..10000] of integer;
y:array[1..10000] of integer;
Begin;
Clrscr;
writeln('Введите размер массива x(m)');
Readln(m);
writeln('Введите размер массива y(k)');
Readln(k);
writeln('Введите элементы массива x(m)');
FOR i := 1 TO m do
Begin
readln(x[i]);
End;
writeln('Введите элементы массива y(k)');
FOR i := 1 TO k do
Begin
readln(y[i]);
End;
FOR i := 1 TO m do
Begin
IF x[i] = 0 THEN num := num + 1;
End;
FOR i := 1 TO k do
Begin
IF y[i] = 0 THEN numm := numm + 1;
End;
if num>numm then nn:=numm else nn:=num;
writeln('Общее количество нулевых элементов в двух массиваx ', nn);
End.
{70. Напечатать число элементов в массиве Т}
Uses crt;
var i,m,k,num:integer;
x:array[1..10000] of integer;
t:array[1..10000] of integer;
Begin;
Clrscr;
writeln('Введите размер массива x(m)');
Readln(m);
FOR i := 1 TO m do
Begin
Clrscr;
writeln('Введите элементы массива x(m)');
readln(x[i]);
Clrscr;
End;
writeln('Введенный массив');
FOR i := 1 TO m do
Begin
writeln (x[i]);
IF x[i] >= 0 THEN
Begin
num := num + 1; k := k + 1; t[k] := x[i];
End;
End;
writeln('Сформированный массив');
FOR i := 1 TO k do
Begin
writeln (t[i]);
End;
writeln('Количество элементов в сформированном массиве ', num);
End.
{71. Вывести четные числа среди положительных элементов}
Uses crt;
var i,m:integer;
x:array[1..10000] of integer;
Begin;
Clrscr;
writeln('Введите размер массива x(m)');
Readln(m);
writeln('Введите элементы массива x(m)');
FOR i := 1 TO m do
Begin
readln(x[i]);
End;
Clrscr;
gotoxy(5,6);writeln('Четные среди положительных элементов массива');
FOR i := 1 TO m do
Begin
IF (x[i] > 0) AND (x[i] / 2 = INT(x[i] / 2)) THEN
Begin
gotoxy(i*3+5,8); writeln( x[i]); end;
gotoxy(i*3+5,10);writeln(x[i]);
End;
End.
{72. Удвоить наибольший элемент массива Х(м)}
Uses crt;
var max,i,size,k:integer;
x:array[1..10000] of integer;
Begin;
Clrscr;
writeln('Введите размер массива');
Readln(size);
writeln('Введите элементы массива');
FOR i := 1 TO size do
Begin
readln(x[i]);
End;
max := x[1];
FOR i := 2 TO size do
Begin
IF x[i] > max THEN
Begin
max := x[i]; k := i;
End;
End;
x[k] := max * 2;
writeln('Массив с удвоенным максимальным элементом');
FOR i := 1 TO size do
Begin
writeln (x[i]);
End;
End.
{73. Вывести ненулевые элементы массива Х(м) и их произведение}
Uses crt;
var size,i,pr:integer;
x:array[1..10000] of integer;
Begin;
Clrscr;
writeln('Введите размер массива');
Readln(size);
writeln('Введите элементы массива');
FOR i := 1 TO size do
Begin
readln(x[i]);
End;
pr := 1;
writeln('Ненулевые элементы массива');
FOR i := 1 TO size do
Begin
IF x[i] <> 0 THEN
Begin
writeln(x[i]); pr := pr * x[i];
End;
End;
writeln('Их произведение ',pr);
End.
{74. Вывести положительные элементы массива Х(к) затем отрицать элементы массива У(м) и кол-во выведенных чисел}
Uses crt;
var m,num,i,k:integer;
x:array[1..10000] of integer;
y:array[1..10000] of integer;
Begin
Clrscr;
writeln('Введите размер массива x(k)');
Readln(k);
writeln('Введите размер массива y(m)');
Readln(m);
writeln('Введите элементы массива x(k)');
FOR i := 1 TO k do
Begin
readln(x[i]);
End;
writeln('Введите элементы массива y(m)');
FOR i := 1 TO m do
Begin
readln(y[i]);
End;
writeln('Положительные элементы массива x(k)');
FOR i := 1 TO k do
Begin
IF x[i] > 0 THEN
Begin
writeln (x[i]);
num := num + 1;
End;
End;
writeln('Отрицательные элементы массива y(m)');
FOR i := 1 TO m do
Begin
IF y[i] < 0 THEN
Begin
writeln(y[i]); num := num + 1;
End;
End;
writeln('Количество выведенных элементов ', num);
End.
{75. Найти число элементов массива Т мньших С }
Uses crt;
var m,i,c,summa,num:integer;
t:array[1..10000] of integer;
Begin
Clrscr;
writeln('Введите размер массива t(m)');
Readln(m);
writeln('Введите число C');
Readln(c);
writeln('Введите элементы массива t(m)');
FOR i := 1 TO m do
Begin
readln(t[i]);
End;
FOR i := 1 TO m do
Begin
IF t[i] > c THEN
Begin
summa := summa + t[i]; num := num + 1;
End;
End;
writeln('Среднее арифметическое элементов больше C равно ', summa / num:7:2);
writeln('Количество элементов меньше С равно ',m - num);
End.
{76. Произвести перестановку массива}
Uses crt;
var m,x,i,k:integer;
a:array[1..10000] of integer;
a2:array[1..10000] of integer;
Begin;
Clrscr;
writeln('Введите размер массива a(m)');
Readln(m);
writeln('Введите число x');
Readln(x);
FOR i := 1 TO m do
Begin
Clrscr;
writeln('Введите элементы массива a(m)');
readln(a[i]);
End;
Clrscr;
writeln('Введенный массив');
FOR i := 1 TO m do
Begin
writeln(a[i]);
IF a[i] < x THEN
Begin
k := k + 1; a2[k] := a[i];
End;
End;
FOR i := 1 TO m do
Begin
IF a[i] = x THEN
Begin
k := k + 1; a2[k] := a[i];
End;
End;
FOR i := 1 TO m do
Begin
IF a[i] > x THEN
Begin
k := k + 1; a2[k] := a[i]
End;
End;
writeln('Сформированный массив');
FOR i := 1 TO m do
Begin
writeln (a2[i]);
End;
End.
{77. Образовать третий массив из элементов встречающихся в обоих массивах}
Uses crt;
var m,k,i,l,c:integer;
a:array[1..10000] of integer;
b:array[1..10000] of integer;
ab:array[1..10000] of integer;
Begin;
Clrscr;
writeln('Введите размер массива a(m)');
Readln(m);
writeln('Введите размер массива b(k)');
Readln(k);
Clrscr;
writeln('Введите элементы массива a(m)');
FOR i := 1 TO m do
Begin
readln(a[i]);
End;
writeln('Введите элементы массива b(k)');
FOR i := 1 TO m do
Begin
readln(b[i]);
End;
FOR i := 1 TO m do
Begin
FOR l := 1 TO k do
Begin
IF a[i] = b[l] THEN
Begin
c := c + 1; ab[c] := a[l];
End;
End;
End;
Clrscr;
writeln('Массив образованный из одинаковых элементов');
FOR i := 1 TO c do
Begin
writeln (ab[i]);
End;
End.
{78. Поменять местами макс и мин элементы}
Uses crt;
var i,size,max,min,num,num1:integer;
a:array[1..10000] of integer;
Begin
Clrscr;
writeln('Bведите размер массива');
Readln(size);
FOR i := 1 TO size do
Begin
Clrscr;
writeln('Введите элементы массива');
readln(a[i]);
End;
max := a[1];
min := a[1];
Clrscr;
writeln('Введенный массив');
FOR i := 1 TO size do
Begin
writeln(a[i]);
IF a[i] > max THEN
Begin
num := i; max := a[i];
End;
End;
FOR i := 1 TO size do
Begin
IF a[i] < min THEN
Begin
num1 := i; min := a[i];
End;
End;
a[num1 + 1] := max;
a[num] := min;
writeln('Массив, где max и min поменяли местами');
FOR i := 1 TO size do
Begin
writeln(a[i]);
End;
End.
{79. Поменять местами макс и последний элемент }
Uses crt;
var i,max,num,size:integer;
a:array[1..10000] of integer;
Begin;
Clrscr;
writeln('Введите размер массива');
Readln(size);
FOR i := 1 TO size do
Begin
Clrscr;
writeln('Введите элементы массива');
readln(a[i])
End;
max := a[1];
Clrscr;
writeln('Введенный массив');
FOR i := 1 TO size do
Begin
writeln(a[i]);
IF a[i] > max THEN
Begin
num := i; max := a[i];
End;
End;
a[num] := a[size];
a[size] := max;
writeln('Массив, где max и последний элемент поменяли местами');
FOR i := 1 TO size do
Begin
writeln (a[i]);
End;
End.
{80 Сколько раз во втором слове встречается первая буква первого слова}
Uses crt;
var x,x1,i,c,dl,ch,n:integer;
word,word1,k:string;
Label 1;
Begin
Clrscr;
writeln('Введите первое слово');
Readln(word);
writeln('Введите второе слово');
Readln(word1);
dl:=length(word1);
k:=copy(word,1,1);
ch:=0;
n:=pos(k,word1);
1:if n>0 then
Begin
ch:=ch+1;
Delete(word1,1,n);
dl:=length(word1);
if dl>0 then
Begin
n:=pos(k,word1);
Goto 1;
End
End;
writeln('Во втором слове буква ',k,' встречается ',ch,' раз(а)');
End.
{81. }
Uses crt;
var n:integer;
Begin
Clrscr;
writeln('Введите 0 или 2');
Readln(n);
if n=0 then
Begin
writeln('БУКВА И ЗВУК');
End
else writeln('БУКВА И БАБОЧКА');
End.
{82.}
Uses crt;
var st0,st1,st2,st3,st4,st5,st6,st7,st8,st9,ST10,ST11,st12,d:string;
Begin
Clrscr;
writeln('БАЛКОН');
writeln(' ');
st0:='БАЛКОН';
st1:=copy(st0,3,1);
st2:=copy(st0,5,1);
st3:=copy(st0,1,1);
d:=st1+st2+st3;
Writeln(d);
st4:=copy(st0,4,1);
st5:=copy(st0,3,1);
st6:=copy(st0,2,1);
st7:=copy(st0,6,1);
d:=st4+st5+st6+st7;
Writeln(d);
st8:=copy(st0,4,1);
st9:=copy(st0,5,1);
st10:=copy(st0,3,1);
st11:=copy(st0,1,1);
st12:=copy(st0,2,1);
d:=st8+st9+st10+st11+st12;
Writeln(d);
End.
{83}
Uses crt;
var st0,st1,st2,st3,st4,st5,st6,st7,st8,st9,ST10,ST11,st12,d:string;
Begin
Clrscr;
writeln('ШУТКА');
writeln(' ');
st0:='ШУТКА';
st1:=copy(st0,1,1);
st2:=copy(st0,2,1);
st3:=copy(st0,3,1);
d:=st1+st2+st3;
Writeln(d);
st4:=copy(st0,2,1);
st5:=copy(st0,3,1);
st6:=copy(st0,4,1);
st7:=copy(st0,5,1);
d:=st4+st5+st6+st7;
Writeln(d);
st8:=copy(st0,3,1);
st9:=copy(st0,2,1);
st10:=copy(st0,1,1);
st11:=copy(st0,4,1);
st12:=copy(st0,5,1);
d:=st8+st9+st10+st11+st12;
Writeln(d);
End.
{84. Составить программу для подсчета числа букв А Б В в предложении}
Uses crt;
var a,b,c,x,y:integer;
dl,ch,n,cha,chb,chv:integer;
text,text1:string;
aa,bb,vv,cc:char;
Label 1,2,3;
Begin
Clrscr;
writeln('какие символы будем считать(a,b,c-через Enter)');
Readln(aa);
Readln(bb);
Readln(vv);
writeln('Введите текст');
Readln(text);
dl:=length(text);
text1:=text;
cha:=0;
chb:=0;
chv:=0;
n:=pos(aa,text);
1:if n>0 then
Begin
cha:=cha+1;
Delete(text1,1,n);
dl:=length(text1);
if dl>0 then
Begin
n:=pos(aa,text1);
Goto 1;
End
End;
text1:=text;
n:=pos(bb,text1);
2:if n>0 then
Begin
chb:=chb+1;
Delete(text1,1,n);
dl:=length(text1);
if dl>0 then
Begin
n:=pos(bb,text1);
Goto 2;
End
End;
text1:=text;
n:=pos(vv,text1);
3:if n>0 then
Begin
chv:=chv+1;
Delete(text1,1,n);
dl:=length(text1);
if dl>0 then
Begin
n:=pos(vv,text1);
Goto 3;
End
End;
writeln('В предложениии ',aa,' встречается ',cha,' раз(а) ');
writeln('В предложениии ',bb,' встречается ',chb,' раз(а) ');
writeln('В предложениии ',vv,' встречается ',chv,' раз(а) ');
End.
{85 Поставить буквы в алфавитном порядке}
Uses crt;
var dl,ch,n,i,k:integer;
text,alf,c,sim,buk:string;
d:array[1..32] of integer;
Label 1;
Begin
Clrscr;
writeln('Введите текст');
Readln(text);
dl:=length(text);
alf:='абвгдежзийклмнопрстуфхцчшщъыьэюя';
Clrscr;
for k:=1 to 32 do
d[k]:=0;
for i:=1 to dl do
Begin
sim:=copy(text,i,1);
for k:=1 to 32 do
Begin
buk:=copy(alf,k,1);
if sim=buk then
d[k]:=d[k]+1;
End;
End;
for i:=1 to 32 do
Begin
if d[i]<>0 then
Begin
gotoxy(i*2+5,15);
writeln(alf[i]);
gotoxy(i*2+5,18);
writeln(d[i]);
End
End;
Gotoxy(5,13);
Writeln(text);
End.
{86. Найти в тексте подстроку "авс"}
Uses crt;
var m:string[79];
k:string[79];
i:integer;
position:byte;
Procedure Search;
Begin
Position:=pos(k,m);
IF position<>0 then sound(100);delay(10);nosound;
End;
Begin;
Textbackground(0);
Clrscr;
writeln('Введите предложение');
Readln(m);
writeln('Какие символы следует найти');
Readln(k);
Clrscr;
Search;
Writeln(m);