Форум для начинающих программистов /Delphi7 /Turbo Pascal /Общения /Безопасность

Информация о пользователе

Привет, Гость! Войдите или зарегистрируйтесь.

Решение задач на "Turbo Pascal 7.0";

Страница: 1

Сообщений 1 страница 5 из 5

1

  • Автор: AdMiN
  • Серый Сеошник

№ 99
Задана квадратная матрица. Переставить строку с максимальным  элементом на главной диагонали со строкой с заданным номером m.

Код:
program borlpasc;


var a:array[1..n,1..m] of integer;

i,j,n,k,m,max,at:integer;

begin 

begin writeln('Введите размерность матрицы:');

readln(n);

write('Введите номер строки m=');

readln(m);

for i:=1 to n do

for j:=1 to n do

begin write('a[',i,j,']=');

readln(a[i,j])

end;

writeln('Ваша матрица:');----- это писать не обязательно пояснение 

for i:=1 to n do

begin for j:=1 to n do

write(a[i,j]:4);

writeln

end;

max:=1;

for i:=1 to n do

if a[max,max]<a[i,i]

then max:=i;

for i:=1 to n do

begin at:=a[m,i];

a[m,i]:=a[max,i];

a[max,i]:=at

end;

writeln('Полученная матрица:'); ----- это писать не обязательно пояснение 

for i:=1 to n do

begin for j:=1 to n do

write(a[i,j]:4);

writeln

end;

readln;

end.

2

  • Автор: AdMiN
  • Серый Сеошник

Решение задач на двумерный массив

Сформировать квадратную матрицу порядка n по заданному образцу:

1 2 3… n-2 n-1 n
2 3 4… n-1 n 0
3 4 5… n 0 0

n-1 n 0… 0 0 0
n 0 0 … 0 0 0

Код:
program freeware
var a: array [1..100,1..100] of integer;
    i,j,n: integer;
begin
write('n=');
readln(n);
for i:=1 to n do
    begin
    for j:=1 to n do
        begin
        if i=1 then a[i,j]:=j
          else if i+j<=n+1 then a[i,j]:=a[i-1,j]+1
               else a[i,j]:=0;
        write(a[i,j]:3);
        end;
    writeln;
    end;
end.

--------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------

n n-1 n-2. 3 2 1
n-1 n-2 n-3. 2 1 0
n-2 n-3 n-4. 1 0 0

Код:
program freeware;
const nmax=20;
var a:array[1..nmax,1..nmax] of byte;
    n,i,j:byte;
begin
clrscr;
repeat
write('Размер матрицы до ',nmax,' n=');
readln(n);
until n in [1..nmax];
writeln('Матрица:');
for i:=1 to n do
 begin
  for j:=1 to n do
   begin
    if j<=n-i+1 then a[i,j]:=n-j-i+2
    else a[i,j]:=0;
    write(a[i,j]:3);
   end;
  writeln;
 end;
readln
end.

-------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------

n 0 0 … 0 0 0
0 n-1 0 … 0 0 0
0 0 n-2 … 0 0 0
………………………
0 0 0 … 0 2 0
0 0 0 … 0 0 1

Код:
program freeware
var a: array [1..100,1..100] of integer;
    i,j,n: integer;
begin
write('n=');
readln(n);
for i:=1 to n do
 begin
  for j:=1 to n do
   begin
    if j=i then a[i,j]:=n-i+1
    else a[i,j]:=0;
    write(a[i,j]:4);
   end;
  writeln;
 end;
end.

-------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------

1 0 0 0 0 1
1 1 0 0 0 1
1 1 1 1 1 1

n-1 n 0 0 0 0
n    0 0 0 0 0

Код:
Program freeware;
const nmax=20;
var a:array[1..nmax,1..nmax] of integer;
    n,i,j,k:byte;
begin
clrscr;
repeat
write('Размер матрицы четное число  от 2 до ',nmax,' n=');
readln(n);
until (n in [2..nmax])and(n mod 2=0);
writeln('Матрица:');
k:=n div 2;
for i:=1 to n do
 begin
  for j:=1 to n do
   begin
    if(i<=k) and((j<=i)or(j>=n-i+1))then a[i,j]:=1
    else if(i>k)and(j<=n-i+1)then a[i,j]:=i+j-1
    else a[i,j]:=0;
    write(a[i,j]:4);
   end;
  writeln;
 end;
readln;
end.

3

  • Автор: AdMiN
  • Серый Сеошник

Задачи на  String
Дана строка вычеслить что больше английских букв или цифры
Дана страка вычеслить что болше русских букв или цифры

Код:
program freeware ;
var s:string[100]; k,j,i:integer;
begin
k:=0; j:=0 ;
writeln('s-?');
readln(s);

for i:=1 to length(s)  do begin
if (s[i]='a') or (s[i]='b') or (s[i]='c') or (s[i]='d')  then {надо все буквы перечислят до [color=red]Z[/color]  P.S  если русские буквы следовательно перечисляем русские буквы от а до я }
k:=k+1;
if (s[i]='1') or (s[i]='2') or (s[i]='3') or (s[i]='4') then j:=j+1; { перечислят все цифры   [color=red]0..9 [/color]}
end;
if k=j then write('byk=sifr') else if k>j then write('byk>sifr')
 else write('byk<sifr');
readln;
end.

by AdMiN ®
Копирайтингам при копировании указывать ссылку обязательно !

Отредактировано AdMiN (May 11 2012 23:26:29)

4

  • Автор: AdMiN
  • Серый Сеошник

Задача номер 27  №27
Проверить одинаковое ли число открывающих и закрывающих скобок в данной строке.

Код:
program freeware ;
var s:string[30]; k,j,i:integer;
begin
k:=0; j:=0 ;
writeln('s-?');
readln(s);

for i:=1 to length(s)  do begin
if s[i]='('  then
k:=k+1;
if s[i]=')' then j:=j+1;
end;
if k=j then write('sov') else if k>j then write('(-bol') else write(')-bol');

end.

by AdMiN ®
Копирайтингам при копировании указывать ссылку обязательно

5

  • Автор: AdMiN
  • Серый Сеошник

Задача номер 18
В строке заменить все двоеточия

Код:
(:)

точкой запятой

Код:
(;)

. Подсчитать количество замен.

Код:
program freeware;
var s:string[30]; k,i:integer ;
begin
k:=0;
writeln('s-?');
readln(s);
for i:=1 to length(s) do
if s[i]=':' then  begin k:=k+1; delete(s,i,1); insert(';',s,i)
 end;
writeln(s,' ' ,k);
readln;
end.

Или

Код:
program freeware ;
var s:string[30]; k,i:integer ;
begin
k:=0;
writeln('s-?');
readln(s);
for i:=1 to length(s) do
if s[i]=':' then  begin s[i]:=';' ; k:=k+1;
 end;
writeln(s,' ' ,k);
readln;
end.

by AdMiN ®
Копирайтингам при копировании указывать ссылку обязательно

Страница: 1