Turbo Pascal

akick

letter to god
Ответ: Turbo Pascal

Честно говоря не думал, что ABC чемто отличается от оригинала, но разочаровался
вот стандартный поскалевый код:
Код:
program IDZ4;
USES CRT;

const C = 3;  { cols }
const R = 1;  { rows }

type myArr = array [0..R,0..C] of integer; { new type matrix }

{start array procedure }
procedure FuckArray(arr: myArr);
var i,j,my,elements:integer;
begin
  clrscr;
  elements := (R+1)*(C+1);
  my := 0;

  for i := 0 to R  do
  begin
  write('{ ');
    for j := 0 to  C do
    begin
        write(' ',arr[i,j],' ');    { printing input array }
    end;
    write(' }');
  end;
  writeln('[',elements,']');
  for i := 0 to  R do
  begin
  write('{ ');
    for j := 0 to  C do
    begin
      if(  ( arr[i,j] <>  3 ) and ( arr[i,j] <>  -3 ) ) then
      inc(my);                     { search to 3,-3       }

      arr[i,j] := 5;               { replace element to 5 }
      write(' ',arr[i,j],' ');     { printing new array   }
    end;
    write(' }');
    end;
  writeln('[',elements,']');
  writeln('Elements <>(3,-3) in array: ',my);
  end;
{ /end procedure block }

var
  matrix: myArr;
  i,j: integer;

begin

Randomize;

  for i := 0 to R do
    for j := 0 to C do
      matrix[i,j] := Random(10)-3;         { initialize the array }

  fuckArray(matrix);  { using procedure }
  readln;
end.
 
Ответ: Turbo Pascal

Код:
program pervaya;
uses crt;
var a,b,x,c,d,y,z:real;
begin
clrscr;
write ('vvedite a,b,x');
readln(a,b,x);
if (x=1)or(a*b+x<0)or(a*x<=1)or(cos(a+b)=0)
     then
        writeln ('delenie na nol')
     else
 begin
   c:=ln(a*b+x)/ln(5)-sqrt(abs(x-arctan((a*x)/sqrt(1-x*x))));
   d:=abs((a*a-1)/(B*b+1))+sqr(sin(a+b)/cos(a+b));
   y:=c/d+exp(-1/a*b);
   write ('Otvet y  = ',y:3:5)
 end;
 readkey;
end.
помогите плз в чем ошибка как сделать что б работало :|
 

Вкладення

  • 4.5 КБ Перегляди: 259

СерьогА

Просто СерьогА
Ответ: Turbo Pascal

Люди памагите хто может! Нада решить задачку, там со списками ! Прога должна создавать новый список, вводить в список елементы, искать первое и последнее вхождение заданной информации в список, разбивать список за указанным елементом, удалять елементы из списка! Мне нужно хотябы меню и вставка/удаление елементов в список и вывод информации на екран!!! Помогите плз кто может!
 

celerons

Лёша
Ответ: Turbo Pascal

Люди памагите хто может! Нада решить задачку, там со списками ! Прога должна создавать новый список, вводить в список елементы, искать первое и последнее вхождение заданной информации в список, разбивать список за указанным елементом, удалять елементы из списка! Мне нужно хотябы меню и вставка/удаление елементов в список и вывод информации на екран!!! Помогите плз кто может!

Код:
{Массивы данных. Пример использования и работы с ними}
program massiv;

{$APPTYPE CONSOLE}

uses
  SysUtils
  ,Dialogs
  ;

var
  // Определение статического массива
  wordArray  : Array[Word] of Integer;     // Статический, размер=High (Word)
  multiArray : Array[Byte, 1..5] of char;  // Статический массив, 2 измерения
  rangeArray : Array[5..20] of string;     // Статический массив, размер = 16

  i : Integer;

begin
  // Показ размеров и диапазоны этих массивов
  ShowMessage('Длина wordArray = '+IntToStr(Length(wordArray)));
  ShowMessage('Самый маленький элемент wordArray = '+IntToStr(Low(wordArray)));
  ShowMessage('Самый большой элемент wordArray = '+IntToStr(High(wordArray)));
  ShowMessage('Длина multiArray = '+IntToStr(Length(multiArray)));
  ShowMessage('Самый маленький элемент multiArray = '+IntToStr(Low(multiArray)));
  ShowMessage('Самый большой элемент multiArray = '+IntToStr(High(multiArray)));
  ShowMessage('Длина rangeArray = '+IntToStr(Length(rangeArray)));
  ShowMessage('Самый маленький элемент rangeArray = '+IntToStr(Low(rangeArray)));
  ShowMessage('Самый большой элемент rangeArray = '+IntToStr(High(rangeArray)));
  ShowMessage('');

  // Полный диапазон статического массива доступен до назначения,
  // но значения будет непредсказуемо
  ShowMessage('wordArray элемент 7 = '+IntToStr(wordArray[7]));
  ShowMessage('wordArray элемент 20 = '+IntToStr(wordArray[20]));

  // Использование индексации для заполнения массива
  for i := 5 to 20 do
    rangeArray[i] := IntToStr(i * 5);

  // Теперь используем индексацию для отображения 2-х элементов
  ShowMessage('rangeArray элемент 7 = '+rangeArray[7]);
  ShowMessage('rangeArray элемент 20 = '+rangeArray[20]);
end.
 

Вкладення

celerons

Лёша
Ответ: Turbo Pascal

Код:
program pervaya;
uses crt;
var a,b,x,c,d,y,z:real;
begin
clrscr;
write ('vvedite a,b,x');
readln(a,b,x);
if (x=1)or(a*b+x<0)or(a*x<=1)or(cos(a+b)=0)
     then
        writeln ('delenie na nol')
     else
 begin
   c:=ln(a*b+x)/ln(5)-sqrt(abs(x-arctan((a*x)/sqrt(1-x*x))));
   d:=abs((a*a-1)/(B*b+1))+sqr(sin(a+b)/cos(a+b));
   y:=c/d+exp(-1/a*b);
   write ('Otvet y  = ',y:3:5)
 end;
 readkey;
end.
помогите плз в чем ошибка как сделать что б работало :|

Код:
{Задача}
program Taras;

{$APPTYPE CONSOLE}

uses
  SysUtils {/  ,Dialogs // Только для отладки
};

var
  a,b,x,c,d,y,z:real;
//  l:real;
begin
//clrscr; // xD зачем екран чистишь?
  writeln ('vvedite a,b,x');      // запрос на ввод данных
  readln(a,b,x); // Читаем a,b,x
//a:=1;
//b:=2;
//x:=3;
  {Проверка на деление на 0}
  if (x=1)or(a*b+x<0)or(a*x<=1)or(cos(a+b)=0)
     then
        begin
        writeln ('delenie na nol'); // Пользуйся writeln
        readln;
        end

  {Иные случаи}
     else
     begin
c:=ln(a*b+x)/ln(5)-sqrt(abs(x-arctan((a*x)/sqrt(abs(1-x*x)))));
//l:=arctan((a*x)/sqrt(1-x*x))  // Ошибка здесь.
{sqrt(1-x*x) если x=1 or x=0 тогда норм, но деление на ноль,
иначе, подкоренное выражение всегда
должно быть больше нуля.
Скорее всего там модуль должен быть.}
//sqrt(
//;
//      ShowMessage('STEP1');
      d:=abs((a*a-1)/(B*b+1))+sqr(sin(a+b)/cos(a+b));
//      ShowMessage('STEP2');
      y:=c/d+exp(-1/a*b);
//      ShowMessage('STEP3');
      writeln ('Otvet y  = ',y:3:5);
//      ShowMessage('STEP4');

      end;
readln;
// readkey;  // на олимпиаде модули подключать не разрешают :)
end.
 

Вкладення

Пух

كنت بلهاء
Модератор
Ответ: Turbo Pascal

2celerons
1) массив и списки это разные вещи
2) это тема про Паскаль,а не С
 

Cris

Member
Ответ: Turbo Pascal

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

ВСЕ транслитом выводит на чорном экране слева))
если доделаю и все будет норм и будет время, то еше выпушу версюю для работы с мышкой))
 

Вкладення

Пух

كنت بلهاء
Модератор
Ответ: Turbo Pascal

не успел ты, келбас через 1,5 часа :Р
 

Русечкин

♥♠♣•♀?♪ §╘
Ответ: Turbo Pascal

Парни нужна помощь в примере!!Сама задача работает норм решает все! Тут вопросов нет. Только есть одна проблемка если вводиш три одинаковых числа например а=2 б=2 с=2 программа вырубается! а если вводиш все разные числа например а=1 б=2 с=3 то программа щитает все без "б"

помогите пожалуйста


Код проги таков
program func;
uses CRT;
var a,b,x,y:real;
begin
writeln('vvedite a,b,x:');
readln(a,b,x);
y:=exp(arctan(a*b)-ln(8*x-a)/ln(10))/(sqrt(abs((x-a)/(x-b)))-(x*x-a*exp(1/3)));
writeln ('y=',y:3:5);
readln;
end.


вот фото самого примера! Мне сказали надо предусмотреть деление на 0. Помогите дописать недостающую часть программы!

вот картинка примера!
 

Вкладення

Зверху