Нужна помощь в паскале.

[Gek]

!!! Привет всеМ !!!

Моя проблема заключается в следующем
я ламер в паскале так уж довелось что нас в школе ничему не научили...
теперьже кода я в универе с меня требуют.....

Наш препод берет все задачи с http://borlpasc.narod.ru
http://borlpasc.narod.ru/docym/metpas/kr1.htm
http://borlpasc.narod.ru/docym/metpas/kr2.htm
http://borlpasc.narod.ru/docym/metpas/kr3.htm
.................................................. .........................
(мой вариант 14)
Итого их семь

две из них я с горем пополам решил.

КТО НИТЬ ЗНАЕТ ГДЕ ЕСТЬ РЕШЕНИЯ НА ЭТИ ЗАДАЧИ???

[xaIRu[s]]

14 решал сам, проверте

Program z14;
var x,a,b:integer
begib
Writeln ('Введите первое число');
readl(a);
Writeln ('Введите второе число');
readln(b);
IF a>b then
           x:=(a/b)+1;
writeln ('Введеные значения совпадают условию a>b');
writeln ('Ответ равен',x);

IF a=b then
           x:=-2;
writeln ('Введеные значения совпадают условию a=b');
writeln ('Ответ равен',x);

IF a<b then
          x&#58;=&#40;a-b&#41;/a;
writeln &#40;'Введеные значения совпадают условию a<b'&#41;;
writeln &#40;'Ответ равен',x&#41;;
readln;
end.

ЗЫ Надо проверять, хз но по такому принципу работать будет

[Дюша]

Хаирус ботанег

[Gek]

Первую и вторую я решил!

program lab2var14;
uses CRT;
Label L1;
var a,d,X:real;
begin
ClrScr;
writeln('     |a/d+1,  Esli a>d');
writeln('   X=|-2,     Esli a=d');
writeln&#40;'     |&#40;a-d&#41;/a Esli a<d'&#41;;
L1&#58;
writeln&#40;'Vvedite a'&#41;;
readln&#40;a&#41;;
writeln&#40;'Vvedite d'&#41;;
readln&#40;d&#41;;
if &#40;a<>round&#40;a&#41;&#41; or &#40;d<>round&#40;d&#41;&#41; then
 begin
 writeln&#40;'a ili b ne tseloe'&#41;;
 goto L1;
 end
else;
if a>d then
begin
if d=0 then
  begin
  writeln&#40;'Znamenatel =0'&#41;;
  goto L1;
  end
  else X&#58;=a/d+1;
 end
 else;
if a=d then X&#58;=-2 else;
if a<d then
begin
if a=0 then
  begin
  writeln&#40;'Znamenatel =0'&#41;;
  goto L1;
  end
  else X&#58;=&#40;a-d&#41;/a;
  end;
writeln&#40;'Pri a= ',a,' i ',' d= ',d,' znachenie funkcii ',X&#58;8&#58;3&#41;;
readln;
end.

[xaIRu[s]]

Видать я смысл не понял ))

[xELos]

Я в свое время занял 2-ое место по городу в олемпиаде ... ))

[yage]

Сообщение от Gek

Первую и вторую я решил!

Третья задача, 14-ый вариант

program lab3v14;

uses Crt;

const
  n = 20;

var
  A: array[1..n] of Integer;

procedure FillArray;
var
  i: Integer;
begin
  WriteLn('Reference array:');
  Randomize;
  for i:= 1 to n do
    begin
      A[i]:= 32767 - Random(65535);
      WriteLn(A[i]);
    end;
end;

procedure GetSum(Mas: array of Integer);
var
  Res: Real;
  i: Integer;
begin
  Res:= 0;
  WriteLn('Negative elements:');
  for i:= 0 to n-1 do
    if Mas&#91;i&#93;< 0 then
      begin
        WriteLn&#40;Mas&#91;i&#93;&#41;;
        Res&#58;= Res + &#40;&#40;-1&#41;*Exp&#40;3*Ln&#40;Abs&#40;Mas&#91;i&#93;&#41;&#41;&#41;&#41;;
      end;
  WriteLn&#40;'Result&#58;'&#41;;
  WriteLn&#40;Res&#41;
end;

begin
  ClrScr;
  FillArray;
  GetSum&#40;A&#41;;
  WriteLn&#40;'Press "enter" to exit...'&#41;;
  ReadLn
end.

[Capri]

Сообщение от xELos

Я в свое время занял 2-ое место по городу в олемпиаде ... ))

Явно не по русского езыгу.

[Gek]

В задаче:
Исходные данные задать самостоятельно, учитывая формат элементов массива A.

Program lab3var14;
uses CRT;
var i,n:integer;
    s:real;
 A:array [1..20] of integer;
begin
  write('Vvedite razmer massiva ');
  readln (n);
   for i:=1 to n do
    begin
     write('a[',i,']=');
     readln(a[i]);
    end;
 ..........................
             .............................
end.

вроде так незнаю чё делать.......

[yage]

Сообщение от Gek

В задаче:
Исходные данные задать самостоятельно, учитывая формат элементов массива A.

Program lab3var14;
uses CRT;
var i,n:integer;
    s:real;
 A:array [1..20] of integer;
begin
  write('Vvedite razmer massiva ');
  readln (n);
   for i:=1 to n do
    begin
     write('a[',i,']=');
     readln(a[i]);
    end;
 ..........................
             .............................
end.

вроде так незнаю чё делать.......

Ну если тебя не устраивает заполнение случайными числами типа Integer, то можно воспользоваться такой процедурой (считаю, что массив задан глобальной переменной A: array[1..20] of Integer):

procedure FillArrayManually;
var
  n: Integer;
  i: Integer;
  tmp: Longint;
  flag: Boolean;
begin
  flag:= True;
  while flag do begin
    Write('Enter array length from 1 to 20: ');
    ReadLn(n);
    if &#40;n<1&#41; or &#40;n>20&#41; then WriteLn&#40;'Incorrect array length, try again'&#41;
      else flag&#58;= False;
  end;
  for i&#58;= 1 to n do begin
    flag&#58;= True;
    while flag do begin
      Write&#40;'Enter A&#91;', i, '&#93;&#58; '&#41;;
      ReadLn&#40;tmp&#41;;
      if &#40;tmp< -32768&#41; or &#40;tmp> 32767&#41; then WriteLn&#40;'Incorrect number, try again'&#41;
        else
          begin
            A&#91;i&#93;&#58;= tmp;
            flag&#58;= False;
          end;
    end;
  end;
end;

[Gek]

Спасибо РАБОТАЕТ!!!

program lab3v14;
uses Crt;
const
  n = 20;
var
  A: array[1..n] of Integer; 
procedure FillArrayManually;
var
  n: Integer;
  i: Integer;
  tmp: Longint;
  flag: Boolean;
begin
  flag:= True;
  while flag do begin
    Write('Enter array length from 1 to 20: ');
    ReadLn(n);
    if &#40;n<1&#41; or &#40;n>20&#41; then WriteLn&#40;'Incorrect array length, try again'&#41;
      else flag&#58;= False;
  end;
  for i&#58;= 1 to n do begin
    flag&#58;= True;
    while flag do begin
      Write&#40;'Enter A&#91;', i, '&#93;&#58; '&#41;;
      ReadLn&#40;tmp&#41;;
      if &#40;tmp< -32768&#41; or &#40;tmp> 32767&#41; then WriteLn&#40;'Incorrect number, try again'&#41;
        else
          begin
            A&#91;i&#93;&#58;= tmp;
            flag&#58;= False;
         end;
    end;
  end;
end;
procedure GetSum&#40;Mas&#58; array of Integer&#41;;
var
Res&#58; Real;
i&#58; Integer;
begin
  Res&#58;= 0;
  WriteLn&#40;'Negative elements&#58;'&#41;;
  for i&#58;= 0 to n-1 do
    if Mas&#91;i&#93;< 0 then
      begin
        WriteLn&#40;Mas&#91;i&#93;&#41;;
        Res&#58;= Res + &#40;&#40;-1&#41;*Exp&#40;3*Ln&#40;Abs&#40;Mas&#91;i&#93;&#41;&#41;&#41;&#41;;
      end;
  WriteLn&#40;'Result&#58;'&#41;;
  WriteLn&#40;Res&#41;
end;
begin
  ClrScr;
  FillArrayManually;
  GetSum&#40;A&#41;;
  WriteLn&#40;'Press "enter" to exit...'&#41;;
  ReadLn
end.

Только есть интересный момент
ответ выдает как:
...........
-1
-2
-3
-4
Result:
-1.0000000000E+02
.........

Как это убрать?

[yage]

Сообщение от Gek

ответ выдает как:
...........
-1
-2
-3
-4
Result:
-1.0000000000E+02
.........

Как это убрать?

А в каком виде надо ответ? Если список отрицательных элементов не нужен (я его только для проверки выводил) убери строчки
WriteLn('Negative elements:');
и
WriteLn(Mas[i]);
из процедуры GetSum

[Gek]

-1.0000000000E+02
-100

[yage]

Сообщение от Gek

-1.0000000000E+02
-100

Вообще у тебя в условии задачи написано, что для четырнадцатого варианта ответ должен быть вещественным числом. Но если так уж надо целое, то измени чуть-чуть процедуру GetSum

procedure GetSum(Mas: array of Integer);
var
  Res: Real;
  i: Integer;
  Res_Out: Longint;
begin
  Res:= 0;
  WriteLn('Negative elements:');
  for i:= 0 to n-1 do
    if Mas&#91;i&#93;< 0 then
      begin
        WriteLn&#40;Mas&#91;i&#93;&#41;;
        Res&#58;= Res + &#40;&#40;-1&#41;*Exp&#40;3*Ln&#40;Abs&#40;Mas&#91;i&#93;&#41;&#41;&#41;&#41;;
      end;
  Res_Out&#58;= Trunc&#40;Res&#41;;
  WriteLn&#40;'Result&#58;'&#41;;
  WriteLn&#40;Res_Out&#41;
end;

[Gek]

а как ещё ОДЗ влепить на целые числа

(tmp<>round(tmp))

не работает.

[yage]

Сообщение от Gek

а как ещё ОДЗ влепить на целые числа

не работает.

Будь добр, поясни мысль, я как то слабо понял, что на этот раз не так? Если тебе надо было вывести целое число в ответе, то чем не устраивает последний, предложенный мной, вариант?

(tmp<>round(tmp))

А это что еще такое???

[Gek]

эт если водишь 1.5 прогу выкидывает...

во второй задаче я делал так:

............
writeln('Vvedite a');
readln(a);
writeln('Vvedite d');
readln(d);
if &#40;a<>round&#40;a&#41;&#41; or &#40;d<>round&#40;d&#41;&#41; then
 begin
 writeln&#40;'a ili b ne tseloe'&#41;;
 goto L1;
 end 
............

из задания:

Задав одномерный массив целочисленных данных А

[yage]

Сообщение от Gek

эт если водишь 1.5 прогу выкидывает...

во второй задаче я делал так:

............
writeln('Vvedite a');
readln(a);
writeln('Vvedite d');
readln(d);
if &#40;a<>round&#40;a&#41;&#41; or &#40;d<>round&#40;d&#41;&#41; then
 begin
 writeln&#40;'a ili b ne tseloe'&#41;;
 goto L1;
 end 
............

из задания:

Ясно... обновляй процедуру FillArrayManually

procedure FillArrayManually;
var
  n: Integer;
  i: Integer;
  tmp: Real;
  flag: Boolean;
begin
  flag:= True;
  while flag do begin
    Write('Enter array length from 1 to 20: ');
    ReadLn(n);
    if &#40;n<1&#41; or &#40;n>20&#41; then WriteLn&#40;'Incorrect array length, try again'&#41;
      else flag&#58;= False;
  end;
  for i&#58;= 1 to n do begin
    flag&#58;= True;
    while flag do begin
      Write&#40;'Enter A&#91;', i, '&#93;&#58; '&#41;;
      ReadLn&#40;tmp&#41;;
      if &#40;tmp<>Round&#40;tmp&#41;&#41; or &#40;tmp< -32768&#41; or &#40;tmp> 32767&#41; then WriteLn&#40;'Incorrect number, try again'&#41;
        else
          begin
            A&#91;i&#93;&#58;= Round&#40;tmp&#41;;
            flag&#58;= False;
          end;
    end;
  end;
end;

Надеюсь проверку от ввода не числовых данных делать от вас не требуют?

[Gek]

Фуф ели ка отчитал эту работу.
ему не понравилась формула ((-1)exp(3*ln(abs(x)))=... , пришлось переделывать (x*x*x)....

теперь хоть знаю ка со степенями работать........!

ЦЕЛЬ РАБОТЫ. Задав двумерный массив вещественных данных (матрицу А), реализовать его обработку, как указано в варианте. Исходные данные задать самостоятельно, учитывая специфику задачи.

В программе должны быть предусмотрены процедуры ввода-вывода элементов массива А и его обработки

Найти сумму всех ее элементов и заменить ею все диагональные элементы этой матрицы.

Program LAB4v14;
 var a:array [1..10,1..10] of integer;
 i,j,n,k:integer;
begin
write('n=');
readln(n);
for i:=1 to n do
 for j:=1 to n do
  readln(a[i,j]);
writeln('Bila vvedina matrica:');
for i:=1 to n do
begin
  for j:=1 to n do
     write(a[i,j]);
     writeln;
end;
.................................

что дальше делать???

[yage]

Сообщение от Gek

что дальше делать???

Ну допустим, что сумма это переменная Sum

for i:= 1 to n do
  for j:= 1 to n do
    Sum:= Sum + A[i,j];

У диагональных элементов (я так понимаю нужна только главная диаглналь) i=j, следовательно

for i:= 1 to n do A[i,i]:= Sum;

[Gek]

Доделал......

Program Lab4v14;
Uses CRT;
 Var
 a:array [1..10,1..10] of real;
 i,j,n: integer;
 y,q,w,s:real;
begin
 writeln ('Zadanie:');
 writeln ('naiti symmy elementov matrici i zamenit eyu vse diagonalnie elementi');
 writeln ('');
 write ('vvedite razmer matrici, A=');
 read (n);
  randomize;
   for i:=1 to n do
     begin
       for j:=1 to n do
       begin
         A[i,j]:=random(10)-random(10);
       end;
     end;
  s:=0;
  for i:=1 to n do
  for j:=1 to n do
   if j>i then
   s:=s+a[i,j];
  w:=0;
  for i:=1 to n do
  for j:=1 to n do
   if j<i then
   w&#58;=w+a&#91;i,j&#93;;
  q&#58;=0;
  for i&#58;=1 to n do
  for j&#58;=1 to n do
   if j=i then
   q&#58;=q+a&#91;i,j&#93;;
   ClrScr;
   writeln&#40;'matrica A'&#41;;
  for i&#58;=1 to n do
  begin
   for j&#58;=1 to n do
   write&#40;a&#91;i,j&#93;&#58;8&#58;0,' '&#41;;
   writeln
  end;
 readln;
 writeln;
 readln;
 ClrScr;  &#123;<==для наглядности это можно убрать&#125;
   y&#58;=q+w+s;
   for i&#58;=1 to n do
  for j&#58;=1 to n do
   if j=i then
   a&#91;i,j&#93;&#58;=y;
    y&#58;=q+w+s;
   for i&#58;=1 to n do
  for j&#58;=1 to n do
   if i+j-1=N then
   a&#91;i,j&#93;&#58;=y;
   y&#58;=N;
    for i&#58;=1 to n do
  begin
   for j&#58;=1 to n do
   write&#40;a&#91;i,j&#93;&#58;8&#58;0,' '&#41;;
   writeln
  end;
  Writeln;
  Readln;
 end.

Осталось последнее.

на плоскости X,Y. (10х10) построить треугольник.
X1,Y1; X2,Y2; X3,Y3.

1. Через процедуру M-Вычислить длину и проверить, можно ли построить треугольник.
2. Через функцию S-вычислить площадь.
3. M и S поместить в Unit (модуль).

[Gek]

Закройте тему..........!