Технический форум - Помогите решить задачи

Технический форум (http://www.tehnari.ru/)

- Delphi, Kylix and Pascal (http://www.tehnari.ru/f43/)

- - Помогите решить задачи (http://www.tehnari.ru/f43/t86874/)

Помогите решить задачи

1. Составьте программу подсчёта всех натуральных чисел, меньших М, квадрат суммы цифр которых равен Х.
2. В заданном предложении найти самое короткое и самое длинное слова
3. Удалите строку, в которой находится элемент, кратный 3
4. Составьте программу меняющую местами элементы матрицы симметрично побочной диагонали
5. Вставить два элемента: первый – после всех элементов, больших данного числа Р, а второй – перед всеми элементами, большими данного числа Р (Р вводить с клавиатуры).

:telepat:Язык программирования?

Цитата:

Сообщение от nice5531 (Сообщение 887213)

2. В заданном предложении найти самое короткое и самое длинное слова

Код:

uses crt;

const rz=[' ','.',',','?','!'];

var s,s1,s2,s3:string;

    sk,sd:string;

    k,d,i,ik,id,j,p:byte;

begin

clrscr;

writeln('Введите строку из слов, отделенных разделителями:');

readln(s);

i:=1;

d:=0;id:=1;{длина длинного слова и его начало в строке}

k:=255;ik:=1;{длина корткого слова и его начало в строке}

while i<=length(s) do

if not(s[i] in rz) then

begin

  s1:='';{будем составлять слово}

  j:=i;

  p:=0;

  while not(s[j] in rz)and(j<=length(s)) do

   begin

    s1:=s1+s[j];

    j:=j+1;

    p:=p+1;

   end;

  if length(s1)<k then{если меньше короткого}

   begin

    sk:=s1;{это короткое}

    k:=length(s1);{его длина}

    ik:=i;{начало в строке}

   end;

  if length(s1)>d then{то же с длинным}

   begin

    sd:=s1;

    d:=length(s1);

    id:=i;

   end;

  i:=i+p;

end

else i:=i+1;

writeln('Самое короткое слово ',sk);

writeln('Самое длинное слово ',sd);

if ik<id then{если короткое раньше}

begin

  insert(sk,s,id);{вставляем короткое перед длинным}

  delete(s,id+k,d);{удаляем длинное}

  insert(sd,s,ik);{вставляем длинное на старое место короткого}

  delete(s,ik+d,k);{удаляем короткое}

end

else{если длинное раньше, то все наоборот}

   begin

    insert(sd,s,ik);

    delete(s,ik+d,k);

    insert(sk,s,id);

    delete(s,id+k,d);

   end;

write(s);

readln

end.

Цитата:

Сообщение от nice5531 (Сообщение 887213)

4. Составьте программу меняющую местами элементы матрицы симметрично побочной диагонали

Код:

program matrix;

uses crt;

var n: BYTE;

    A: array[0..10, 0..10] of Integer;

    i, j: BYTE;

    num: Integer;

 

begin

    clrscr;

    writeln('Vvedite n');

    read(n);

    writeln('vvedite matricy');

    for i:= 0 to n-1 do begin

      for j:= 0 to n-1 do begin

        gotoxy((j+1)*5, 5+i);

        read(A[i, j]);

      end;

    end;

    for i:= 0 to n-1 do

      for j:= 0 to n-1 do

        if (j < n-i) then begin

            num:= A[i, j];

            A[i, j]:= A[n-j-1, n-i-1];

            A[n-j-1, n-i-1]:= num;

        end;

    for i:= 0 to n-1 do begin

      for j:= 0 to n-1 do begin

        gotoxy((j+1)*5, 7+i+n);

        write(A[i, j]);

      end;

    end;

    readkey;

end.

Цитата:

Сообщение от nice5531 (Сообщение 887213)

5. Вставить два элемента: первый – после всех элементов, больших данного числа Р, а второй – перед всеми элементами, большими данного числа Р (Р вводить с клавиатуры).

Код:

uses crt;

const nmax=50;

type myarray=array[1..nmax] of integer;

var n:byte;

procedure init2 (var n:byte; var m:myarray);

var i:integer;

begin

n:=25;

for i:=1 to n do

m[i]:=Random(111)-35;

end;

procedure print1 (n:integer; var m:myarray);

var i:integer;

begin

for i:=1 to n do

write(m[i]:4);

writeln;

end;

procedure vstavka(var n:byte; var m:myarray; a,k1,k2:integer);

var i,j:byte;

begin

i:=1;

while i<=n do

if m[i]>a then

begin

n:=n+1;

for j:=n downto i+2 do

m[j]:=m[j-1];

m[i+1]:=k1;

n:=n+1;

for j:=n downto i+1 do

m[j]:=m[j-1];

m[i]:=k2;

i:=i+3;

end

else i:=i+1;

end;

var a:myarray; P,k1,k2,k:integer;

begin

Randomize;

init2(n,a);

print1(n,a);

write('Vvedite chislo dlya sravnenia P=');

readln(P);

write('Vvedite chislo dlya vstavki posle bolshih ',P,' k1=');

readln(k1);

write('Vvedite chislo dlya vstavki pered kratnumi P k2=');

readln(k2);

vstavka(n,a,P,k1,k2);

writeln('Vstavka chisel po ysloviu:');

print1(n,a);

end.

Цитата:

Сообщение от nice5531 (Сообщение 887213)

3. Удалите строку, в которой находится элемент, кратный 3

Код:

const nmax=20;

Type myarray=array [1..nmax]of integer;

Procedure init2(var n1:integer;var x:myarray);

var i:integer;

begin

repeat

write('Размер массива до ',nmax,' n=');

readln(n1);

until n1 in [1..nmax];

for i:=1 to n1 do

x[i]:=random(10);

end;

Procedure print1(n1:integer;x:myarray);

var i:integer;

begin

for i:=1 to n1 do

write(x[i]:3);

writeln;

end;

Procedure Delete(var n1:Integer;Var m:myarray);

Var i,j:Integer;

Begin

i:=1;

while i<=n1 do

if m[i] mod 3=0 then

 begin

  if i=n1 then n1:=n1-1

  else

   begin

    for j:=i to n1-1 do

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

    n1:=n1-1;

   end;

 end

else i:=i+1;

end;

var a:myarray;

    n:integer;

Begin

Randomize;

Init2(n,A);

writeln('Исходный массив');

Print1(n,A);

Delete(n,a);

writeln('Удаление кратных 3');

print1(n,a);

end.