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

Тема в разделе "Pascal and Delphi", создана пользователем skiff94, 10 сен 2011.

Статус темы:
Закрыта.
  1. skiff94

    skiff94 Гость

    qwe.JPG
    Помогите написать БЛОК-СХЕМУ пожалуйста
    <!--shcode--><pre><code class='pascal'>uses crt;
    var n,k:integer;
    p:real;
    begin
    clrscr;
    write('n=');
    readln(n);
    p:=1;
    for k:=1 to n do
    p:=p*cos(k);
    write('P=',p:0:8);
    readln
    end[/CODE]
    <!--shcode--><pre><code class='pascal'>uses crt;
    function sign(a:real):integer;
    begin
    if a<0 then sign:=-1
    else if a=0 then sign:=0
    else sign:=1;
    end;
    var x,y:real;
    z:integer;
    begin
    clrscr;
    writeln('Введите 2 числа:');
    readln(x,y);
    z:=(sign(x)+sign(y))*sign(x+y);
    write('Z=',z);
    readln
    end[/CODE]
    <!--shcode--><pre><code class='pascal'>uses crt;
    {функция определения палиндрома}
    function Palindrom(n:integer):boolean;
    var m,p,i,k:integer;
    begin
    m:=n;
    p:=0; {получим перевернутое число}
    while m>0 do
    begin
    i:=m mod 10;
    p:=p*10+i;
    m:=m div 10;
    end;
    Palindrom:=p=n;{если оно равно исходному то палиндром}
    end;
    {процедура переворота числа}
    procedure Revers(n:integer;var p:integer);
    var m:longint;
    i:integer;
    begin
    m:=n;
    p:=0;
    while m>0 do
    begin
    i:=m mod 10;
    p:=p*10+i; {записываем цифры с конца в начало нового числа}
    m:=m div 10;
    end;
    end;
    {проверка на завершение за данное число итераций}
    function Zaversh(n,m:integer):boolean;
    var a,p,k:integer;
    f:boolean;
    begin
    k:=0;
    f:=true;
    repeat
    if not Palindrom(n) then {если не палиндром}
    begin
    a:=n; {запомним}
    k:=k+1; {считаем итерации}
    Revers(a,p);{переворачиваем}
    n:=n+p; {суммитуем}
    end;
    if k>m then {если не вложились}
    begin
    f:=false;
    break; {завершаем проверку}
    end;
    until Palindrom(n)or not f; {если палиндром или не уложились, конец цикла}
    Zaversh:=f;
    end;
    var k,l,m,i:integer;
    begin
    clrscr;
    write('Введите начало диапазона k=');
    readln(k);
    repeat
    write('Введите конец диапазона l>=',k,' l=');
    readln(l);
    until l>=k;
    write('Введите максимальное число итераций m=');
    readln(m);
    for i:=k to l do
    begin
    if Zaversh(i,m) then writeln('Для числа ',i,' завершается')
    else writeln('Для числа ',i,' не завершается');
    end;
    readln
    end[/CODE]
     
Загрузка...
Похожие Темы - Посмотрите пожалуйста код
  1. ioni
    Ответов:
    5
    Просмотров:
    3.911
  2. Gamlet
    Ответов:
    16
    Просмотров:
    6.962
  3. Gamlet
    Ответов:
    11
    Просмотров:
    5.242
  4. vital
    Ответов:
    21
    Просмотров:
    6.996
  5. limbra
    Ответов:
    3
    Просмотров:
    44
Статус темы:
Закрыта.

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