Хостинг портала RFpro.ru:
Московский хостер
Профессиональный платный хостинг на базе Windows 2008

РАССЫЛКИ ПОРТАЛА RFPRO.RU

Чемпионы рейтинга экспертов в этой рассылке

lamed Статус: Практикант Рейтинг: 2145 ∙ повысить рейтинг »

Boriss Статус: Академик Рейтинг: 1815 ∙ повысить рейтинг »

_Ayl_ Статус: Студент Рейтинг: 1718 ∙ повысить рейтинг »

Вопрос № 177014: Нужно написать программу для Турбо Паскаля ...

Нужно написать программу для Турбо Паскаля

Отправлен: 02.03.2010, 21:20
Вопрос задал: sanekvseti, Посетитель
Всего ответов: 2
Страница вопроса »

Приложение:
var a,b,c:integer; x,y,z,u:real; {функция min} function F_min(aa,bb:integer):integer; begin if aa>bb then F_min:=bb else F_min:=aa; end; {функция max} function F_max(aa,bb:integer):integer; begin if aa>bb then F_max:=aa else F_max:=bb; end; {функция вычисления растояния} function F_rad(aa,bb:real):real; begin F_rad:=sqrt(sqr(aa)+sqr(bb)); end; begin {вводим А, В и С} Write(\'Enter A:\'); readln(a); Write(\'Enter B:\'); readln(b); Write(\'Enter C:\'); readln(c); {считаем по формулам X, Y и Z} x:=F_min(F_max(a,b),c); y:=F_max(b,c); z:=x/(y+5); {выполняем условие} if(F_rad(x+1,y)>=1)and(F_rad(x+1,y)<=2)and(x>=0)then u:=x-y{проверяем область D1} else if(y<=(x-2))then u:=x*y+15{проверяем область D2} else u:=z;{в другой области} {выводим результат} write(\'Result U:=\',u:10:5); readln; end.
-----
Итерация от человека. Рекурсия — от Бога. — Л. Питер Дойч

Ответ отправил: Зенченко Константин Николаевич, Модератор
Ответ отправлен: 05.03.2010, 12:46
Номер ответа: 259907
Украина, Киев
Тел.: +38-097-953-66-19
Адрес: Украина, Киев

Вам помог ответ? Пожалуйста, поблагодарите эксперта за это! Как сказать этому эксперту "спасибо"?

Отправить SMS #thank 259907 на номер 1151 (Россия) | Еще номера »

Отправить WebMoney: Неплохо (30 руб.) Хорошо (40 руб.) Отлично (55 руб.) БЛЕСТЯЩЕ! (80 руб.)

Program labs;
uses crt;
var
a,b,c,x,y,z,u:real;
begin
      clrscr;
      write('Input A: '); readln(a);
      write('Input B: '); readln(b);
      write('Input C: '); readln(c);
    
 if a>b then if a<c then x:=a
      else x:=c
      else if b<c then x:=b
      else x:=c;
      if c>b then x:=c
      else x:=b;
      z:=x/(y+5);
      if (y>=0) and (sqr(x+1)+y*y>=1) and (sqr(x+1)+y*y<=4) then u:=x-y
      else if (x>=0) and (y<=x-2) then u:=x-y+15
      else u:=z;
      writeln('u= ',u:5:2,', x= ',x:5:2,', y= ',y:5:2,', z= ',z:5:2); readln;
end.

Ответ отправил: F®ost, Советник
Ответ отправлен: 05.03.2010, 21:52
Номер ответа: 259922
Беларусь, Минск
Тел.: 375292792018
Организация: Минский Промтранспроект
Адрес: ул. В.Хоружей, 13, г. Минск, Беларусь
Адрес сайта: http://www.mptp.by

Вам помог ответ? Пожалуйста, поблагодарите эксперта за это! Как сказать этому эксперту "спасибо"?

Отправить SMS #thank 259922 на номер 1151 (Россия) | Еще номера »

Отправить WebMoney: Неплохо (30 руб.) Хорошо (40 руб.) Отлично (55 руб.) БЛЕСТЯЩЕ! (80 руб.)

Здравствуйте,уважаемые эксперты! Такие вот задачи, помогите пожалуйста с решением:

1. Имеется одномерный массив, отсортированный пузырьком(уже результат этой сортировки). и данные о том сколько раз перестанавливался каждый из элементов массива. Восстановить по этим данным исходной массив, с первоначальной расстановкой элементов.
Пример:
5 4 9 3 7 *исходный, эти данный нужно получить*
4 5 3 7 9 - 1 1 2 1 1 *перестановки*
4 3 5 7 9 - 1 2 2 2 1
3 4 5 7 9 - 2 2 2 3 1
В данном примере из данных об отсортированном массиве "3 4 5 7 9 " и данных о количестве перестановок его элементов "2 2 2 3 1" необходимо получить исходный массив - "5 4 9 3 7".

2. Массив 12 3 5 7 9 10 сортируется методом пузырька за один просмотр, а массив 5 7 9 10 12 3 за пять.Устранить неравноправие путём смены направлений просмотров, т.е. первоначально в направлении "направо" получаем 5 7 10 3 12 а затем в н аправлении "налево" результат - 3 5 7 9 10 12. итак, чередуем направления , пока массив не будет отсортирован.

Заранее огромное спасибо!

Отправлен: 02.03.2010, 23:46
Вопрос задал: Надежда Лаптева, Посетитель
Всего ответов: 2
Страница вопроса »

Приложение:
program q177025; {$R-} { отключаем проверку индексов } type t_intarray = array [0..0] of integer; p_intarray = ^t_intarray; { вывод массива на экран } procedure print_array( var a: t_intarray; n: integer; prefix: char ); var i: integer; begin write( prefix ); for i := 0 to n-1 do write( a[i]:4 ); writeln; end; { Шейкерная сортировка массива. n - кол-во элементов в массиве } procedure cocktail_sort( var a: t_intarray; n: integer ); var k, l, r, tmp, i : integer; begin print_array( a, n, \':\' ); { выводим на экран исходный массив - для наглядности } l := 0; { левая граница } r := n-1; { правая граница } k := r; { индекс последнего изменения } while r > l do begin { опускаем "тяжелые" элементы вниз минимальный элемент на отрезке [l,r] опускается на свое место } for i := r downto l+1 do if a[i] < a[i-1] then begin tmp := a[i]; a[i] := a[i-1]; a[i-1] := tmp; k := i; end; l := k; { все элементы до l упорядочены } print_array( a, n, \'<\' ); { поднимаем "легкие" элементы вверх максимальный элемент на отрезке [l,r] поднимается на свое место } for i := l to r-1 do if a[i] > a[i+1] then begin tmp := a[i]; a[i] := a[i+1]; a[i+1] := tmp; k := i; end; r := k; { все элементы после r упорядочены } print_array( a, n, \'>\' ); end; end; const a1: array [0..5] of integer = ( 12, 3, 5, 7, 9, 10 ); a2: array [0..5] of integer = ( 5, 7, 9, 10, 12, 3 ); var p: p_intarray; begin p := p_intarray(@a1); { обходим проверку типов } cocktail_sort( p^, 6 ); p := p_intarray(@a2); cocktail_sort( p^, 6 ); end.

Ответ отправил: amnick, 9-й класс
Ответ отправлен: 03.03.2010, 15:40
Номер ответа: 259868

Вам помог ответ? Пожалуйста, поблагодарите эксперта за это! Как сказать этому эксперту "спасибо"?

Отправить SMS #thank 259868 на номер 1151 (Россия) | Еще номера »

Отправить WebMoney: Неплохо (30 руб.) Хорошо (40 руб.) Отлично (55 руб.) БЛЕСТЯЩЕ! (80 руб.)

Приложение:
Uses Crt; Const MinIndex = 1; MaxIndex = 5; Type TNumSet = Set of Byte; TOffset = Array[MinIndex..MaxIndex] of TNumSet; TDataArray = Array[MinIndex..MaxIndex] of Integer; Const ResAr: TDataArray = (3, 4, 5, 7, 9); ExAr: TDataArray = (2, 2, 2, 3, 1); {Ряд наборов перестановок для тестирования (0, 0, 0, 0, 0) (4, 2, 0, 2, 4) (4, 0, 2, 1, 1) (3, 1, 2, 1, 3) (2, 2, 2, 3, 1)} Var Place: TOffset; i, j: Byte; function ItemsCount(s: TNumSet): Byte; {Подсчет количества элементов в множестве} var result, i: Byte; begin result := 0; for i := MinIndex to MaxIndex do if (ResAr[i] in s) then Inc(result); ItemsCount := result; end; procedure PrintSets; {Вывод множества на экран} var i, j: Byte; begin {Print values of places} for i := MinIndex to MaxIndex do begin Write(i:3, {\'.\', ItemsCount(Place[i]):3,} \': [\'); for j := MinIndex to MaxIndex do begin if (ResAr[j] in Place[i]) then Write(ResAr[j]:2); end; Writeln(\']\'); end; Writeln; end; procedure Solve; { Идея решения состоит в том, что большИе значения попадая в хвост уже из него не всплывают. Значит начав просмотр с хвоста можно с большой вероятностью отыскать правильное первоначальное место элемента. Меньшие значения могут совершать более "непредсказуемые" перемещения в процессе упорядочивания. } var max, idx: Integer; begin for i := MaxIndex downto MinIndex do begin if ExAr[i] = 0 then begin {Если перестановок с этой позиции не было} Place[i] := [ResAr[i]]; end else begin for j := MaxIndex downto MinIndex do begin if i = j then begin if Not (Odd(ExAr[j])) then {Если количество перемещений было четным, то, возможно, элемент перемещался, но вернулся на исходную позицию} Place[j] := Place[j] + [ResAr[i]]; continue; end; if ((j < i) and (j + ExAr[j] = i)) or ((i < j) and (j - ExAr[j] = i)) then begin {Если рассматриваемая позиция достижима из предполагаемой} Place[j] := Place[j] + [ResAr[i]]; continue; end; end; end; end; {Попытка приведения количества элементов в каждом множестве к единственному} {WARNING! Не всякий набор перестановок дает единственный ответ. К примеру для наборов (7, 3, 9, 5, 4) и (7, 5, 3, 9, 4) я насчитал одинаковый набор перестановок - (3, 1, 2, 1, 3)} i := 0; while (i <= MaxIndex) do begin if (ItemsCount(Place[i]) > 1) then for j := MinIndex to MaxIndex do if (i = j) then continue else if ItemsCount(Place[j]) = 1 then Place[i] := Place[i] - Place[j]; Inc(i); end; PrintSets; end; begin ClrScr; Solve; readkey; end.
-----
Временная неудача лучше временной удачи

Ответ отправил: Andrew Kovalchuk, 6-й класс
Ответ отправлен: 06.03.2010, 03:53
Номер ответа: 259930

Вам помог ответ? Пожалуйста, поблагодарите эксперта за это! Как сказать этому эксперту "спасибо"?

Отправить SMS #thank 259930 на номер 1151 (Россия) | Еще номера »

Отправить WebMoney: Неплохо (30 руб.) Хорошо (40 руб.) Отлично (55 руб.) БЛЕСТЯЩЕ! (80 руб.)

здравствуйте,помогите пожалуйста:

1.Введите строку из нескольких слов. Определите, сколько слов в строке имеет четное количество символов, а сколько - нечетное.

2.Текущие активы фирмы представляются выражением ТА(х) = 15 – 7х, а текущие пассивы – ТП (х) = 10 + 3х2. Протабулируйте, т.е. представьте в табличном виде изменение ТА и ТП, а также ликвидность капитала фирмы L = ТА /ТП ежемесячно в течение года (х =1, 2, 3, 4, 5, …, 12). Результаты табуляции запишите в файл.

Отправлен: 03.03.2010, 12:48
Вопрос задал: max123, Посетитель
Всего ответов: 2
Страница вопроса »

Приложение:
var ta,tp,l: real; x: byte; f:text; Begin assign(f,\'\bp\pas\table.txt\'); rewrite(f); writeln(f,\'--------------------------\'); writeln(f,\': Mec: TA : TP : L :\'); writeln(f,\'--------------------------\'); for x:=1 to 12 do begin ta:=15-7*x; tp:=10+3*x*x; l:=ta/tp; writeln(f,\':\',x:3,\' :\',ta:4:0,\' :\',tp:4:0,\' :\',l:6:2,\' :\') end; writeln(f,\'--------------------------\'); close(f) ; Write(\'Готово!\'); readln end.

Ответ отправил: Максим Юрьевич, 7-й класс
Ответ отправлен: 03.03.2010, 16:23
Номер ответа: 259870

Оценка ответа: 5

Вам помог ответ? Пожалуйста, поблагодарите эксперта за это! Как сказать этому эксперту "спасибо"?

Отправить SMS #thank 259870 на номер 1151 (Россия) | Еще номера »

Отправить WebMoney: Неплохо (30 руб.) Хорошо (40 руб.) Отлично (55 руб.) БЛЕСТЯЩЕ! (80 руб.)

Приложение:
var a,b:string; countA,countB:integer; begin repeat{вводим не пустую строку} write(\'Enter string:\'); readln(a); until length(a)>0; b:=\'.,!/?-=(@#$%^&*)\';{служебная строка символов-разделителей слов} while length(b)>0 do{пока не проверим всё символы-разделители} begin while pos(b[1],a)>0 do{пока в строке есть символ-разделитель заменяем его на пробел} a[pos(b[1],a)]:=\' \'; delete(b,1,1);{удаляем проверенный символ-разделитель} end; while pos(\' \',a)>0 do{удаляем двойные пробелы в строке} delete(a,pos(\' \',a),1); {сбрасываем счетчики} countA:=0; countB:=0; {проверяем строку} while length(a)>0 do begin if pos(\' \',a)=0 then a:=a+\' \';{если пробела нет, то добавляем его} b:=copy(a,1,pos(\' \',a)-1);{копируем текущее(первое) слово} if odd(length(b)){проверяем его длину и увеличиваем нужный счетчик} then inc(countA) else inc(countB); delete(a,1,pos(\' \',a));{удаляем первое слово} end; {выводим результат} writeln(\'odd length:=\',countA:4); writeln(\'even length:=\',countB:4); readln; end.
-----
Итерация от человека. Рекурсия — от Бога. — Л. Питер Дойч

Ответ отправил: Зенченко Константин Николаевич, Модератор
Ответ отправлен: 04.03.2010, 12:46
Номер ответа: 259887
Украина, Киев
Тел.: +38-097-953-66-19
Адрес: Украина, Киев

Вам помог ответ? Пожалуйста, поблагодарите эксперта за это! Как сказать этому эксперту "спасибо"?

Отправить SMS #thank 259887 на номер 1151 (Россия) | Еще номера »

Отправить WebMoney: Неплохо (30 руб.) Хорошо (40 руб.) Отлично (55 руб.) БЛЕСТЯЩЕ! (80 руб.)

Уважаемые эксперты, помогите, надо написать программу!

Отправлен: 03.03.2010, 17:48
Вопрос задал: sanekvseti, Посетитель
Всего ответов: 2
Страница вопроса »

program P_177041;

type
    { В переменных этого типа будем хранить данные о диапазоне изменения и шаге
      переменных }
    TRange=record
        Start,Finish,Step:Double;
    end;

{ Вводит данные
вещественного типа с примитивным контролем ошибок }
function InputDouble(Msg:String):Double;
var
    Res:Double;
begin
    {$I-}
    repeat
        Write(Msg);
        ReadLn(Res);
    until IOResult=0;
    {$I+}
    InputDouble:=Res;
end;

{ Ввод информации о диапазоне изменения переменной }
procedure InputRange(Variable:String;var Range:TRange);
var
    Res:TRange;
begin
    Res.Start:=InputDouble('Начальное зн
 ачение для '+Variable+':');
    Res.Finish:=InputDouble('Конечное значение для '+Variable+':');
    if Res.Start>Res.Finish then begin
        WriteLn('Начальное значение должно быть меньше конечного');
        Halt;
    end;
    Res.Step:=InputDouble('Значение шага для '+Variable+':');
    if Res.Step<=0 then begin
        WriteLn('Шаг должен быть больше нуля');
        Halt;
    end;
    Range:=Res;
end;

const

   Line='-------------------------------';

var
    XRange,YRange:TRange;
    X,Y,Z:Double;

begin
{ Ввод данных }
    InputRange('X',XRange);
    InputRange('Y',YRange);
    WriteLn(Line);
    WriteLn('|','    X    ','|','    Y    ','|','    Z    ','|');
    WriteLn(Line);
{ Ниже, собственно, само задание }
    X:=XRange.Start;
    
 repeat
        Y:=YRange.Start;
        repeat
            Write('|',X:9:4,'|',Y:9:4,'|');
            { Вычисляем значение }
            if X>-1 then begin
                Z:=(X*X+2*cos(Y)+1)/(ln(Abs(1+Sqrt(X+1)))/ln(10));
                { Выводим результат }
                WriteLn(Z:9:4,'|');
            end else begin
                WriteLn(' Ошибка  ','|');
            end;
            Y:=Y+YRange.Step;
       
until Y>YRange.Finish;
        X:=X+XRange.Step;
    until X>XRange.Finish;
end.

/home/micren/projects/Pascal/P_177041
Начальное значение для X:0.2
Конечное значение для X:2
Значение шага дл
 я X:0.156
Начальное значение для Y:3
Конечное значение для Y:5
Значение шага для Y:0.5
-------------------------------
|    X    |    Y    |    Z    |
-------------------------------
|   0.2000|   3.0000|  -2.9258|
|   0.2000|   3.5000|  -2.5925|
|   0.2000|   4.0000|  -0.8320|
|   0.2000|   4.5000|   1.9248|
|   0.2000|   5.0000|   5.0029|
|   0.3560|   3.0000|  -2.5443|
|   0.3560|   3.5000|  -2.2251|
|   0.3560|   4.0000|  -0.5384|
|   0.3560|   4.5000|   2.1027|
|
  0.3560|   5.0000|   5.0516|
|   0.5120|   3.0000|  -2.0614|
|   0.5120|   3.5000|  -1.7539|
|   0.5120|   4.0000|  -0.1296|
|   0.5120|   4.5000|   2.4138|
|   0.5120|   5.0000|   5.2536|
|   0.6680|   3.0000|  -1.4822|
|   0.6680|   3.5000|  -1.1848|
|   0.6680|   4.0000|   0.3858|
|   0.6680|   4.5000|   2.8452|
|   0.6680|   5.0000|   5.5913|
|   0.8240|   3.0000|  -0.8110|
|   0.8240|   3.5000|  -0.5225|
|   0.8240|   4
 .0000|   1.0014|
|   0.8240|   4.5000|   3.3876|
|   0.8240|   5.0000|   6.0519|
|   0.9800|   3.0000|  -0.0513|
|   0.9800|  
 3.5000|   0.2293|
|   0.9800|   4.0000|   1.7120|
|   0.9800|   4.5000|   4.0336|
|   0.9800|   5.0000|   6.6258|
|   1.1360|   3.0000|   0.7937|
|   1.1360|   3.5000|   1.0674|
|   1.1360|   4.0000|   2.5133|
|   1.1360|   4.5000|   4.7774|
|   1.1360|   5.0000|   7.3052|
|   1.2920|   3.0000|   1.7217|
|   1.2920|   3.5000|   1.9891|
|   1.2920|   4.0000|   3.4019|
|   1.2920|   4.5000|   5.6142|
|   1.2920|   5.0000|   8.0843|
|   1.4480|   3.0000|   2.7302|
|
  1.4480|   3.5000|   2.9920|
|   1.4480|   4.0000|   4.3749|
|   1.4480|   4.5000|   6.5403|
|   1.4480|   5.0000|   8.9580|
|   1.6040|   3.0000|   3.8174|
|   1.6040|   3.5000|   4.0740|
|   1.6040|   4.0000|   5.4296|
|   1.6040|   4.5000|   7.5523|
|   1.6040|   5.0000|   9.9223|
|   1.7600|   3.0000|   4.9815|
|   1.7600|   3.5000|   5.2334|
|   1.7600|   4.0000|   6.5639|
|   1.7600|   4.5000|   8.6474|
|   1.7600|   5.0000|  
 10.9738|
|   1.9160|   3.0000|   6.2208|
|   1.9160|   3.5000|   6.4684|
|   1.9160|   4.0000|   7.7759|
|   1.9160|   4.5000|   9.8233|
|   1.9160|   5.0000|  12.1094|

program P_177041;

var
    x,xn,xk,hx,y,yn,yk,hy,z:Real;
begin
{
Ввод данных }
    WriteLn('Введите xn,xk,hx,yn,yk,hy');
    ReadLn(xn,xk,hx,yn,yk,hy);
{ Ниже, собственно, само задание }
    x:=xn;
    repeat
        y:=yn;
        repeat
            { Вычисляем значение }
            z:=(x*x+2*cos(y)+1)/(ln(Abs(1+Sqrt(x+1)))/ln(10));
            { Выводим результат }
            WriteLn('x=',x:6:2,' y=',y:6:2,' z=',z:6:2);
       
      y:=y+hy;
        until y>=yk+hy/2;
        x:=x+hx;
    until x>=xk+hx/2;
end.

Ответ отправил: Micren, Профессионал
Ответ отправлен: 03.03.2010, 18:41
Номер ответа: 259874

Вам помог ответ? Пожалуйста, поблагодарите эксперта за это! Как сказать этому эксперту "спасибо"?

Отправить SMS #thank 259874 на номер 1151 (Россия) | Еще номера »

Отправить WebMoney: Неплохо (30 руб.) Хорошо (40 руб.) Отлично (55 руб.) БЛЕСТЯЩЕ! (80 руб.)

Program labs;
uses crt;
var
        x,y,z,xn,xk,yn,yk,hx,hy:real;
        i:integer;
begin
       clrscr;
       write('input xn: '); readln(xn);
       write('input xk: '); readln(xk);
     
 write('input hx: '); readln(hx);
       write('input yn: '); readln(yn);
       write('input yk: '); readln(yk);
       write('input hy: '); readln(hy);
       y:=yn;
       writeln(' x y z');
       writeln;
       repeat
       x:=xn;
       repeat
       z:=(x*x+2*cos(y)+1)/(ln(abs(1+sqrt(x+1))/ln(10)));
       write(' ',x:3:1,' ');
       write(y:3:1,' ');
       wri
 te(z:6:3);
       writeln;
       x:=x+hx;
       until x>xk;
       y:=y+hy;
       writeln;
       until y>yk;
       readkey;
end.

Ответ отправил: F®ost, Советник
Ответ отправлен: 05.03.2010, 22:25
Номер ответа: 259925
Беларусь, Минск
Тел.: 375292792018
Организация: Минский Промтранспроект
Адрес: ул. В.Хоружей, 13, г. Минск, Беларусь
Адрес сайта: http://www.mptp.by

Вам помог ответ? Пожалуйста, поблагодарите эксперта за это! Как сказать этому эксперту "спасибо"?

Отправить SMS #thank 259925 на номер 1151 (Россия) | Еще номера »

Отправить WebMoney: Неплохо (30 руб.) Хорошо (40 руб.) Отлично (55 руб.) БЛЕСТЯЩЕ! (80 руб.)

Оценить выпуск »
Нам очень важно Ваше мнение об этом выпуске рассылки!

Задать вопрос экспертам этой рассылки »