Несколько задач на масивы, помогите пожалста Опции

[Неясыть]

Люди помогите! Умираю! Осталось две пары а мне 4 лабы здать надо. Очень срочно. Я больше ничего просить не буду! Честное слово. Я вас когдо-нибудь обманывал. А ты говоришь!!!!
Ну дак вот --- вот они:
массивы

1. сформировать новый массив из элементов массива М(15), встречающ. в этом массиве один раз
2. Определить представляют ли собой элементы массива А(20) возрастающую последовательность

матрицы

1. дана вещественная матрица М(9*8) преобразовать матрицу: поэлементно вычесть последнюю строку из всех строк, кроме последней
2. дана целочисленная матрица В(7*7). Найти номера столбцов, элементы каждого из кот. образуют возрастающую последовательность(b(1j)‹b(2j)..‹b(7j))

процедуры и ф-ции

1. в массивах А(5*7) и В(7*5) найти максимумы, поменять их местами
2. вычислить Z=(S1+S2)/(S1-S2), где S1-сумма положительных элементов массива А(70), S2-сумма отрицательных элементов массива В(60)... суммы вычислять в одной подрограмме

строки

1. дана строка символов. удалить из нее все кратные рядом стоящие одинаковые символы,оставив по одному(АААВВСС--›АВС)
2. дана строка символов до точки. Подсчитать в ней число латинских букв.

Я в вса верю люди......помогите .......с меня магар...........
Спасибо! можно на е-майл <censored>

[Jahnerus]

Массивы
1

Код

program 1;
uses
 crt;
const
 n=15;
var
 a,m:array[1..n] of integer;
 i,j,k:byte;
 b:boolean;

begin
 clrscr;
 randomize;
 {Формируем массив М}
 for i:=1 to n do begin
   m[i]:=random(10)-5;
   write(m[i],'  ');
 end;
 k:=1;
 a[1]:=m[1];
 {Проверка на вхождение}
 for i:=1 to n do begin
   b:=false;
   j:=1;
   while j<=k do begin
     b:=(m[i]=a[j]);
     if b then break;
     j:=j+1;
   end;
   if not(b) then begin
     k:=k+1;
     a[k]:=m[i];
   end;
 end;
 writeln;
 for i:=1 to k do write(a[i],' ');
 readln;
end.

2

Код

program 2;
uses
 crt;
const
 n=20;
var
 a:array[1..n] of integer;
 i:byte;
 b:boolean;

begin
 clrscr;
 randomize;
 for i:=1 to n do begin
   a[i]:=random(100)-50;
   write(a[i],'  ');
 end;
 for i:=1 to n-1 do begin
   b:=a[i]<a[i+1];
   if not(b) then break;
 end;
 writeln;
 if b then writeln('Da')
 else writeln('Net');
 readln;
end.

ЭЭЭЭ.... чёто дальше задачи скучные ....аж лень писать !

Сообщение отредактировано: Jahnerus - 2.12.2004 0:33

[GoodWind]

Я больше ничего просить не буду!

почему ?
а вот заголовочек оформлен не по правилам... ай-ай-ай...
подправил заголовок. GoodWind

Сообщение отредактировано: GoodWind - 2.12.2004 6:07

[Гость_Неясыть]

ЭЭЭЭ.... чёто дальше задачи скучные ....аж лень писать !

Что значить скучные!:blink: Самые легкие значить мы решать умеем....
А остальные.... Ладно уж вам помогите с остальными то! ................а я ничего и не прошу ...........умоляю:molitva: !!!!!!!!!!! у меня зачет скоро а ети лабы зсдать надо за 2 пары еще и защитить!!!!!!!!! с меня пиво если что!!!!!!!!!!!!!!!

а вот заголовочек оформлен не по правилам... ай-ай-ай...

ну я ж сказал ...............в заголовках просить ничего не буду :D

[Неясыть]

Еще и

Unregistered

обозвали!!!!!!!!!!!!

[volvo]

Матрицы:

1.

Код

const
 nrow = 8;
 ncol = 9;

var
 m: array[1 .. nrow, 1 .. ncol] of real;
 i, j: integer;
begin
 for i := 1 to nrow do
   for j := 1 to ncol do
     m[i, j] := random(100) * 1.21;

 writeln('перед вычитанием');
 for i := 1 to nrow do
   begin
     for j := 1 to ncol do
       write( m[i, j]:8:2 );
     writeln
   end;

 for i := 1 to nrow - 1 do
   for j := 1 to ncol do
     m[i, j] := m[i, j] - m[nrow, j];

 writeln('после вычитания');
 for i := 1 to nrow do
   begin
     for j := 1 to ncol do
       write( m[i, j]:8:2 );
     writeln
   end;

end.

[ShadowWatcher]

Матрицы:
1

Код

Var
 m:Array[0..8,0..7] Of Double;

Procedure Print;
Var
 i,j:Integer;
Begin
 For i:=0 To 7 Do
 Begin
   For j:=0 To 8 Do
     Write(m[j,i]:4:2);
   WriteLn
 End
End;

Var
 i,j:Integer;

Begin
 For i:=0 To 8 Do
   For j:=0 To 7 Do
     m[i,j] := Random(100);
 Print;
 WriteLn('------------------------------------');
 For i:=0 To 6 Do
   For j:=0 To 8 Do
     m[j,i] := m[j,i] - m[j,7];
 Print
End.

2

Код

Var
 b:Array[0..6,0..6] Of Integer;
 i,j:Integer;
 bGood:Boolean;
Begin
 For i:=0 To 6 Do
   For j:=0 To 6 Do
     b[i,j] := Random(100);
 For i:=0 To 6 Do
 Begin
   bGood := True;
   For j:=1 To 6 Do
     bGood := bGood And b[j,i] < b[j-1,i];
   If bGood Then
     WriteLn('Column #',i,' is good')
 End
End.

Вроде так...

[volvo]

ShadowWatcher
Может быть ты все задачи по второму разу перерешаешь? Повторяться - то зачем?

Кроме того, внимательнее с условиями:

Код

bGood := bGood And (b[j,i] < b[j-1,i]);

Сообщение отредактировано: volvo - 2.12.2004 19:36

[Jahnerus]

Неясыть

Самые легкие значить мы решать умеем.... А остальные....

:P Ни одна из этих задачь помойму не составит труда ... а скучные значит как разтаки лёгкие
а пиво мне после определённых событий запретили пить ... да и ты мне его как через инет поставишь чтоли ...

Сообщение отредактировано: Jahnerus - 2.12.2004 19:36

[Jahnerus]

volvo
Надо решить чтоли кто чё решает ... а то потом так и получается что у каждой задачи по два варианта реализации ... ;)
Я могу взятся за последнюю тему если кто уже 3 начал

Сообщение отредактировано: Jahnerus - 2.12.2004 19:40

[ShadowWatcher]

volvo, не перерешиваю конечно Мало того я не даю гарантии, что мои решения хотя бы скомпилятся - пишу без компилятора. Просто получается так, что ты высылаешь решение в то время, когда я его набираю

[volvo]

Jahnerus
Я в эту тему пока не пишу - договаривайся с ShadowWatcher
;)

[ShadowWatcher]

Строки
1

Код

Var
 i:Integer;
 s:String;
Begin
 ReadLn(s);
 i:=2;
 While (i < Length(s)) Do
   If s[i] = s[i-1] Then
     Delete(s,i,1)
   Else
     Inc(i);
 WriteLn(s)
End.

2

Код

Const
 BadChars = ['b','c','d','f','g','h']; {Сам допишешь...}
Var
 s:String;
 i,n:Integer;
Begin
 ReadLn(s);
 n:=0;
 For i:=1 To Length(s) Do
   Inc(n,Byte(s[i] In BadChars));
 WriteLn(n)
End.

Должно работать...

З. Ы.: опередил-таки

Сообщение отредактировано: ShadowWatcher - 2.12.2004 19:50

[volvo]

ShadowWatcher
Он же во второй задаче, по-моему, просил ВСЕ латинские буквы ДО ТОЧКИ ? Или я ошибаюсь?

Код

Var
s:String;
i,n:Integer;
Begin
ReadLn(s);
n:=0;
i:=1;
while (i<= Length(s)) and (s[i] <> '.') Do
  Begin
    Inc(n,Byte(Upcase(s[i]) In ['A'..'Z'])); Inc(i)
  End;
WriteLn(n)

[Jahnerus]

ShadowWatcher

Должно работать...
З. Ы.: опередил-таки

Мы не на гонках ... ;)
а баги есть и видно даже без компилятора ...
Ща исправлю ....

[Jahnerus]

volvo
Точно ... не пойму причём тут согласные в реализации ShadowWatcher!
ShadowWatcher
Лучше бы читал задание внимательнее чем торопиться! :D
Да и ещё в первой задаче со строками

While (i < Length(s)) Do

а если последний символ повторяется ?
поэтому

Код

While (i <= Length(s)) Do

Сообщение отредактировано: Jahnerus - 2.12.2004 20:02

[Jahnerus]

Функции и процедуры
1

Код

uses
 crt;
type ma3x=array[1..7,1..7] of integer;
var a,b:ma3x;
 i1,i2,j1,j2:byte;
 r:integer;

procedure out_ma3x(mas:ma3x; m,n:byte);
var i,j:byte;
begin
 for i:=1 to m do begin
   for j:=1 to n do write(mas[i,j]:4);
   writeln;
 end;
end;

procedure in_ma3x(var mas:ma3x; m,n:byte);
var i,j:byte;
begin
 randomize;
 for i:=1 to m do begin
   for j:=1 to n do begin
     mas[i,j]:=random(100)-50;
     write(mas[i,j]:4);
   end;
   writeln;
 end;
end;

procedure srch_max(mas:ma3x; m,n:byte; var i_max:byte; var j_max:byte);
var
 max,i,j:integer;
begin
 max:=mas[1,1];
 i_max:=1;
 j_max:=1;
 for i:=1 to m do begin
   for j:=1 to n do begin
     if mas[i,j]>max then begin
       i_max:=i;
       j_max:=j;
       max:=mas[i,j];
     end;
   end;
 end;
end;

begin
 clrscr;
 writeln('Massiv 1 do preobrazovaniya');
 in_ma3x(a,5,7);
 writeln('Massiv 2 do preobrazovaniya');
 in_ma3x(b,7,5);
 srch_max(a,5,7,i1,j1);
 srch_max(b,7,5,i2,j2);
 r:=a[i1,j1];
 a[i1,j1]:=b[i2,j2];
 b[i2,j2]:=r;
 writeln('Massiv 1 posle preobrazovaniya');
 out_ma3x(a,5,7);
 writeln('Massiv 2 posle preobrazovaniya');
 out_ma3x(b,7,5);
 readln;
end.

[Jahnerus]

Функции и процедуры
2

Код

uses
 crt;
type ma3x=array[1..70] of integer;
var a,b:ma3x;
 i,s1,s2:integer;
 z:real;

function sum(mas:ma3x; m:byte; k:integer):integer;
var
 s,j:integer;
begin
 s:=0;
 for j:=1 to m do begin
   if (mas[j]*k>0) then s:=s+mas[j];
 end;
 sum:=s;
end;

begin
 clrscr;
 randomize;
 writeln('Massiv A(70)');
 for i:=1 to 70 do begin
   a[i]:=random(10)-5;
   write(a[i],' ');
 end;
 writeln;
 writeln('Massive B(60)');
 for i:=1 to 60 do begin
   b[i]:=random(10)-5;
   write(b[i],' ');
 end;
 writeln;
 s1:=sum(a,70,1);
 s2:=sum(b,60,-1);
 z:=(s1+s2)/(s1-s2);
 writeln('z=',z:5:3);
 readln;
end.

Кажется это последняя ... :thanks:

Сообщение отредактировано: Jahnerus - 2.12.2004 20:57

[ShadowWatcher]

volvo, как правило в этих задачах точка ставится только в конце строки. А то что мы не на гонках, это я знаю - а почему выходят такие накладки, я говорил.

[Неясыть]

я чуствую на пиво вам до пенсии работать буду!
шутка! :D Не проблема если кто в Питере живет!
Благодарю всех за помощь....
Обязательно зайду еще за помощью!
ждите...