Для студентов МГТУ им. Н.Э.Баумана 1 семестрa по предмету Информатика Готовые решённые задачи в формате ТХТГотовые решённые задачи в формате ТХТ 2013-08-16 СтудИзба

Готовые решённые задачи в формате ТХТ

Описание

Описание файла отсутствует
Картинка-подпись

Список файлов в архиве

Города и температура

program temperatura;

{$APPTYPE CONSOLE}

uses

SysUtils;

type goroda=record

nazvanie:string[20];

temp:integer;

end;

tmas=array[1..10] of goroda;

massiv=array[1..20] of string;

procedure VVOD (var A:tmas;var n:integer);

var i:integer;

begin

writeln('VVedite kolichestvo gorodov');

readln(n);

for i:=1 to n do begin

writeln('Vvedite nazvanie');

readln(A[i].nazvanie);

writeln('Vvedite temperaturu');

readln(A[i].temp);

end;

end;

procedure VIBOR (A:tmas;n:integer;var B:massiv;var kol:integer);

var i,nizk:integer;

begin

nizk:=a[1].temp;

for i:=1 to n do if a[i].temp<nizk then nizk:=a[i].temp;

kol:=0;

for i:=1 to n do if a[i].temp=nizk then begin

kol:=kol+1;

B[kol]:=a[i].nazvanie;

end;

end;

procedure SORT (var B:massiv;kol:integer);

var i,j:integer;

buf:string;

begin

for j:=1 to kol-1 do

for i:=1 to kol-j do

if B[i]> B[i+1]then begin

buf:=B[i];

B[i]:=B[i+1];

B[i+1]:=buf;

end;

end;

var Gor:tmas;

Nizk:massiv;

i,n,k:integer;

begin

VVOD(Gor,n);

VIBOR(Gor,n,Nizk,k);

SORT(Nizk,k);

writeln;

Writeln ('Yporiadochennii massiv strok');

for i:=1 to k do write (Nizk[i],' ');

writeln;

readln;

end.

Другая задача с точками

запись точки,сортирует по длине от точки до следующей точки

program Project1;

{$APPTYPE CONSOLE}

uses

SysUtils;

type XY=record

x:integer;

x1:integer;

y:integer;

y1:integer;

l:real;

end;

Tmas=array [1..100] of XY;

procedure vvod (var A:tmas;var n:integer);

Var i:integer;

begin

writeln ('vvedite kolvo elementov');

readln (n);

writeln ('VVEDITE massiv');

for i:=1 to n do begin

writeln ('vvedite x');

readln (A[i].x);

writeln ('vvedite x1') ;

readln (A[i].x1);

writeln ('vvedite y');

readln (a[i].y);

writeln ('vvedite Y1') ;

readln (A[i].y1); end;

end;

procedure vivod (a:tmas;n:integer);

var i: integer;

begin

writeln ('l' );

for i:=1 to n do

writeln (A[i].l:2:3);

end;

procedure sort (var A:tmas;var n:integer);

var i,j:integer; b:XY;

begin

for i:=1 to n do

A[i].l:=sqrt(sqr(A[i].x-A[i].x1)+sqr(A[i ].y-A[i].y1));

for i:=1 to n do begin

for j:=1 to n-i do

if a[j].l>a[j+1].l then begin

b:=A[j];

A[j]:=A[j+1];

A[j+1]:= B; end; end;

end;

var b:tmas;k:integer;

BEGIN

vvod (b,k);

sort (b,k);

vivod (b,k);readln;

END.

Куклы

program igruski;

{$APPTYPE CONSOLE}

uses

SysUtils;

type igruski=record

nazvanie:string[10];

zena:integer;

min:integer;

max:integer;

end;

tmas=array[1..10] of igruski;

procedure VVOD (var A:tmas; var n:integer);

var i:integer;

begin

repeat writeln('Vvedite kolichestvo igrushek (ne bolshe 10)');

readln(n);

until n<=10;

for i:=1 to n do begin

writeln('Vvedite nazvanie');

readln(A[i].nazvanie);

writeln('Vvedite zenu');

readln(A[i].zena);

writeln('Vvedite minimalnii vozrast');

readln(A[i].min);

writeln('Vvedite maximalnii vozrast');

readln(A[i].max);

end;

end;

procedure PROV (A:tmas;n:integer;sum:integer;vozr:integ er;var C:tmas;var kol:integer);

var i:integer;

begin

kol:=0;

for i:=1 to n do if (sum>A[i].zena) and (vozr>a[i].min) and (vozr<a[i].max) then begin

kol:=kol+1;

C[kol]:=A[i];

end;

end;

procedure VIVOD (A:tmas;kol:integer);

var i:integer;

begin

if kol=0 then writeln('Takix igrushek net')

else writeln ('Nazvanie Zena Min vozr Max vozr');

for i:=1 to kol do writeln (A[i].nazvanie,' ',A[i].zena,' ',A[i].min,' ',A[i].max);

end;

var B,D:tmas;

n,k,summa,vozrast:integer;

begin

VVOD(B,n);

writeln ('Vvedite vashu summu deneg');

readln(summa);

writeln('Vvedite vozrast rebenka');

readln(vozrast);

writeln('Isxodnii massiv');

VIVOD(B,n);

writeln;

writeln('To,chto podoidet po vozrastu i zene');

PROV(B,n,summa,vozrast,D,k);

VIVOD(D,k);

readln;

end.

PROV(B,n,D,k);

VIVOD(D,k);

readln;

end.

Спортсмены

program cpot;

{$APPTYPE CONSOLE}

uses

SysUtils;

type sport=record

fam:string[10];

ball:array [1..3] of integer;

end;

sportsmen=array[1..10] of sport;

procedure VVOD(var A:sportsmen; var n:integer);

var i,j:integer;

begin

writeln('Vvedite kolichestvo sportsmenov');

readln(n);

for i:=1 to n do begin

writeln('Vvedite familiu');

readln(A[i].fam);

writeln('Vvedite 3 rezultata');

for j:=1 to 3 do begin

read (a[i].ball[j]);

end;

readln;

end;

end;

procedure VIVOD(A:sportsmen;n:integer);

var i,j:integer;

begin

writeln('Familia ball 1 ball 2 ball 3');

for i:=1 to n do begin writeln(a[i].fam,' ');

for j:=1 to 3 do write(a[i].ball[j]:6);

end;

end;

function REC (A:sportsmen;n:integer;star:integer):boo lean;

var i,j,s:integer;

begin

REC:=false;

for i:=1 to n do begin

S:=0;

for j:=1 to 3 do S:=s+a[i].ball[j];

if S>star then

REC:=true;

end;

end;

var Sp:sportsmen;

n,star:integer;

begin

VVOD(Sp,n);

writeln('Vvedite starii rezultat');

readln(star);

if REC(Sp,n,star) then writeln('ruzeltat pobit')

else writeln('rezultat ne pobit');

readln;

end.

Точки

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

program toch;

{$APPTYPE CONSOLE}

uses

SysUtils;

type tochki=record

x:real;

y:real;

end;

tmas=array[1..20] of tochki; {massiv tochek}

var n,m:integer;

t:tmas;

i:integer;

procedure vvod(n1:integer;var t1:tmas);

var i:integer;

begin

for i:=1 to n1 do begin

writeln('Vvedite koordinaty X',i);readln(t1[i].x);

writeln('Vvedite koordinaty Y',i);readln(t1[i].y);

end;

end;

procedure vivod(n1:integer;t1:tmas);

begin

for i:=1 to n1 do

writeln(t1[i].x:2:0,' ',t1[i].y:2:0);

end;

function rast(x1:real;y1:real):real;

var q:real;

begin

q:=sqrt(sqr(x1)+sqr(y1));

rast:=q;

end;

procedure proverka(n1:integer;var m1:integer; var t1:tmas);

var p,j:integer;

ra:array[1..20] of real;

buf:tochki;

begin

for i:=1 to n1 do

ra[i]:=rast(t1[i].x,t1[i].y);

p:=1;

for i:=1 to n1-1 do

if ra[i]>ra[i+1] then p:=0;

if p=0 then m1:=0

else m1:=1;

if p=0 then

for i:=1 to n1-1 do begin

for j:=1 to n1-i do

if rast(t[j].x,t[j].y)>rast(t[j+1].x,t[j+1] .y) then begin

buf.x:=t[j].x;

buf.y:=t[j].y;

t[j].x:=t[j+1].x;

t[j].y:=t[j+1].y;

t[j+1].x:=buf.x;

t[j+1].y:=buf.y;

end;

end;

end;

begin {osn programma}

writeln('Vvedite kol-vo tochek');

readln(n);

vvod(n,t);

proverka(n,m,t);

if m=0 then writeln('Net. Ots. massiv: ');

vivod(n,t);

if m=1 then writeln('DA');

readln;

end.

Треугольники

Занести в другой массив записей прямоугольные треугольники. Даны в записи их стороны

program Project2;

{$APPTYPE CONSOLE}

uses

SysUtils;

type zap=record

AB:integer;

BC:integer;

AC:integer;

end;

tre=array[1..20] of zap;

procedure VVOD (var a:tre;var n:integer);

var i:integer;

begin

writeln('Vvedite kolichestvo treygolnikov');

readln(n);

for i:=1 to n do begin

writeln('Vvedite storonu AB');

readln(a[i].AB);

writeln('Vvedite storonu BC');

readln(a[i].BC);

writeln('Vvedite storonu AC');

readln(a[i].AC);

end;

end;

procedure VIBOR(a:tre;n:integer;var b:tre;var k:integer);

var i:integer;

begin

k:=0;

for i:=1 to n do if

(sqr(a[i].AC)=sqr(a[i].AB)+sqr(a[i].BC))

or (sqr(a[i].AB)=sqr(a[i].AC)+sqr(a[i].BC))

or (sqr(a[i].BC)=sqr(a[i].AB)+sqr(a[i].AC)) then begin

k:=k+1;

b[k]:=a[i];

end;

end;

procedure VIVOD(b:tre;k:integer);

var i:integer;

begin

writeln('AB BC AC');

for i:=1 to k do writeln(b[i].AB,' ',b[i].BC,' ',b[i].AC);

end;

var A,C:tre;

n,k:integer;

begin

VVOD(A,n);

VIBOR(A,n,C,k);

writeln('Priamoygolnie treygolniki');

VIVOD(C,k);

readln;

end.

Задача 1 (найти сумму мин и макс на побочной диаг и поделить всю матрицу на эту сумму)

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

program matrizi;

{$APPTYPE CONSOLE}

uses

SysUtils;

type mas=array[1..15,1..15] of double;

procedure VVOD (var a:mas;var n:integer);

var i,j:integer;

begin

writeln('VVedite kolichestvo strok/stolbzov');

readln(n);

writeln('Vvedite matrizu');

for i:=1 to n do begin

for j:=1 to n do read (a[i,j]);

readln;

end;

end;

procedure POISK (a:mas;n:integer;var sum:double);

var i,j:integer;

min,max:double;

begin

min:=a[1,n];

for i:=1 to n do if a[i,n+1-i]<min then min:=a[i,n+1-i];

max:=a[1,n];

for i:=1 to n do if a[i,n+1-i]>max then max:=a[i,n+1-i];

sum:=min+max;

writeln('Min element pobochnoi diag ',min:0:0);

writeln('Max element pobochnoi diag ',max:0:0);

writeln('Cymma ',sum:0:0);

end;

procedure DELENIE (a:mas;n:integer;sum:double;var c:mas);

var i,j:integer;

begin

for i:=1 to n do begin

for j:=1 to n do c[i,j]:=a[i,j]/sum;

end;

end;

procedure VIVOD (c:mas;n:integer);

var i,j:integer;

begin

for i:=1 to n do begin

for j:=1 to n do write (c[i,j]:1:1,' ');

writeln;

end;

end;

var M,K:mas;

n:integer;

summa:double;

begin

VVOD(M,n);

POISK(M,n,summa);

DELENIE(M,n,summa,K);

VIVOD(K,n);

readln;

end.

Задача 10 (перестановка наибольшего и наименьшего элемента в каждом столбце)

10) квадратная матрица, надо написать процедуру перестановки наибольшего и наименьшего элементов в каждом столбце и процедуру вывода/ввод в основной программе

program matrizi;

{$APPTYPE CONSOLE}

uses

SysUtils;

type mas=array[1..15,1..15] of integer;

procedure VVOD (var a:mas;var n:integer);

var i,j:integer;

begin

writeln('VVedite kolichestvo strok/stolbzov');

readln(n);

writeln('Vvedite matrizu');

for i:=1 to n do begin

for j:=1 to n do read (a[i,j]);

readln;

end;

end;

procedure POISK (var a:mas;n:integer);

var i,j,min,max,imin,imax,buf:integer;

begin

for j:=1 to n do begin

min:=a[1,j];

imin:=1;

for i:=1 to n do if a[i,j]<min then begin

min:=a[i,j];

imin:=i;

end;

max:=a[1,j];

imax:=1;

for i:=1 to n do if a[i,j]>max then begin

max:=a[i,j];

imax:=i;

end;

a[imax,j]:=min;

a[imin,j]:=max;

end;

end;

procedure VIVOD (a:mas;n:integer);

var i,j:integer;

begin

for i:=1 to n do begin

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

writeln;

end;

end;

var A:mas;

n:integer;

begin

VVOD(A,n);

POISK(A,n);

writeln('Poluchennaya matriza');

VIVOD(A,n);

readln;

end.

Задача 11 (умножение каждого столбца на макс элемент этого столбца)

11) матрицу n x m чтоб н<=10 м<=12 вещественных чисел.

Создать проедуру обработки матрицы чтобы она находила в каждом столбце максимальный элемент и умножала этот столбец на максимальный элемент своего столбца. Вывод матрицв сделать в основной программе

program matrizi;

{$APPTYPE CONSOLE}

uses

SysUtils;

type mas=array[1..10,1..12] of double;

procedure VVOD (var a:mas;var n,m:integer);

var i,j:integer;

begin

repeat

writeln('VVedite kolichestvo strok');

readln(n);

until n<=10;

repeat

writeln('VVedite kolichestvo stolbzov');

readln(m);

until n<=12;

writeln('Vvedite matrizu');

for i:=1 to n do begin

for j:=1 to n do read (a[i,j]);

readln;

end;

end;

procedure POISK (var a:mas;n,m:integer);

var i,j:integer;

max:double;

begin

for j:=1 to m do begin

max:=a[1,j];

for i:=1 to n do if a[i,j]>max then max:=a[i,j];

for i:=1 to n do a[i,j]:=a[i,j]*max;

end;

end;

procedure VIVOD (a:mas;n,m:integer);

var i,j:integer;

begin

for i:=1 to n do begin

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

writeln;

end;

end;

var A:mas;

n,m:integer;

begin

VVOD(A,n,m);

POISK(A,n,m);

writeln('Poluchennaya matriza');

VIVOD(A,n,m);

readln;

end.

Задача 12 (поменять макс элемент каждый строки с 1ым элементом (например))

12) в строках матрицы - найти макс и поменять местами с чем-то

(я меняла для разнообразия с первым элементом)

program matrizi;

{$APPTYPE CONSOLE}

uses

SysUtils;

type mas=array[1..15,1..20] of integer;

procedure VVOD (var a:mas;var n,m:integer);

var i,j:integer;

begin

writeln('VVedite kolichestvo strok');

readln(n);

writeln('VVedite kolichestvo stolbzov');

readln(m);

writeln('Vvedite matrizu');

for i:=1 to n do begin

for j:=1 to m do read (a[i,j]);

readln;

end;

end;

procedure POISK (var a:mas;n,m:integer);

var i,j,max,kol,jmax:integer;

begin

for i:=1 to n do begin

max:=a[i,1];

jmax:=1;

for j:=1 to m do if a[i,j]>max then begin

max:=a[i,j];

jmax:=j;

end;

a[i,jmax]:=a[i,1];

a[i,1]:=max;

end;

end;

procedure VIVOD (a:mas;n,m:integer);

var i,j:integer;

begin

for i:=1 to n do begin

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

writeln;

end;

end;

var A:mas;

n,m:integer;

begin

VVOD(A,n,m);

POISK(A,n,m);

writeln('Poluchennaya matriza');

VIVOD(A,n,m);

readln;

end.

Задача 13 (найти мин элемент и поделить на него всю матрицу)

13) В матрице 12х15 найти минимальный элемент в матрице. Поделить всю матрицу на этот элемент , если он = 0 , не изменить матрицу. Использовать процедуру. Вывести исходную матрицу и полученную в основной программе

program matrizi;

{$APPTYPE CONSOLE}

uses

SysUtils;

type mas=array[1..12,1..15] of double;

procedure VVOD (var a:mas;var n,m:integer);

var i,j:integer;

begin

repeat

writeln('VVedite kolichestvo strok');

readln(n);

until n<12;

repeat

writeln('VVedite kolichestvo stolbzov');

readln(m);

until m<15;

writeln('Vvedite matrizu');

for i:=1 to n do begin

for j:=1 to m do read (a[i,j]);

readln;

end;

end;

procedure POISK (a:mas;n,m:integer;var b:mas);

var i,j:integer;

min:double;

begin

min:=a[1,1];

for i:=1 to n do begin

for j:=1 to m do if a[i,j]<min then min:=a[i,j];

end;

for i:=1 to n do begin

for j:=1 to m do begin

b[i,j]:=a[i,j];

b[i,j]:=b[i,j]/min;

end;

end;

end;

procedure VIVOD (a:mas;n,m:integer);

var i,j:integer;

begin

for i:=1 to n do begin

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

writeln;

end;

end;

var A,B:mas;

n,m:integer;

begin

VVOD(A,n,m);

POISK(A,n,m,B);

writeln('Isxodnaya matriza');

VIVOD(A,n,m);

writeln('Poluchennaya matriza');

VIVOD(B,n,m);

readln;

end.

Задача 14 (убрать столбец с минималным элементом на побочной диагонали)

14) Задана квадратная матрица А(n,n) n<=10. вещественных чисел.Написать процедуру новой матрицы путем вычеркивания солбца, где расположен минимальный элемент ПОБОЧНОЙ диагонали исходной матрицы.считать элемент единственный. В основной пограмме распечатать исходную и полученную матрицу.

program matrizi;

{$APPTYPE CONSOLE}

uses

SysUtils;

type mas=array[1..10,1..10] of double;

procedure VVOD (var a:mas;var n,m:integer);

var i,j:integer;

begin

repeat

repeat

writeln('VVedite kolichestvo strok');

readln(n);

until n<=10;

repeat

writeln('VVedite kolichestvo stolbzov');

readln(m);

until m<=10;

until m=n;

writeln('Vvedite matrizu');

for i:=1 to n do begin

for j:=1 to m do read (a[i,j]);

readln;

end;

end;

procedure POISK (a:mas;n:integer;var b:mas;var m:integer);

var i,j,jmin:integer;

min:double;

begin

min:=a[1,m];

jmin:=m;

for i:=1 to n do if a[i,m+1-i]<min then begin

min:=a[i,m+1-i];

jmin:=m+1-i;

end;

for i:=1 to n do

for j:=1 to m do b[i,j]:=a[i,j];

for i:=1 to n do

for j:=jmin to m-1 do begin b[i,j]:=b[i,j+1];

end;

m:=m-1;

end;

procedure VIVOD (a:mas;n,m:integer);

var i,j:integer;

begin

for i:=1 to n do begin

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

writeln;

end;

end;

var A,B:mas;

n,m:integer;

begin

VVOD(A,n,m);

POISK(A,n,B,m);

writeln('Isxodnaia matriza');

VIVOD(A,n,n);

writeln('Poluchennaya matriza');

VIVOD(B,n,m);

readln;

end.

Задача 15 (умножить четные столбцы на сумму мин и макс матрицы)

15) в матрице прямоугольной элементы чётных столбов умножить на сумма минмального и максимального элемента всей матрицы

program Project2;

{$APPTYPE CONSOLE}

uses

SysUtils;

type mas=array[1..20,1..20] of integer;

procedure VVOD (var A:mas; var n,m:integer);

var i,j:integer;

begin

writeln('Vvedite kolichestvo strok');

readln(n);

writeln('Vvedite kolichestvo stolbzov');

readln(m);

writeln('Vvedite matrizu');

for i:=1 to n do begin

for j:=1 to m do read (a[i,j]);

readln;

end;

end;

procedure POISK (var A:mas;n,m:integer);

var i,j,min,max,sum:integer;

begin

min:=a[1,1];

for i:=1 to n do

for j:=1 to m do if a[i,j]<min then min:=a[i,j];

max:=a[1,1];

for i:=1 to n do

for j:=1 to m do if a[i,j]>max then max:=a[i,j];

sum:=max+min;

for i:=1 to n do begin

for j:=1 to m do if (j mod 2) = 0 then a[i,j]:=a[i,j]*sum;

end;

end;

procedure VIVOD (A:mas;n,m:integer);

var i,j:integer;

begin

for i:=1 to n do begin

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

writeln;

end;

end;

var n,m:integer;

A:mas;

begin

VVOD(A,n,m);

POISK(A,n,m);

VIVOD(A,n,m);

readln;

end.

Задача 2 (каждый элемент строки делится на макс элемент этой строки)

2) Матрица. Процедура: в строке находит максимальный элемент и делит каждый элемент на него. Если искомый элемент 0, то оставляет строку без изменений. В основной программе провести процедуру на всех строках.

program matrizi;

{$APPTYPE CONSOLE}

uses

SysUtils;

type mas=array[1..15,1..15] of double;

var M,K:mas;

n,i:integer;

procedure VVOD (var a:mas;var n:integer);

var i,j:integer;

begin

writeln('VVedite kolichestvo strok/stolbzov');

readln(n);

writeln('Vvedite matrizu');

for i:=1 to n do begin

for j:=1 to n do read (a[i,j]);

readln;

end;

end;

procedure POISK_Del (a:mas;n:integer;var c:mas);

var j:integer;

max,del:double;

begin

max:=a[i,1];

for j:=1 to n do if a[i,j]>max then max:=a[i,j];

for j:=1 to n do begin

del:=a[i,j]/max;

C[i,j]:=del;

end;

end;

procedure VIVOD (c:mas;n:integer);

var i,j:integer;

begin

for i:=1 to n do begin

for j:=1 to n do write (c[i,j]:1:1,' ');

writeln;

end;

end;

begin

VVOD(M,n);

for i:=1 to n do

POISK_Del(M,n,K);

writeln('Poluchennaya matriza');

VIVOD(K,n);

readln;

end.

Задача 4 (умножить числа главной диагонали на кол-во четных элементов всей матрицы)

4) Умножить все элементы главной диагонали квадратной матрицы на кол-во четных элементов всей матрицы. Вывести сообщение, если матрица не изменится.

program matrizi;

{$APPTYPE CONSOLE}

uses

SysUtils;

type mas=array[1..15,1..15] of integer;

procedure VVOD (var a:mas;var n:integer);

var i,j:integer;

begin

writeln('VVedite kolichestvo strok/stolbzov');

readln(n);

writeln('Vvedite matrizu');

for i:=1 to n do begin

for j:=1 to n do read (a[i,j]);

readln;

end;

end;

procedure POISK (var a:mas;n:integer);

var i,j,max,kol:integer;

begin

kol:=0;

for i:=1 to n do

for j:=1 to n do

if (a[i,j] mod 2) = 0 then kol:=kol+1;

if kol=1 then writeln ('matriza ne izmenitsia')

else begin

for i:=1 to n do a[i,i]:=a[i,i]*kol;

end;

end;

procedure VIVOD (a:mas;n:integer);

var i,j:integer;

begin

for i:=1 to n do begin

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

writeln;

end;

end;

var M:mas;

n:integer;

begin

VVOD(M,n);

POISK(M,n);

writeln('Poluchennaya matriza');

VIVOD(M,n);

readln;

end.

Задача 5 (найти в каждой строке ср арифметическое и из них массив)

5) матрица m<30 n<20 найти в каждой строке среднее арифм и из этих этих ср.арифм создать массив

program matrizi;

{$APPTYPE CONSOLE}

uses

SysUtils;

type mas=array[1..30,1..20] of integer;

massiv=array[1..30] of double;

procedure VVOD (var a:mas;var n,m:integer);

var i,j:integer;

begin

writeln('VVedite kolichestvo strok');

readln(n);

writeln('VVedite kolichestvo stolbzov');

readln(m);

writeln('Vvedite matrizu');

for i:=1 to n do begin

for j:=1 to m do read (a[i,j]);

readln;

end;

end;

procedure POISK (a:mas;n,m:integer;var b:massiv);

var i,j,sum:integer;

ar:double;

begin

for i:=1 to n do begin

sum:=0;

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

ar:=sum/m;

b[i]:=ar;

end;

end;

procedure VIVOD (b:massiv;n:integer);

var i:integer;

begin

for i:=1 to n do write (b[i]:1:1,' ');

writeln;

end;

var A:mas;

b:massiv;

n,m:integer;

begin

VVOD(A,n,m);

POISK(A,n,m,b);

writeln('Poluchennaya matriza');

VIVOD(b,n);

readln;

end.

Задача 6 (умножить числа главной диагонали на кол-во нечетных элементов)

6) матрица, главная диагональ, умножить все члены диагонали на колво нечетных в матрице, и если не изменится - вывести сообщение (теоретические вопросы в этом билете: оперативная память и условный оператор)

program matrizi;

{$APPTYPE CONSOLE}

uses

SysUtils;

type mas=array[1..15,1..15] of integer;

procedure VVOD (var a:mas;var n:integer);

var i,j:integer;

begin

writeln('VVedite kolichestvo strok/stolbzov');

readln(n);

writeln('Vvedite matrizu');

for i:=1 to n do begin

for j:=1 to n do read (a[i,j]);

readln;

end;

end;

procedure POISK (var a:mas;n:integer);

var i,j,max,kol:integer;

begin

kol:=0;

for i:=1 to n do

for j:=1 to n do

if (a[i,j] mod 2) = 1 then kol:=kol+1;

if kol=1 then writeln ('matriza ne izmenitsia')

else begin

for i:=1 to n do a[i,i]:=a[i,i]*kol;

end;

end;

procedure VIVOD (a:mas;n:integer);

var i,j:integer;

begin

for i:=1 to n do begin

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

writeln;

end;

end;

var M:mas;

n:integer;

begin

VVOD(M,n);

POISK(M,n);

writeln('Poluchennaya matriza');

VIVOD(M,n);

readln;

end.

Задача 7 (все элементы матрицы делятся на минимальный главной диагонали)

7) дана квадратна матрица n<=10. Разработать процедуру, в которой все элементы матрицы делятся на минимальный элемент главной диагонали. В основной программе вывести преобразованную матрицу или сообщение , что преобразовать нельзя

program matrizi;

{$APPTYPE CONSOLE}

uses

SysUtils;

type mas=array[1..10,1..10] of double;

procedure VVOD (var a:mas;var n:integer);

var i,j:integer;

begin

repeat

writeln('VVedite kolichestvo strok/stolbzov');

readln(n);

until n<=10;

writeln('Vvedite matrizu');

for i:=1 to n do begin

for j:=1 to n do read (a[i,j]);

readln;

end;

end;

procedure POISK (var a:mas;n:integer);

var i,j:integer;

min:double;

begin

min:=a[1,1];

for i:=1 to n do if a[i,i]<min then min:=a[i,i];

if min=0 then writeln ('Preobrazovat nelzia')

else begin

for i:=1 to n do begin

for j:=1 to n do a[i,j]:=a[i,j]/min

end;

end;

end;

procedure VIVOD (a:mas;n:integer);

var i,j:integer;

begin

for i:=1 to n do begin

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

writeln;

end;

end;

var M:mas;

n:integer;

begin

VVOD(M,n);

POISK(M,n);

writeln('Poluchennaya matriza');

VIVOD(M,n);

readln;

end.

Задача 8 (создать новую матрицу без столбца с мин элементом)

8) найти минимальный эл в матрице запомнить этот слобец и записать все элементы в новую матрицу без этого столбца

program matrizi;

{$APPTYPE CONSOLE}

uses

SysUtils;

type mas=array[1..15,1..10] of integer;

procedure VVOD (var a:mas;var n,m:integer);

var i,j:integer;

begin

writeln('VVedite kolichestvo strok');

readln(n);

writeln('VVedite kolichestvo stolbzov');

readln(m);

writeln('Vvedite matrizu');

for i:=1 to n do begin

for j:=1 to m do read (a[i,j]);

readln;

end;

end;

procedure POISK (a:mas;n:integer;var m:integer;var b:mas);

var i,j,min,jmin:integer;

begin

min:=a[1,1];

jmin:=1;

for i:=1 to n do begin

for j:=1 to m do if a[i,j]<min then begin

min:=a[i,j];

jmin:=j;

end;

end;

writeln('Min el ',min,' stoit v stolbze ',jmin);

for i:=1 to n do

for j:=1 to m do b[i,j]:=a[i,j];

for i:=1 to n do begin

for j:=jmin to m-1 do begin

b[i,j]:=b[i,j+1];

end;

end;

m:=m-1;

end;

procedure VIVOD (b:mas;n,m:integer);

var i,j:integer;

begin

for i:=1 to n do begin

for j:=1 to m do write (b[i,j],' ');

writeln;

end;

end;

var A,B:mas;

n,m:integer;

begin

VVOD(A,n,m);

POISK(A,n,m,B);

writeln('Poluchennaya matriza');

VIVOD(B,n,m);

readln;

end.

Задача 9 (удалить столбец, содержащий мин элемент побочной диагонали)

9) дана квадратная матрица. Найти минимальный элемент побочной диагонали и удалить столбец его содержащий.

program matrizi;

{$APPTYPE CONSOLE}

uses

SysUtils;

type mas=array[1..15,1..15] of integer;

procedure VVOD (var a:mas;var n,m:integer);

var i,j:integer;

begin

repeat

writeln('VVedite kolichestvo strok');

readln(n);

writeln('Vvedite kolichestvo stolbzov');

readln(m);

until n=m;

writeln('Vvedite matrizu');

for i:=1 to n do begin

for j:=1 to n do read (a[i,j]);

readln;

end;

end;

procedure POISK (var a:mas;n:integer;var m:integer);

var i,j,min,jmin:integer;

begin

min:=a[1,n];

jmin:=n;

for i:=1 to n do begin

if a[i,n+1-i]<min then begin

min:=a[i,n+1-i];

jmin:=n+1-i;

end;

end;

writeln('min el ',min,' v ',jmin);

for i:=1 to n do begin

for j:=jmin to m-1 do begin

a[i,j]:=a[i,j+1];

end;

end;

m:=m-1;

end;

procedure VIVOD (a:mas;n,m:integer);

var i,j:integer;

begin

for i:=1 to n do begin

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

writeln;

end;

end;

var A:mas;

n,m:integer;

begin

VVOD(A,n,m);

POISK(A,n,m);

writeln('Poluchennaya matriza');

VIVOD(A,n,m);

readln;

end.

задача 3 (найти макс элемент на главной диагонале, удаляет строку с макс)

3) На главной диагонали находит максимум и удаляет строку содержащую этот максимум.

program matrizi;

{$APPTYPE CONSOLE}

uses

SysUtils;

type mas=array[1..15,1..15] of integer;

procedure VVOD (var a:mas;var n,m:integer);

var i,j:integer;

begin

repeat

writeln('VVedite kolichestvo strok');

readln(n);

writeln('Vvedite kolichestvo stolbzov');

readln(m);

until m=n;

writeln('Vvedite matrizu');

for i:=1 to n do begin

for j:=1 to m do read (a[i,j]);

readln;

end;

end;

procedure Del (var a:mas;n:integer;m:integer;var s:integer);

var i,j,imax,max:integer;

begin

max:=a[1,1];

imax:=1;

for i:=1 to n do

for j:=i to i do

if a[i,j]>max then begin

max:=a[i,j];

imax:=i;

end;

for j:=1 to m do

for i:=imax to n do begin

a[i,j]:=a[i+1,j];

s:=n-1;

end;

end;

procedure VIVOD (a:mas;s,m:integer);

var i,j:integer;

begin

for i:=1 to s do begin

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

writeln;

end;

end;

var A:mas;

m,n,s:integer;

begin

VVOD(A,n,m);

DEL(A,n,m,s);

writeln('Poluchennaya matriza');

VIVOD(A,s,m);

readln;

end.

Внимание

Задачи на строки надо решать по примеру задачи 1! (осн программа)

Задача 1 (найти в каждой строке кол-во самых длинных слов)

1) найти кол-во максимальных элементов в массиве строк (как понимаю, надо написать процедуру/функцию, которая находит максимальное кол-во элементов в строке, а в основной программе уже найти кол-во максимальных элементов в тексте)

program Project1;

{$APPTYPE CONSOLE}

uses

SysUtils;

type mas=array[1..20] of string;

procedure SLOVO (var s:string;var b:mas;var kol:integer);

var slovo,max:string;

i,n,p:integer;

begin

{удаление пробелов - необязательно думаю}

p:=pos(' ',s);

while p>0 do

begin

delete(s,p,1);

p:=pos(' ',s);

end;

{сама программа}

s:=s+' ';

slovo:='';

n:=0;

for i:=1 to length(s) do if s[i]<>' ' then slovo:=slovo+s[i]

else begin

n:=n+1;

b[n]:=slovo;

slovo:=''

end;

max:=b[1];

for i:=1 to n do

if length(b[i])>length(max) then max:=b[i];

kol:=0;

for i:=1 to n do

if length(b[i])=length(max) then

kol:=kol+1;

end;

var s:string;

b,b1:mas;

n,i:integer;kol:array[1..20] of integer;

begin

writeln('Vvedite kolichestvo strok');

readln(n);

for i:=1 to n do begin

writeln('Vvedite stroku');

readln(b1[i]);

end;

for i:=1 to n do SLOVO(b1[i],b,kol[i]);

writeln('Izmenennie stroki');

for i:=1 to n do

writeln('Kolichestvo max dlin slov ',kol[i],' v stroke ',i);

readln;

end.

Задача 4 (посчитать количество четных слов в каждой строке)

4) процедура в строке удаляет лишнии пробелы и подсчитыает слова с четным количеством букв

program Project2;

{$APPTYPE CONSOLE}

uses

SysUtils;

procedure Izmen (var s:string;var chet:integer);

var i,p,kol:integer;

slovo:string;

begin

writeln('Vvedite stroku');

readln(s);

{удаление пробелов}

p:=pos(' ',s);

while p>0 do begin

delete(s,p,1);

p:=pos(' ',s);

end;

if s[1]=' ' then delete(s,1,1);

if s[length(s)]=' ' then delete (s,length(s),1);

s:=s+' ';

slovo:='';

chet:=0;

for i:=1 to length(s) do

if s[i]<>' ' then slovo:=slovo+s[i]

else begin if length(slovo) mod 2=0 then begin

chet:=chet+1;

slovo:='';

end

else slovo:='';

end;

writeln('kol-vo chet slov ',chet);

end;

var n,k,j:integer;

s:string;

begin

writeln('Vvedite kolichestvo strok');

readln(n);

for j:=1 to n do begin

Izmen(s,k);

end;

readln;

end.

Задача 5 (поменять местами первое и последнее слово)

5) разработать процедуру которая в строке меняет первое и последнее слово

program Project1;

{$APPTYPE CONSOLE}

uses

SysUtils;

type mas=array[1..20] of string;

procedure ZAMENA (var s:string;n:integer;var b:mas;var k:integer);

var i,p,j:integer;

slovo,buf:string;

begin

writeln('vvedite stroku');

readln(s);

{удаление пробелов}

p:=pos(' ',s);

while p>0 do begin

delete(s,p,1);

p:=pos(' ',s);

end;

if s[1]=' ' then delete(s,1,1);

if s[length(s)]=' ' then delete (s,length(s),1);

s:=s+' ';

slovo:='';

k:=0;

for i:=1 to length(s) do if s[i]<>' ' then slovo:=slovo+s[i]

else begin

k:=k+1;

b[k]:=slovo;

slovo:='';

end;

for i:=1 to k do begin

buf:=b[1];

b[1]:=b[k];

b[k]:=buf;

end;

end;

var n,i,kol,j:integer;

st:string;

B:mas;

begin

writeln('Vvedite kolichestvo strok');

readln(n);

for i:=1 to n do begin

ZAMENA(st,n,B,kol);

for j:=1 to kol do write (B[j],' ');

writeln;

end;

readln;

end.

Задача 6 (количество букв в строке)

6) используя процедуру, посчитать сколько букв в строке произвольной длины

program Project1;

{$APPTYPE CONSOLE}

uses

SysUtils;

procedure CHISLO (var s:string;n:integer;var k:integer);

var i,p,j:integer;

slovo,buf:string;

begin

writeln('vvedite stroku');

readln(s);

{удаление пробелов}

p:=pos(' ',s);

while p>0 do begin

delete(s,p,1);

p:=pos(' ',s);

end;

if s[1]=' ' then delete(s,1,1);

if s[length(s)]=' ' then delete (s,length(s),1);

s:=s+' ';

slovo:='';

k:=0;

for i:=1 to length(s) do if s[i]<>' ' then k:=k+1;

end;

var n,i,kol,j:integer;

st:string;

begin

writeln('Vvedite kolichestvo strok');

readln(n);

for i:=1 to n do begin

CHISLO(st,n,kol);

writeln('Kolicestvo bukv v ',i,' stroke ravno ',kol);

end;

readln;

end.

___________

6) используя процедуру, посчитать сколько букв в строке произвольной длины (если учитывать, что заданы разные символы)

program Project2;

{$APPTYPE CONSOLE}

uses

SysUtils;

type mn=set of char;

function Kol(var s:string;n:integer):integer;

var i,p,k:integer;

M:mn;

begin

writeln('Vvedite stroku');

readln(s);

{поиск букв}

M:=['A'..'Z'];

k:=0;

for i:=1 to length(s) do if upcase(s[i]) in M then k:=k+1;

Kol:=k;

end;

var n,i,kolich:integer;

st:string;

begin

writeln('Vvedite kol-vo strok');

readln(n);

for i:=1 to n do begin

kolich:=kol(st,n);

writeln('Kolichestvo bukv v stroke ravno ',kolich);

end;

readln;

end.

Задача 7 (функция-найти количество наименьших слов)

7) Составить функцию, которая в строке произвольной длины находит число слов с минимальной длиной.

program Project1;

{$APPTYPE CONSOLE}

uses

SysUtils;

type mas=array[1..20] of string;

function CHISLO (var s:string;var b:mas;var kol:integer):integer;

var slovo,min:string;

i,n,p:integer;

begin

writeln('Vvedite stroku');

readln(s);

{удаление пробелов}

p:=pos(' ',s);

while p>0 do

begin

delete(s,p,1);

p:=pos(' ',s);

end;

if s[1]=' ' then delete(s,1,1);

if s[length(s)]=' ' then delete (s,length(s),1);

{сама программа}

s:=s+' ';

slovo:='';

n:=0;

for i:=1 to length(s) do if s[i]<>' ' then slovo:=slovo+s[i]

else begin

n:=n+1;

b[n]:=slovo;

slovo:=''

end;

min:=b[1];

for i:=1 to n do

if length(b[i])<length(min) then min:=b[i];

kol:=0;

for i:=1 to n do

if length(b[i])=length(min) then

kol:=kol+1;

CHISLO:=kol;

end;

var s:string;

b:mas;

n,i,kol:integer;

begin

writeln('Vvedite kolichestvo strok');

readln(n);

for i:=1 to n do begin

CHISLO(s,b,kol);

writeln('Kolichestvo min dlin slov ',kol,' v stroke ',i);

end;

readln;

end.

Задача 8 (функция - количество различных букв в строке)

8) Написать функцию, которая определяет, сколько различных (именно различных:) букв есть в строке. Разработать эту функцию для N строк.

program Project1;

{$APPTYPE CONSOLE}

uses

SysUtils;

type mn=set of char;

function CHISLO (var s:string;n:integer):integer;

var i,kol:integer;

M:mn;

begin

writeln('Vvedite stroku');

readln(s);

M:=['A'..'Z'];

kol:=0;

for i:=1 to length(s) do if upcase(s[i]) in M then begin

kol:=kol+1;

M:=M-[upcase(s[i])];

end;

CHISLO:=kol;

end;

var n,i,kol:integer;

st:string;

begin

writeln('Vvedite kolichestvo strok');

readln(n);

for i:=1 to n do begin

kol:=CHISLO(st,n);

writeln('kol-vo razlichnix bukz v stroke ',kol);

end;

readln;

end.

Задача 9 (функция - количество мин слов)

9) разработать функцию для подсчета в строке минимального слова. (не поняла что это значит, то ли указать длину мин слова, то ли указать количество таких слов, но если писать длину слова, то тогда не учитывается условие, "их может быть несколько", поэтому думаю надо искать их количество) Учитывать , что их может быть несколько. Функцию применить для многих строк , количесво которых вводится с клавиатуры.

program Project2;

{$APPTYPE CONSOLE}

uses

SysUtils;

type mas=array[1..20] of string;

function Min_sl (var s:string;n:integer):integer;

var i,kol:integer;

slovo,min:string;

b:mas;

begin

writeln('Vvedite stroku');

readln(s);

s:=s+' ';

slovo:='';

n:=0;

for i:=1 to length(s) do if s[i]<>' ' then slovo:=slovo+s[i]

else begin

n:=n+1;

b[n]:=slovo;

slovo:=''

end;

min:=b[1];

for i:=1 to n do

if length(b[i])<length(min) then min:=b[i];

kol:=0;

for i:=1 to n do

if length(b[i])=length(min) then

kol:=kol+1;

Min_sl:=kol;

end;

var n,k,i:integer;

st:string;

begin

writeln('Vvedite kol-vo strok');

readln(n);

for i:=1 to n do begin

k:=Min_sl(st,n);

writeln('Kolichestvo min slov ravno ',k);

end;

readln;

end.

Задача фотка (изменить строку по правилу)

Задача с фотки (изменить строку по правилу: пробел должен быть после . , ; а не перед ними)

program Project1;

{$APPTYPE CONSOLE}

uses

SysUtils;

procedure OSHIBKI(var s:string);

var p,k,i:integer;

begin

p:=pos(' ',s);

while p>0 do begin

delete(s,p,1);

p:=pos(' ',s);

end;

if s[1]=' ' then delete(s,1,1);

if s[length(s)]=' ' then delete(s,length(s),1);

k:=pos(' ,',s);

while k>0 do begin

delete(s,k,1);

k:=pos(' ,',s);

end;

k:=pos(' ;',s);

while k>0 do begin

delete(s,k,1);

k:=pos(' ;',s);

end;

k:=pos(' .',s);

while k>0 do begin

delete(s,k,1);

k:=pos(' .',s);

end;

for i:=length(s) downto 1 do if s[i]=',' then insert(' ',s,i+1);

for i:=length(s) downto 1 do if s[i]='.' then insert(' ',s,i+1);

for i:=length(s) downto 1 do if s[i]=';' then insert(' ',s,i+1);

p:=pos(' ',s);

while p>0 do begin

delete(s,p,1);

p:=pos(' ',s);

end;

end;

var n,i:integer;

st:array[1..10] of string;

begin

writeln('Vvedite kolichestvo strok');

readln(n);

for i:=1 to n do begin

writeln('Vvedite stroku');

readln(st[i]);

end;

for i:=1 to n do OSHIBKI(st[i]);

writeln('Izmenennie stroki');

for i:=1 to n do writeln(st[i]);

readln;

end.

кол-во слов заданной длины

program Pr1;

{$APPTYPE CONSOLE}

uses

SysUtils;

function kol_sl(x:string; n:integer):integer;

var i,k,kol:integer;

slovo:array[1..30]of string;

begin

kol:=1;k:=0;

for i:=1 to length(x) do

{slovo[kol]:='';}

if x[i]<>' ' then

slovo[kol]:=slovo[kol]+x[i]

else kol:=kol+1;

for i:=1 to kol do

if length (slovo[i])=n then

k:=k+1;

kol_sl:=k;

end;

var a:array[1..30]of string;

s,n,i,k:integer;

begin

{основная программа}

writeln('vvedite kol. strok');

readln(n);

writeln('vvedite stroki');

for i:=1 to n do

readln(a[i]);

writeln('vvedite zadannuy dlinu slov');

readln(k);

s:=0;

for i:=1 to n do

s:=s+kol_sl(a[i],k);

if s=0 then writeln('takix slov net')

else writeln('kol. slov zadannoy dliny =',s );

readln;

end.

Комментарии

Сопутствующие материалы
Дата публикации 16 августа 2013 в 23:56
Рейтинг -
0
0
0
0
0
Автор zzyxel (4,53 из 5)
Цена Бесплатно
Скачивания 1279
Просмотры 4371
Размер 22,44 Kb
Безопасность Файл был вручную проверен администрацией в том числе и на вирусы
Поделитесь ссылкой:
Свежие статьи
Популярно сейчас