Помогите решить задачу на Паскале???

Тема в разделе "Delphi - FAQ", создана пользователем Yez, 18 мар 2005.

Наш партнер Genesis Hackspace
Статус темы:
Закрыта.
  1. Yez

    Yez Гость

    Помогите решить задачу, ПЛИЗЗЗ!!! Условие: Дан массив размера n ненулевых целых чисел. Проверить, чередуются ли в нём чётные и нечётные числа. Если чередуются, то вывести значения TRUE, если нет, то вывести номер первого элемента, нарушающего закономерность.
    Подскажите хотя бы идею решения!!! :) Зарание всем СПАСИБО!!! :)
     
  2. zubr

    zubr Гость

    Код (Text):
    Type
    mas=Array[1..100] of Integer;

    function CheckMassiv(buf:mas; var nom:Integer):boolean;
    var
    even:boolean;
    i:Integer;
    begin
    Result:=True;
    even:=(buf[1] mod 2)=0;//первый элемент четный или нечетный
    For i:=1 to 100 do
    begin
    If even then
    begin
     If (((i mod 2)<>0) and ((buf[i] mod 2)<>0)) or (((i mod 2)=0) and ((buf[i] mod 2)=0)) then
     begin
     nom:=i;
     Result:=False;
     exit;
     end;
    end
    else
    begin
     If (((i mod 2)<>0) and ((buf[i] mod 2)=0)) or (((i mod 2)=0) and ((buf[i] mod 2)<>0)) then
     begin
     nom:=i;//номер элемента нарушающего закономерность
     Result:=False;
     exit;
     end;
    end;
    end;
    end;
     
  3. Yez

    Yez Гость

    zubr
    Спасибо тебе большое!!! Может подскажешь где нормально разъеснены
    решения интегралов на
    Паскале??? :)
     
  4. zubr

    zubr Гость

    Неа, давно такое не делал, уже забыл. :)
     
  5. Yez

    Yez Гость

    zubr
    :) Извини, пожалуйста, может поможешь решить ещё одну задачу???
    Условие: Найдите приближённос точностью до 0.01 наибольшее значение функции y=(axквадрат+bx +c)/dx+e на отрезке [x1;x2]. Значения a, b, c, d, e, x1, x2 введите с клавиатуры. Зарание СПАСИБО!!!
     
  6. zubr

    zubr Гость

    Проще всего это решить с рекурсией. Вот примерный код:
    Код (Text):
    program MaxFunc;

    var
    a, b, c, d, e, x1, x2, y, Max, int:Real;

    procedure Recurs(a, b, c, d, e, x2:Real; var x1, int, y, Max:Real);
    var
    y2, x_int:Real;
    begin
    If x1>=x2 then
    begin
    exit;
    end;
    x_int:=x1+int;
    y2:=(a*x_int*x_int+b*x_int+c)/(d*x_int)+e;
    If Abs(y2-y)>0.01 then
    begin
    int:=int/2;
    Recurs(a, b, c, d, e, x1, x2, int, y, Max);
    end
    else
    begin
    If y2>Max then
    Max:=y2;
    x1:=x1+int;
    Recurs(a, b, c, d, e, x1, x2, int, y2, Max);
    end;
    end;

    begin
    Write('Enter a:');
    Readln(a);
    Write('Enter b:');
    Readln(b);
    Write('Enter c:');
    Readln(c);
    Write('Enter d:');
    Readln(d);
    Write('Enter e:');
    Readln(e);
    Write('Enter x1:');
    Readln(x1);
    Write('Enter x2:');
    Readln(x2);
    y:=(a*x1*x1+b*x1+c)/(d*x1)+e;
    Max:=y;
    int:=(x2-x1)/2;
    Recurs(a, b, c, d, e, x2, x1, int, y, Max);
    Writeln('Result=', Max);
    Writeln('Press "Enter" to exit');
    Readln;
    end.
    Здесь отрицательные значения функции не учитываются, это ты уже сам.
     
  7. Yez

    Yez Гость

    zubr
    Спасибо, тебе большое, но я уже сам решил, и всё таки ты не знаешь где можно достать документацию по решению интегралов??? ;)
     
  8. Quistis

    Quistis Гость

    Кто-нибудь объясните как решается эта задача. ПОЖАЛУЙСТА :(
    function F(X:string):string;
    var
    L:integer;
    T:string;
    begin
    L:=Length(X);
    if L>1 then
    begin
    T:copy(X,2,L-1);
    case X(1) of
    `0`:F:=T;
    `1`:F:=F(T)+`0`+F(T)
    else F:=F(X)
    end
    end
    else
    F:=F(X)
    end
    Нужно найти строку Х, для которой F(X)=10X
     
  9. zubr

    zubr Гость

    Функция function F(X:string):string не будет зацикливаться, только если X будет вида '10101010'
    Ответ здесь Х='10101'
     
  10. Guest_Quistis

    Guest_Quistis Гость

    zubr
    Спасибо за ответ :( И если тебе не лень, разъясни как ты это вычислил
     
  11. Guest_Quistis

    Guest_Quistis Гость

    zubr
    Пришел брат, он у меня сис. админ и решил задачку она конечно простая теперь и для меня. :(
     
  12. zubr

    zubr Гость

    Рад за вас :(
    А функцию кто писал? Кривовата она.
     
  13. Гость

    А такое решите??? Пожалуйста….очень надо))..если что мой маил enik1986@mail.ru

    Плииззз решите..

    У фирмы три магазина. Известен доход каждого магазина за каждый из десяти дней:
    магазин ДАТА
    1 2 3 4 5 6 7 8 9 10
    1-ый 3 5 4 7 9,5 8 2,3 3 7 5,1
    2-ой 4,1 2,8 4,3 1,2 6,7 8 5,5 3 4 8
    3-ий 8,3 9,1 10 8 7 2 3,4 2 3 9
    ДОХОД

    Организовать ввод информации по этой таблице и определить:
    А) какой из магазинов получил максимальный общий доход за 10 дней;
    Б) какого числа фирма получила максимальный общий доход;
    В) какой магазин, и какого числа получил максимальный доход за день
    Г) для каждого магазина определить, какого числа этот магазин получил максимальный доход;
    Д) для каждого магазина определить среднюю численность в группе
     
  14. zubr

    zubr Гость

    А что самому никак? Задача простенькая. У меня пока нет времени. Может на днях, если просвет будет, что подкину.
     
  15. zubr

    zubr Гость

    Женя
    Вот код:
    Код (Text):
    program Magazins;

    type
    mags=array [1..3, 1..10] of real;

    var
    mag:mags;
    i, j:Integer;

    procedure A(mag:mags);
    var
    i, j, n:Integer;
    max:array [1..3] of real;
    maxsum:real;
    begin
    For j:=1 to 3 do
    begin
    max[j]:=mag[j, 1];
    For i:=2 to 10 do
    begin
     If mag[j, i]>max[j] then
     max[j]:=mag[j, i];
    end;
    end;
    maxsum:=max[1];
    n:=1;
    For j:=2 to 3 do
    begin
    If max[j]>maxsum then
    begin
     maxsum:=max[j];
     n:=j;
    end;
    end;
    Writeln('Maxsimalniui doxod y magazina N', n);
    end;

    procedure B(mag:mags);
    var
    i, j, n:Integer;
    max:array [1..10] of real;
    maxsum:real;
    begin
    For j:=1 to 10 do
    begin
    max[j]:=0;
    For i:=1 to 3 do
    begin
     max[j]:=max[j]+mag[i, j];
    end;
    end;
    maxsum:=max[1];
    n:=1;
    For j:=2 to 10 do
    begin
    If max[j]>maxsum then
    begin
     maxsum:=max[j];
     n:=j;
    end;
    end;
    Writeln('Maxsimalniui doxod y firmi ', n, ' chisla');
    end;

    begin
    For j:=1 to 3 do
    begin
    Writeln('Vvedite doxod po dniam ',j,'-go magazina:');
    For i:=1 to 10 do
    begin
     Write(i,' den: ');
     Readln(mag[j, i]);
    end;
    end;
    Writeln;
    A(mag);
    Writeln;
    B(mag);
    Writeln;
    Writeln('Dlia vixoda iz programmi nagmite Enter');
    Readln;
    end.
    Сделано для пунктов А), Б), остальное сам.
     
  16. Sima

    Sima Гость

    :lol: :eek: Помогите, пожалст., решить задачу в Паскале: Даны параметры (длина и ширина)-Word прямоугольника. Нужно отсекать самые большие квадраты в нем до тех пор, пока стороны прямоугольника не станут по 1. :)
     
  17. zubr

    zubr Гость

    Код (Text):
    program Kvadrat;

    var
     a, b:Word;
     i:Integer;

    begin
    Write('Shirina: ');
    Readln(a);
    Write('Visota: ');
    Readln(b);
    If a=b then
    begin
     Writeln('Nevernoe yslovie!');
     Writeln('Dlia vixoda nagmite Enter');
     Readln;
     exit;
    end;
    i:=0;
    While (a>1) or (b>1) do
    begin
     inc(i);
     If a>b then
     begin
      a:=a-b;
      Writeln(i, ' kvadrat: ', b, '*', b);
     end
     else
     begin
      b:=b-a;
      Writeln(i, ' kvadrat: ', a, '*', a);
     end;
    Writeln('Ostalsia priamoygolnik: ', a, '*', b);
    end;
    Writeln('Dlia vixoda nagmite Enter');
    Readln;
    end.
     
  18. Sima

    Sima Гость

    СПАСИБА АГРОМНАЯ!!! :rolleyes:
     
  19. Sima

    Sima Гость

    Во чёрт! Оказывается, не пасиба! Задачу-то нужно решить рекурсией, а так и я тоже могу... А вот ентую рекурсию не понимаю, хоть убейте!!! :blink: :( :rolleyes:
     
  20. zubr

    zubr Гость

    Ну на тебе с рекурсией:
    Код (Text):
    program Kvadrat;

    var
    a,b:Word;
    i:Integer;

    procedure Recurs(var a, b:Word; var i:Integer);
    begin
    If (a=1) and (b=1) then
    exit;
    If a=b then
    begin
    Writeln('Ostalsia kvadrat: ', a, '*', b);
    Writeln('Dalshe reshenia net');
    exit;
    end;
    inc(i);
    If a>b then
    begin
    a:=a-b;
    Writeln(i, ' kvadrat: ', b, '*', b);
    Writeln('Ostalsia priamoygolnik: ', a, '*', b);
    end
    else
    begin
    b:=b-a;
    Writeln(i, ' kvadrat: ', a, '*', a);
    Writeln('Ostalsia priamoygolnik: ', a, '*', b);
    end;
    Recurs(a, b, i);
    end;

    begin
    Write('Shirina: ');
    Readln(a);
    Write('Visota: ');
    Readln(b);
    If a=b then
    begin
    Writeln('Nevernoe yslovie!');
    Writeln('Dlia vixoda nagmite Enter');
    Readln;
    exit;
    end;
    i:=0;
    Recurs(a, b, i);
    Writeln('Dlia vixoda nagmite Enter');
    Readln;
    end.
     
Загрузка...
Похожие Темы - Помогите решить задачу
  1. GREED
    Ответов:
    5
    Просмотров:
    715
  2. vovanabali
    Ответов:
    0
    Просмотров:
    598
  3. merrs
    Ответов:
    1
    Просмотров:
    1.332
  4. Kugotovr23
    Ответов:
    1
    Просмотров:
    1.310
  5. mregor
    Ответов:
    0
    Просмотров:
    930
Статус темы:
Закрыта.

Поделиться этой страницей