Форум «Всё о Паскале» > Задачи на строки и массивы+1 на последовательность

Помощь - Поиск - Пользователи - Календарь

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

Форум «Всё о Паскале» > Pascal, Object Pascal > Задачи

mafia1232

2.06.2005 3:30

У меня есть несколько задач и их надо решить на завтра. Пожалуйста хелп. ОЧЕНЬ НАДО. Вот условия первой:
дан одномерный массив 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.

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

mafia1232

2.06.2005 3:34

Вот условия второй:
сформировать массив 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.06.2005 3:54

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

2.06.2005 4:00

Ну а в первом задании менять придется как 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

2.06.2005 4:16

условие задачи номер 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

2.06.2005 4:30

Цитата(mafia1232 @ 2.06.05 0:16)

Даны 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

2.06.2005 4:33

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

volvo

2.06.2005 4:40

Цитата(mafia1232 @ 2.06.05 0:33)

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

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

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

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

mafia1232

2.06.2005 4:58

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

mafia1232

2.06.2005 5:08

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

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

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

2.06.2005 5:10

Цитата(mafia1232 @ 2.06.05 0:58)

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

2.06.2005 5:11

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

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

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

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

volvo

2.06.2005 12:18

Цитата(mafia1232 @ 2.06.05 1:11)

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

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

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

hiv

2.06.2005 12:21

Цитата(mafia1232 @ 2.06.05 2:11)

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

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

Guest

2.06.2005 12:46

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

hiv

2.06.2005 13:12

Цитата(mafia1232 @ 2.06.05 2:08)

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

Вот решение из 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

2.06.2005 13:20

Цитата(mafia1232 @ 2.06.05 2:11)

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

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

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

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

mafia1232

2.06.2005 13:22

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

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

hiv

2.06.2005 13:25

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

klem4

2.06.2005 13:33

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

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 компактнее, но мне кажется этот проще для понимания ;)

mafia1232

2.06.2005 13:48

в var не надо count прописать? а то у меня ругается
как writeln написать? чтобы кол-во букв "а" выводил ?

mafia1232

2.06.2005 14:08

а код пока такой получился


program p14;
uses crt;
var
s:string;
l,i,count:integer;
begin
clrscr;
writeln('vvedite stroky');
readln(s);
l:=length(s);
{podschet kol-vo bykv a}
count:=0;
for i:=1 to l do
  if s[i]='a' then inc(count);
   writeln('bykv a=',count);
   readln;
        end.

hiv

2.06.2005 14:10

Паскаль это не басик! В нем все переменные должны прописываться и инициализироваться. Это в басике взял переменную и использовал (тип сам подберется и нулем проинициализируется или пустой строкой). Еще раз - УЧИ МАТЧАСТЬ!
ЗЫ: Код правильный - так держать!

Только в предпредпоследней строке наверно ты хотел выдать значение счетчика - тогда

writeln('Букв А=',count);

mafia1232

2.06.2005 14:25

а как тогда посчитать самое короткое слово, чего -то искал, но не нашел.
допустим Иванов Алексей Петрович как сделать чтоб именно слово "иванов"
он посчитал самым коротким?

mafia1232

2.06.2005 14:51

Вывести самое короткое слово.

Цитата

Если нет, то выкладывай код - поможем!

ну помогите код выше постом

hiv

2.06.2005 14:52

берешь снова счетчик и считаешь количество букв (не пробелов) пока не встретишь пробел, т.е. слово закончилось. Потом сравниваешь значение счетчика с переменной min, в которой будет храниться минимальное значение счетчика. А его инициализируешь значением длины всей строки. И если счетчик меньше, то его значение присваиваешь переменной min.
А еще гдянь сюда: FAQ: разбиение строки на слова

mafia1232

2.06.2005 14:59

а ты просто написать не можешь? щас уезжать надо на зачет и времени думать нету. напиши плиз. :molitva: :molitva:
:molitva: hiv :molitva:
:molitva: :molitva:

hiv

2.06.2005 16:49

Здесь вообще-то помогают тем кто хочет учиться. А ты досиделся пока сдавать пора не пришла. На:

Исходный код

program p14;
uses crt;
var
  s,ss,sm:string;
  l,i,count,min:integer;
begin
  clrscr;
  writeln('vvedite stroky');
  readln(s);
  l:=length(s);
  writeln('Dlina stroki=',l);
  {podschet kol-vo bykv a}
  count:=0;
  for i:=1 to l do
    if s[i]='a' then inc(count);
  writeln('bykv a=',count);

  min:=l;
  sm:='';
  ss:='';
  i:=1;
  while i<=l do
  begin
    if s[i]=' ' then
    begin
      ss:='';
      while (i<=l)and(s[i]=' ') do inc(i);
    end
    else
    begin
      while (i<=l)and(s[i]<>' ') do
      begin
        ss:=ss+s[i];
        inc(i);
      end;
      if length(ss)<min then
      begin
        min:=length(ss);
        sm:=ss;
      end;
    end;
  end;
  writeln('Korotkoe slovo=',sm);
  writeln('Dlina korotkogo slova=',length(sm));

  readln;
end.

ЗЫ: Сам разбирайся. No comments!

mafia1232

2.06.2005 23:27

спасибо огромное, но я до конца не досидел. дали еще 2 недели на все эти задачи и еще 3 прибавили, их я пока сам помучаю.

mafia1232

23.06.2005 15:09

исправте(если неправильно) и добавте по условию
создать массив и найти в нем max элемент и поменять у элемента знак на противоположный.
и выводит массив с измененным элементом.
от что получилось, но не работает, хотя списал из справочника (задача была с похожими условиями на поиск максимального значения)

Код

program p3;
uses crt;
type
vector=array [1..100] of integer;
var
A:vector;
i,n,k:integer;
max:real;
begin
clrscr;
writeln('vvedite razmernost');
readln(n);
for i:=1 to n do
begin
write('vvedite [',i,'] elementov massiva');
readln(A[i]);
end;
writeln('massive A');
for i:=1 to n do
write (A[i]:3,'');
writeln;
for i:=1 to n do
read(A[i]);
max:=A[1];
for i:=2 to n do
if A[i]>max then max:=A[i];
writeln('maximalniu element massiva: ',max:6:2);
end.

hiv

23.06.2005 15:20

Вот так будет работать, если от куда-то списываешь, то правильно списывай!

program p3;
uses crt;
type
vector=array [1..100] of integer;
var
A:vector;
i,n:integer;
max:integer;
begin
clrscr;
writeln('vvedite razmernost');
readln(n);
for i:=1 to n do
begin
write('vvedite [',i,'] elementov massiva');
readln(A[i]);
end;
writeln('massiv A');
for i:=1 to n do
write(A[i]:3,' ');
writeln;
max:=A[1];
for i:=2 to n do
if A[i]>max then max:=A[i];
writeln('maximalniu element massiva:  ',max);
end.

mafia1232

23.06.2005 15:27

и вот на последовательность
последовательность задается формулой (((-1)^n)*(2^n))/n
вывести сумму членов ряда и первые члены
задача без процедур. лекая, но я забыл как решать

аж стыдно

насчет массива: все работает после добавления readln (

) , но как помять знак на противополжный (было 10--->-10) и вставить обратно это число в массив и вывести новый массив на экран?

klem4

23.06.2005 15:29

эээ... ну наверное всетаки надо искать номер максимального элемента , а не его значение


nmax:=1;
for i:=2 to n do
 if x[i]>x[nmax] then
   nmax:=i;
x[nmax]:=-x[nmax];

mafia1232

23.06.2005 15:33

ну и куда вставить твои строчечки?(объясни) и как сделать то , что я накалякал в Сегодня, 12:27 PM

volvo

23.06.2005 15:41

mafia1232,
ты думать САМ когда-нибудь начнешь? Смысл какой ЗА ТЕБЯ делать задачи? Потом ты получишь диплом, и что? Так что начинай думать. Уж

Цитата

куда вставить твои строчечки?

можно самому догадаться...

klem4

23.06.2005 15:47

на, не мучайся уже ...

uses crt;

type

    Vector = array[1..100] of integer;

var
          a : Vector;

   i,n,nmax : integer;

Begin

   clrscr;

   write('n='); readln(n);

   for i:=1 to n do begin
       write('a[',i,']=');
       readln(a[i]);
   end;

   nmax:=1;

   for i:=2 to n do
    if a[i]>a[nmax] then
     nmax:=i;

   a[nmax]:=-a[nmax];

   writeln;

   for i:=1 to n do
    writeln('a[',i,']=',a[i]);

   readln;

end.

mafia1232

23.06.2005 15:55

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

mafia1232

23.06.2005 16:11

последовательность задается формулой (((-1)^n) * (2^n))/n
вывести сумму членов ряда и первые члены

про последовательность. вот мой код

Код

program p2;
uses crt;
var
a,i,n:integer;
s,s1:real;
begin
clrscr;
writeln('vvedite n');
readln(n);
for i:=1 to n do
begin
a:=((exp(i)*ln(-1))*(exp(i)*ln(2))/i)
s:=s+1;
end;
writeln('summa = ',s:8:3);
readln;
end.

вопросы:
1)как вывести первые члены последовательности
2) про s он пишет, что тип не подходит! на что заменить?
3)как ln(-1) по другому задать, а то чисто математически работать не будет.

klem4

23.06.2005 16:30

Естественно это не будет работать ... во первых там у тебя полная ерунда написана ... ну например Ln(-1) это чему равно по твоему ?

mafia1232

23.06.2005 16:30

про ln я знаю и это один из вопросов
ввести переменную d=ln(1), а d потом возвести в степень -1?

klem4

23.06.2005 16:41

Цитата(mafia1232 @ 23.06.05 13:30)

про ln я знаю и это один из вопросов
ввести переменную d=ln(1), а d потом возвести в степень -1?

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

по идее для этих задачь можно искользовать только +,-,*,/

никаких логорифмов.

mafia1232

23.06.2005 16:52

вот фотография задания на последовательность.
подскажи как возводить в степень не через exp и ln
я такого метода не знаю (: , покажи свой.

hiv

23.06.2005 17:07

Все за тебя делай!
Хоть сам объяснить сможешь, что я сделал?

program p2;
uses crt;
var
i,n:integer;
a,s,s1:real;
begin
clrscr;
writeln('vvedite n');
readln(n);
s:=0;
for i:=1 to n do
begin
if odd(i) then a:=-exp(i*ln(2))/i
else a:=exp(i*ln(2))/i;
s:=s+a;
end;
writeln('summa =  ',s:8:3);
readln;
end.

mafia1232

23.06.2005 17:17

1)HIV конечно спасибо, но все я не просил делать. я тока спросил про методы как сделать или что на что заменить. те 3 вопроса.
2) это задание не целиком и половины задания нету. так что все ты не сделал.

VBproffi

23.06.2005 20:00

Может меня глючит но ln(логорифм натуральный, по основанию e (всё верно?)) числа 1 равен 0.
Вот исходник подтверждающий это.

Код

program asd;
USes
CRT;
var
d :Real;
begin
ClrScr;
d:= ln(1);
Write(d:3:3);
ReadKEy;
end.

hiv

23.06.2005 20:15

VBproffi, тебя не глючит - все верно... Просто mafia1232 ошибся в расстановке скобок. У него было при возведении x в сепень y:

Код

exp(x)*ln(y)

а надо так делать

Код

exp(x*ln(y))

Но логарифм нельзя брать от чисел <= 0. Поэтому нужно определиться при четных или нечетных значениях n приписывать слагаемому отрицательный знак.

Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.