Задача на Прогрессии, вывод геометрич прогрессии через арифмет Опции

[MapЫшKa]

Приветик, всем спецам Паскаля, к сожалению к которым не принадлежу (оч жаль, надеюсь за год подтянусь немного к вам). Вот вам задачка на раздумья:

Дана арифметическая прогрессия с заданном a1 - первым членом , с заданным d - разностью, и n - числом членов прогрессии, так же дана геометрическая прогрессия с заданным b1 - первым членом явл. равным a1, и q - знаменатеолем прогрессии (все задается юзером), теперь надо вычислить все это n-число членов арифметической прогрессии и проверить нет ли там случайно заданной геометрической прогрессии , причем члены геометрической прогрессии необязательно должны быть идти по порядку в арфметической, и их должно быть не менее 3 членов. Постараться использовать без применения массива

Вот такое запутанное условие. Сама уже запуталась в своих решениях, командах и кодах. :p2: Но вот пример чтобы ясней было:

дан первый член a1 = 1
разность ариф прогр d = 1
число членов ариф прогресии n = 28
первый член геометрич прогрессии b1 = a1
знаменатель геомт прогрессии q = 3

итак выводим прогрессию арифм получается:
1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28

проверка на геометрическую прогрессию должна нам вывести вот такие члены арифметич прогрессии:

1, 3, 9, 27

а вот если членов будет не 28 а 8 то прогрессии геометрической не будет...

Ждем вашей помощи.. хотя бы подсказки.. О БОГИ ПАСКАЛЯ!

[MapЫшKa]

кстати пример сама составила так что если что то будет не получаться проверьте может я в примере ошибку сделала... О боги паскаля, жду вашего ответа!

[GoodWind]

О БОГИ ПАСКАЛЯ!

MapЫшKa, вы явно преувеличиваете ... :p2:
не понял задания, но как-то знакомо все....
если врублюсь - напишу

[suriv]

О БОГИ ПАСКАЛЯ

Нихрена себе.

Сообщение отредактировано: suriv - 31.10.2004 23:49

[GoodWind]

я так понял:
проверить, содержит ли арифметическая прогрессия члены геометрической ?

[volvo]

MapЫшKa
Замените константы на операторы ввода при необходимости ...

Код

const
 a = 1;
 d = 2;
 n = 15;
 b = 1;
 q = 3;

var
 bnext: longint;
 counter: integer;
 i, res: integer;
begin
 counter := 0;
 bnext := b;

 while true do
   begin
     res := succ((bnext - a) div d);
     if (bnext - a) mod d = 0
       then
         if (res <= n) and (res > 0) then inc(counter);

     bnext := bnext * q;
     if bnext > (a + d*(n - 1)) then break;
   end;

 if counter >= 3 then
   begin
     writeln( 'Прогрессия найдена:' );
     bnext := b;
     for i := 1 to counter do
       begin
         write( bnext:5 );
         bnext := bnext * q;
       end;
   end
 else writeln('Нет прогрессии');
 writeln
end.

Программа исправлена...

Сообщение отредактировано: volvo - 1.11.2004 1:29

[Altair]

О боги паскаля

А вот и он:
volvo
:P

[GoodWind]

опоздал я
ну фиг с ним, все-равно выложу

Код

uses crt;
var arif:array[1..500] of integer;
   geom:array[1..500] of integer;
   re,n,d,q,t:integer;

function stepen(x,y:integer):integer;
var i,q:integer;
begin
q:=1;
for i:=2 to y do q:=q*x;
stepen:=q;
end;

procedure make_arif;
var i:integer;
begin
for i:=2 to n do arif[i]:=arif[i-1]+d;
end;

procedure find_geo;
var i,j:integer;
begin
for i:=1 to n do
 begin
   for j:=t+1 to n do
    begin
      if arif[i]=stepen(q,j) then
      begin
       inc(t);
       geom[t]:=arif[i];
      end;

    end;
 end;
end;

begin
clrscr;
write('Введите a1: '); readln(arif[1]); geom[1]:=arif[1];t:=1;
write('Введите кол-во членов ариф. прогресси: ');   readln(n);
write('Введите разность ариф. прогресси: ');readln(d);
write('Введите знаменатель геом. прогресси: ');readln(q);
make_arif; find_geo;
for re:=1 to n do write(arif[re],' ');writeln;
for re:=1 to t do write(geom[re],' ');
readkey;
end.

массивы применял, оптимизации никакой....
ну и фиг с ним, выложил все равно

Сообщение отредактировано: GoodWind - 1.11.2004 0:41

[MapЫшKa]

ВЫ ТОЧ ГЕНИИ!
чесное слово!

[volvo]

res := succ((bnext - a) div d);

аналогично:

res := ((bnext - a) div d) + 1; { div - деление нацело }

inc(counter);

аналогично:

counter := counter + 1;

[GoodWind]

P.S.S. начинает копить деньги на памятник...

лучше на пиво ;)

[Amro]

Хех люблю простоту
Правда толком не проверял, но постарался упростить вариант Volvo

Код

uses crt;
const
a1 = 1;
b1 = 1;
n = 81;
q = 3;
d = 2;
var
i,g : integer;
An, Bn : longint;
{.....................................................}
Procedure Proverka(An:longint);
var
i : integer;
begin
i:=1;
repeat
    Bn:=b1*Round(exp((i-1)*ln(q)));
    if An=Bn then  
                        inc(g);
    if Bn>An then
                        break;
   inc(i);
until An=Bn;
end;
{........................................................}
begin
clrscr;
i:=1;

repeat
  An:=a1+d*(i-1);
  Proverka(An);
  inc(i);
until n <= i;

if g>=3 then
                begin
                 writeln('Прогрессия найдена:');
                 i:=1;
                 for i:=1 to g do
                     begin
                      Bn:=b1*Round(exp((i-1)*ln(q)));
                      Write(Bn:4);
                     end;
                end
              else write('А и нету ничего');
end.

Исправлено!!!
Мдя хотел упростить назавыется а написал ещё больше!!!

Сообщение отредактировано: Amro - 1.11.2004 2:12

[volvo]

Amro

А запусти-ка свою программку с n = 11
:P

Добавлено...

А вот после исправления - вроде работает ...

Сообщение отредактировано: volvo - 1.11.2004 2:26

[MapЫшKa]

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

БОГИ! - я не устану ето повторять!



P.S. договоримся ;)))

[GoodWind]

P.S. договоримся ))

а вот такой подход мне нравится