Помощь - Поиск - Пользователи - Календарь
Полная версия: Несколько задач на масивы
Форум «Всё о Паскале» > Pascal, Object Pascal > Задачи
Неясыть
2.12.2004 2:25
Люди помогите! Умираю! Осталось две пары а мне 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
2.12.2004 4:10
Массивы
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.

ЭЭЭЭ.... чёто дальше задачи скучные ....аж лень писать ! angry.gif
GoodWind
2.12.2004 10:02
Цитата
Я больше ничего просить не буду!

почему ? blink.gif
а вот заголовочек оформлен не по правилам... ай-ай-ай...
подправил заголовок. GoodWind
Гость_Неясыть
2.12.2004 23:02
Цитата
ЭЭЭЭ.... чёто дальше задачи скучные ....аж лень писать !

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

ну я ж сказал ...............в заголовках просить ничего не буду :D
Неясыть
2.12.2004 23:05
Еще и
Цитата
Unregistered
обозвали!!!!!!!!!!!!
blink.gif
volvo
2.12.2004 23:18
Матрицы:

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
2.12.2004 23:23
Матрицы:
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
2.12.2004 23:25
ShadowWatcher
Может быть ты все задачи по второму разу перерешаешь? Повторяться - то зачем?

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

bGood := bGood And (b[j,i] < b[j-1,i]);
Jahnerus
2.12.2004 23:34
Неясыть
Цитата
Самые легкие значить мы решать умеем.... А остальные....

:P Ни одна из этих задачь помойму не составит труда ... а скучные значит как разтаки лёгкие angry.gif
sad.gif а пиво мне после определённых событий запретили пить ... да и ты мне его как через инет поставишь чтоли ...
Jahnerus
2.12.2004 23:39
volvo
Надо решить чтоли кто чё решает ... а то потом так и получается что у каждой задачи по два варианта реализации ... ;)
Я могу взятся за последнюю тему если кто уже 3 начал
ShadowWatcher
2.12.2004 23:41
volvo, не перерешиваю конечно smile.gif Мало того я не даю гарантии, что мои решения хотя бы скомпилятся - пишу без компилятора. Просто получается так, что ты высылаешь решение в то время, когда я его набираю smile.gif
volvo
2.12.2004 23:45
Jahnerus
Я в эту тему пока не пишу - договаривайся с ShadowWatcher
;)
ShadowWatcher
2.12.2004 23:45
Строки
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.


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

З. Ы.: опередил-таки smile.gif
volvo
2.12.2004 23:54
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
2.12.2004 23:54
ShadowWatcher
Цитата
Должно работать...
З. Ы.: опередил-таки

Мы не на гонках ... ;)
а баги есть и видно даже без компилятора ... sad.gif
Ща исправлю ....
Jahnerus
2.12.2004 23:57
volvo
Точно ... не пойму причём тут согласные в реализации ShadowWatcher!
ShadowWatcher
Лучше бы читал задание внимательнее чем торопиться! :D
Да и ещё в первой задаче со строками
Цитата
While (i < Length(s)) Do

а если последний символ повторяется ?
поэтому
Код
While (i <= Length(s)) Do
Jahnerus
3.12.2004 0:35
Функции и процедуры
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
3.12.2004 0:55
Функции и процедуры
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:
ShadowWatcher
3.12.2004 14:15
volvo, как правило в этих задачах точка ставится только в конце строки. А то что мы не на гонках, это я знаю - а почему выходят такие накладки, я говорил.
Неясыть
4.12.2004 3:10
я чуствую на пиво вам до пенсии работать буду!
шутка! :D Не проблема если кто в Питере живет!
Благодарю всех за помощь....
Обязательно зайду еще за помощью!
ждите... blink.gif
Неясыть
8.12.2004 3:27
я видел там людям и блок-схемы рисуют?! :p2: эсли я еще не запарил ! :p2:
мне бы тоже неплохо :molitva: пжлстаааааааааааа!
Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.