Задачи на строки и массивы+1 на последовательность Опции

[mafia1232]

У меня есть несколько задач и их надо решить на завтра. Пожалуйста хелп. ОЧЕНЬ НАДО. Вот условия первой:
дан одномерный массив An подсчитать количество четных элементов и их сумму
получилось вот что, но есть ошибки

Исходный код

program p21;
uses crt;
type
vector=array [1..100] of integer;
var
A:vector;
s,i,n,K:integer;
procedure Init(n:integer; var A:vector;ch:char);
var
i:integer;
begin
writeln('vvod elementov massiva ',ch);
for i:=1 to n do
begin
write('vvedite [',i,'] elementov massiva ',ch);
readln(A[i]);
end;
end;
procedure Print(n:integer;A:vector; ch:char);
var
i:integer;
begin
writeln('vivod elementov massiva ',ch);
for i:=1 to n do
write(A[i]:3, ' ');
writeln;
end;
function Rez(n:integer;A:vector):integer;
Var
i,m:integer;
begin
m:=0;
for i:=1 to n do
if (A[i] mod 2=0) then m:=m+1;
Rez:=m;
end;
begin
clrscr;
writeln('vvedite rrazmernost');
readln(n);
Init(n,A,'A');
Print(n,A,'A');
K:=Rez(n,A);
if K=0 then
writeln('chetnix elementov net')
else
writeln('chislo chetnix elementov', K);
readln(K);
s:=s+K;
writeln('symma = ',s);
readln;
end.

Если такие темы существуют, то прошу прощения

Сообщение отредактировано: volvo - 9.09.2005 9:55

[mafia1232]

Вот условия второй:
сформировать массив Bm элементами которго являются нечетные элементы массива A имеющие четные индексы(не понял последний пункт условий).
исходник на формирования массива из нулевых элементов массива A

Исходный код

program p23;
uses crt;
type
vector=array[1..100] of integer;
var
A,B:vector;
n,k:integer;
procedure vvod(var A:vector; n:integer; ch:char);
var
i:integer;
begin
writeln('vvod elmentov massiva ',ch);
for i:=1 to n do
begin
writeln('vvedite [',i,'] elementov massiva ',ch,' ');
readln(A[i]);
end;
end;
procedure print(A:vector;n:integer; ch:char);
var
i:integer;
begin
writeln('vivod elementov massiva ',ch);
for i:=1 to n do
write(A[i]:3,' ');
writeln;
end;
procedure rez(A:vector;n:integer; Var B:vector;var k:integer);
var
i:integer;
begin
k:=0;
for i:=1 to n do
if A[i]=0 then
begin
k:=k+1;
B[k]:=i;
end;
end;
begin
clrscr;
writeln('vvedite ramernost massiva ');
readln(n);
vvod(A,n,'A');
rez(A,n,B,k);
if k=0 then
writeln('iskomiu massive ne svormirovan')
else
begin
print(A,n,'A');
print(B,k,'B');
end;
readln;
end.

переделайте плиз

[Guest]

2. Замени Rez на вот такой:

procedure rez(A:vector;n:integer; Var B:vector;var k:integer);
var i:integer;
begin
  k:=0;
  for i:=1 to n do
    if (not odd(i)) and odd(A[i]) then begin
      k:=k+1; B[k]:=A[i];
    end;
end;

[volvo]

Ну а в первом задании менять придется как Rez так и основной блок программы:

function Rez(n:integer;A:vector; Var Sum: integer):integer;
Var i,m:integer;
begin
  m:=0; sum := 0;
  for i:=1 to n do
    if not odd(A[i]) then begin
      inc(m); inc(sum, A[i]);
    end;
  Rez:=m;
end;

begin
  clrscr;
  writeln('vvedite rrazmernost');
  readln(n);
  Init(n,A,'A');
  Print(n,A,'A');
  K:=Rez(n,A, s);
  if K=0 then writeln('chetnix elementov net')
  else begin
    writeln('chislo chetnix elementov', K);
    writeln('symma =  ',s);
  end;
readln;
end.

[mafia1232]

условие задачи номер 3:
Даны 3 прямоугольные матрицы различной размерности.Получить вектор, каждый компонент которого яв-ся числом элементов больше заданного "a"
соответствующий столбцу матрицы

вариант число элементов строки матрицы, также больше "а", введенного с клавы.

Исходный код

Program p25;
uses crt;
type matr=array[1..10,1..10] of integer;
type vector=array[1..10] of integer;
var
n,m:integer;{razmernost' matrizi}
z: integer;{chislo sravneniu}
A,B,C:matr;{isxodnie matrizi}
VA,VB,VC:vector;{rezyl'tat}
{vvod elementov matrizi}
procedure mv(name:char;n,m:integer; var A:matr);
Var
i,j:integer;
begin
for i:=1 to n do
begin
for j:=1 to m do
begin
write(' ',name,'[',i:1,',',j:1,']= ');
readln(A[i,j]);
end;
end;
end;
{prozedyra pechati elementov matrizi}
procedure mp(A:matr;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]:4);
writeln;
end;
end;
{prozedyra pechati elementov vectora-rezyl'tata}
procedure mprez(VA:vector;m:integer);
var
i:integer;
begin
for i:=1 to m do
write(VA[i]:4);
writeln;
end;
{prozedyra formirovaniya rezyl'tata}
procedure mr(A:matr;z,n,m:integer;var VA:vector);
var
i,j,k:integer;
begin
for j:=1 to m do
begin
k:=0;
for i:=1 to n do
if A[i,j]>z then k:=k+1;
VA[j]:=k;
end;
end;
begin
clrscr;
writeln('Vvedite chislo dlya sravneniya');
Readln(z);
Writeln('Vvedite razmernost pervou matrizi n i m ');
readln(n,m);
mv('A',n,m,A);
writeln('matriza 1');
mp(A,n,m);
mr(A,z,n,m,VA);
writeln;
writeln('rezyltat');
mprez(VA,m);
readln;
clrscr;
writeln('vvedite ramernost 2 matrizi n i m');
readln(n,m);
mv('B',n,m,B ) ;
writeln('matriza 2');
mp(B,n,m);
mr(B,z,n,m,VB);
writeln;
writeln('rezyltat');
mprez(VB,m);
readln;
clrscr;
writeln('vvedite ramernost 3 matrizi n i m');
readln(n,m);
mv('C',n,m,C);
writeln('matriza 3');
mp(C,n,m);
mr(C,z,n,m,VC);
writeln;
writeln('rezyltat');
mprez(VC,m);
readln;
end.

Сообщение отредактировано: volvo - 9.09.2005 9:56

[volvo]

Даны 3 прямоугольной матрицы различной размерности. Получить вектор, каждый компонент которого яв-ся числом элементов больше заданного "a" соответствующий столбцу матрицы

Переведи... Это чего значит?

Погоди, но тут и считается по СТОЛБЦАМ, но никак не по строкам:

procedure mr(A:matr;z,n,m:integer;var VA:vector);
...
begin
  for j:=1 to m do begin
    k:=0;
    for i:=1 to n do
      if A[i,j]>z then k:=k+1;
    VA[j]:=k;
  end;
 end;

[mafia1232]

прямоугольная матрица значит что у матрицы кол-во столбцов не равно
кол-ву строк. размерность разная значит ты вводищь скоко будет строк и столбцов для каждой матрицы. вот файл если надо

Сообщение отредактировано: mafia1232 - 2.06.2005 0:34

[volvo]

прямоугольная матрица значит что у матрицы кол-во столбцов не равно кол-ву строк. размерность разная значит ты вводищь скоко будет строк и столбцов для каждой матрицы. вот файл если надо

Спасибо огромное за столь ценную информацию - я весь интернет облазил, ничего не нашел про прямоугольные матрицы...

Чего, издеваешься?

Тебе вообще ничего менять не надо... Пост выше читай. Программа которую ты привел именно и работает, как тебе нужно.

[mafia1232]

j это столбец а i строка . так что считает прога по строкам
ps: про матрицы я тебе письмо написал. (sorry for флуд)

Сообщение отредактировано: mafia1232 - 2.06.2005 0:59

[mafia1232]

еще задачка: из каждой очередной четвертки символов строки удалить вторую пару символов.

пример на то что второю букву в первом слове удаляет из всех остальных слов

program p13;
uses crt;
var
s,s1:string;
i,l:integer;
ch:char;
begin
clrscr;
writeln('vvedite stroky');
readln(s);
ch:=s[2];
l:=length(s);
s1:=' ';
for i:=1 to l do
if s[i]=ch then s1 :=s1
else
s1:=s1+s[i];
writeln('stroka=  ',s1);
readln;
end.

[volvo]

j это столбец а i строка. так что считает прога по строкам

Я дико извиняюсь, но ИМЕННО потому, что J это столбец, а I это - строка, цикл

Код

for j := ...
 for i := ...
   if A[i, j] ...

пройдет по элементам
j = 1: A[1, 1] - A[2, 1] - A[3, 1] ... { 1-ый СТОЛБЕЦ }
j = 2: A[1, 2] - A[2, 2] - A[3, 2] ... { 2-ой СТОЛБЕЦ }
...

По столбцам, следовательно. Что и требовалось доказать...

P.S. Флуд прекращай

[mafia1232]

задача еще одна: ввести фамилию, имя , отчество как одну строку, состоящую из слов.
Определить длину строки и кол-во букв "а" в ней. Вывести самое короткое слово.

!Ты бы лучше программы сразу себе писал, чем примеры...!

:low: Мог бы проги писать сразу , я бы тогда не спрашивал бы
а про прогу на прямоугольные матрицы A[j,i] должно быть вроде что б по столбцам.

а вот таким способами я решаю задачки :p12: :p1: :ypr:

Сообщение отредактировано: mafia1232 - 2.06.2005 1:36

[volvo]

а про прогу на прямоугольные матрицы A[j,i] должно быть вроде что б по столбцам.

У тебя же индекс I изменяется первым - что ты никак понять не можешь, я же тебе привел пример изменения индексов матрицы, внимательно посмотри...

:p12: Вот так почаще делай !!!

[hiv]

а вот таким способами я решаю задачки :p12: :p1: :ypr:

У меня другой способ:
:p1: :ypr: :p12: :p1: :ypr: :p12: :p1: :D

[Guest]

про матрицы понял.
делаю, но не помогает. А оставшиеся 2 сделайте от Сегодня, 01:11 AM и Сегодня, 01:08 AM , а то очень надо.
и спасибо за другие

[hiv]

еще задачка: из каждой очередной четвертки символов строки удалить вторую пару символов.

Вот решение из 4-х строк:

program p13;
var
  s :string;
  i :integer;
begin
  writeln('vvedite stroky');
  readln(s);
  for i:=(length(s) div 4) downto 1 do delete(s,(i-1)*4+3,2);
  writeln('stroka=',s);
end.

[hiv]

задача еще одна: ввести фамилию, имя , отчество как одну строку, состоящую из слов. Определить длину строки и кол-во букв "а" в ней. Вывести самое короткое слово.

Длину строки ты уже умеешь определять. А количество считают таким способом:

count:=0;
for i:=1 to length(s) do
  if s[i]='a' then inc(count);

Где count - и есть счетчик, который увеличивается на еденицу в цикле когда i-тый символ есть буква a.
Ну а последнее - думаю сам сможешь сделать. Если нет, то выкладывай код - поможем!

Сообщение отредактировано: hiv - 2.06.2005 9:21

[mafia1232]

а вопрос что делает команда "downto" а то я не въехал. объясните
а прога работает если строка без пробелов.

в var не надо count прописать а то у меня ругается

Сообщение отредактировано: mafia1232 - 2.06.2005 9:44

[hiv]

Если TO увеличивает на 1, то DOWNTO уменьшает на 1. УЧИ МАТЧАСТЬ!
А насчет пробелов в задании ничего не было сказано...

[klem4]

удаление последней пары из каждой четверки, можно так :

uses crt;
var s:string;
    i,bword:integer;

Begin
   clrscr;
   write('s=');
   readln(s);
   i:=1;
   while(i<=length(s)) do
    begin
       inc(i,2);
       delete(s,i,2);
    end;
    writeln('s=',s);
    readln;
end.

12pp34pp56pp78pp ->>> 12345678

вариан hiv'a компактнее, но мне кажется этот проще для понимания ;)

Сообщение отредактировано: klem4 - 2.06.2005 9:45