Доброго всем времени суток. Прошу прощения за топик в стиле "ночика", но мне реально надо хелп.. короче говоря, задали нам на практике 3 лабы.. задания приведены ниже вместе с теми вариантами их решения, которые смог придумать я.. сам я не могу понять, почему они программы не работают, поскольку я больше программирую на С++.. Но я начинающий программист, поэтому, не все могу сам решить.. спасибо заранее за помощь..

Задача 1
Лежит ли треугольник АВС, заданный координатами своих вершин на плоскости в области пересечения двух окружностей: (x-a1)*(x-a1) - (y-b1)*(y-b1) = r1*r1; (x-a2)*(x-a2) - (y-b2)*(y-b2) = r2*r2?

мой вариант решения:

Код

program TRIKUTNIK; uses Crt; var    R1,R2,m1,n1,m,n,a1,b1,a2,b2,c1,c2,a3,b3,z1,z2,z3,z4,z5,z6:real; begin      clrscr;      textcolor(GREEN);      writeln('Vvedite koordinati centra 1-go kruga ');      readln(m,n);      writeln('Vvedite koordinati centra 2-go kruga ');      readln(m1,n1);      writeln('Vvedite radius 1-go kruga');      readln(R1);      writeln('Vvedite radius 2-go kruga');      readln(R2);      writeln('Vvedite cherez probil koordinatu wershin trikutnika ');      writeln(' "x" "y" pershoji wershini');      readln(a1,b1);      writeln(' "x" "y" drugoji  wershini');      readln(a2,b2);      writeln(' "x" "y" tretoji  wershini');      readln(a3,b3);      z1:=sqrt(sqr(a3-m1)-sqr(b3-n1));      z2:=sqrt(sqr(a2-m1)-sqr(b2-n1));      z3:=sqrt(sqr(a1-m1)-sqr(b1-n1));      z4:=sqrt(sqr(m-a1)-sqr(n-b1));      z5:=sqrt(sqr(m-a2)-sqr(n-b2));      z6:=sqrt(sqr(m-a3)-sqr(n-b3));      if (z1<R1) or (z2<R1) or (z3<R1) or (z4<R2) or (z5<R2) or (z6<R2) then         writeln('Trikutnik legit v oblasti peretinu kil')      else          writeln('Ne legit v oblasti peretinu kil');      readln; end.

Задача 2
В масиве А(l), все элементы которого разные, найти и удалить n наименьших элементов, "сжимая" масив к началу и сохраняя порядок следования других элементов (n << l).

мой вариант решения:

Код

program stysnennja; uses crt; var    n,s,i,k,j,g,l,b,r,y:integer;    a:array[0..100] of integer; begin      clrscr;      randomize;      writeln('Vvedite koli4estvo elementov v massive');      readln(n);      for l := 1 to n do      begin           a[l] := random(100);           write(a[l],' ');      end;      writeln;      writeln('Vvedite koli4estvo minimalnyj 4lenov, kotorye nuzhno udalit');      readln(b);      s := 0;      for r := 1 to b do      begin           for i := 1 to n do           begin                for k := 1 to n do                begin                     if a[i] < a[k] then                     begin                             s := s + 1;                     end;                     if s = n then                end;                j := i;                for g := i+1 to n do                begin                     a[j] := a[g];                     j := j + 1;                end;                {a[n] := 0;}           end;      end;      for y := 1 to n-b do      begin           write(a[y],' ');      end;      readln; end.

Задача 3
Для заданного m получить таблицу первых m простых чисел.

мой вариант решения:

Код

program prosti_chisla; uses crt; var    a,b,c,d,e,f,g,m: integer; begin      clrscr;      textcolor(LIGHTBLUE);      writeln('Vvedite koli4estvo prostyh 4isel: ');      readln(m);      writeln;      b := 1;      c := b mod 2;      d := b mod 3;      e := b mod 5;      f := b mod 7;      for a := 1 to m do      begin           if b <= 2 then           begin                if c = 0 then                begin                     write(b,' ');                     b := b + 1;                end                else                begin                    b := b + 1;                    write(b,' ');                end;           end;           if b <= 3 then           begin                if c = 0 then                begin                     if d = 0 then                     begin                          write(b,' ');                          b := b + 1;                     end                     else                     begin                          b := b + 1;                          write(b,' ');                     end;                end;           end;           if b <= 5 then           begin                if c = 0 then                begin                     if d = 0 then                     begin                          if e = 0 then                          begin                               write(b,' ');                               b := b + 1;                          end                          else                          begin                               b := b + 1;                               write(b,' ');                          end;                     end;                end;           end;           if b <= 7 then           begin                if c = 0 then                begin                     if d = 0 then                     begin                          if e = 0 then                          begin                               if f = 0 then                               begin                                    write(b,' ');                                    b := b + 1;                               end                               else                               begin                                    b := b + 1;                                    write(b,' ');                               end;                          end;                     end;                end;           end;           if b >= 8 then           begin                if c = 0 then                begin                     if d = 0 then                     begin                          if e = 0 then                          begin                               if f = 0 then                               begin                                    write(b,' ');                                    b := b + 1;                               end                               else                               begin                                    b := b + 1;                                    write(b,' ');                               end;                          end;                     end;                end;           end;      end;      readln; end.[s]

Nurik вторая и тертья задачи были написаны абсолютно неправильно.
А с первой я тебе помогу.
Тут тебе нужно исправить строку

Код

if (z1<R1) or (z2<R1) or (z3<R1) or (z4<R2) or (z5<R2) or (z6<R2) then

Во-первых, здесь везде нужно заменить or на and. Также советую заменить < на <=. По-моему, так будет правильнее.

Во второй просто напиши функцию, получающую масив и индекс, который необходимо удалить, "подтянув" таким образом массив которая будет ПОДТЯГИВАТЬ массив. Находи мин. число и подтягивая с помощью функции

То есть был
7,4,6,5
, стал
7,6,5

Задача 3.
Вот тока в упор не помню считается ли 1 простым числом ...

Код

const     m = 100; var     pr: array [1..m] of LongInt;     i, j, count: Integer; begin     pr[1] := 1;     count := 1;     i := 2;     while count <= m do     begin         j := 2;         while (j <> i) and (i mod j <> 0) do             Inc(j);         if j = i then         begin             Inc(count);             pr[count] := i;         end;         Inc(i);     end;     for i := 1 to count do         Write(pr[i]:5);     Readln; end.

Спасибо большое. Первую я уже переделал, нашел там еще одну ошибку. Вторую нужно еще сделать, а за третюю ОГРОМНОЕ спасибо.

Надоело учить FASM ... решил расслабица ...
Задача 2.

Код

var     Mas: array [1..100] of Integer;     i, j, count: Integer;     n, m: Integer;     min: Integer; begin     Randomize;     Write('BBeDuTe k0JIu4ecTB0 3JIeMeHT0B MaccuBa > ');     Readln(m);     Writeln('MaccuB D0 yDaJIeHu9I');     for i := 1 to m do     begin         repeat             j := Random(3 * m) + 1;             count := 1;             while (Mas[count] <> j) and (count <= i) do                 Inc(count);         until count > i;         Mas[i] := j;         Write(Mas[i]: 5);     end;     Writeln;     repeat         Write('BBeDuTe k0JIu4ecTB0 yDaJI9IeMbIx MuHuMaJIbHbIx 3JIeMeHT0B > ');         Readln(n);     until n <= m;     for i := 1 to n do     begin         min := Mas[1];         for j := 1 to m do         begin             if Mas[j] < min then             begin                 min := Mas[j];                 count := j;             end;         end;         for j := count to m - 1 do             Mas[j] := Mas[j + 1];         Dec(m);     end;     Writeln('MaccuB n0cJIe yDaJIeHu9I');     for i := 1 to m do         Write(Mas[i]: 5);     Readln; end.

Огромное спасибо всем! у меня щас осталась еще одна лаба.. кину ее задание тут, бо как решать я не шарю.. это уже 4 задачка.. все эти три я сдал.. пасиб..

Задача 4.
Для двух заданных матриц А(n,n) и В(n,n) проверить, можно ли получить вторую из первой используя конечное количество операций транспонирования относительно главной и побочной диагоналей.

Если кто шарит в матрицах - плиз, напишите как решать задачу.. если мона, с комментами.. чтобы легче понять было де что.. заранее спасибо..

Nurik прочитайте пожалуйста правила форума: http://forum.vingrad.ru/index.php?s=&act=SR&f=27

В этой теме вы уже неоднократно их нарушили.

один топик - один вопрос.
название темы должно отражать ее суть!

И в следующий раз я темы, в которых тупо просят решить домашнее задание, буду просто закрывать.

Это сообщение отредактировал(а) Fedor - 31.5.2005, 07:50

Nurik ты б хотя бы сам написал, что такое оперция транспонирования. А то самому стало интересно.

Хехе ... вышмат, вышмат ... никада не любил ..
А транспанирование это типа когда в матрице каждый i,j элемент меняеца местами с j,i ...
тоесть a(i,j) = a(j,i) и наоборот ...
было ...
1 2 3
4 5 6
7 8 9
стало ...
1 4 7
2 5 8
3 6 9

Код

const     n = 5; type     Matrix = array [1..n, 1..n] of Integer; var     a, b, tmp_m: Matrix;     i, j: Integer;     tmp: Integer; procedure WriteMatrix(m: Matrix); begin     for i := 1 to n do     begin         for j := 1 to n do             Write(m[i, j]: 4);         Writeln;     end; end; function cmpMatrix(m1, m2: Matrix): Boolean; begin     cmpMatrix := True;     for i := 1 to n do         for j := 1 to n do             if m1[i, j] <> m2[i, j] then             begin                 cmpMatrix := False;                 Break;             end; end; procedure MainDiagTransp(var m: Matrix); begin     for i := 1 to n do         for j := 1 to i - 1 do         begin             tmp := m[i, j];             m[i, j] := m[j, i];             m[j, i] := tmp;         end; end; procedure SideDiagTransp(var m: Matrix); begin     for i := 1 to n do         for j := 1 to n - i do         begin             tmp := m[i, j];             m[i, j] := m[n - j + 1, n - i + 1];             m[n - j + 1, n - i + 1] := tmp;         end; end; begin     Randomize;     for i := 1 to n do         for j := 1 to n do         begin             a[i, j] := Random(n) + 1;             b[i, j] := Random(n) + 1;         end;     Writeln('MaTpuu,a A');     WriteMatrix(a);     Writeln;     Writeln('MaTpuu,a B');     WriteMatrix(b);     Writeln;     if not(cmpMatrix(a, b)) then     begin         tmp_m := a;         MainDiagTransp(tmp_m);         if not(cmpMatrix(tmp_m, b)) then         begin             SideDiagTransp(a);             if not(cmpMatrix(a, b)) then             begin                 MainDiagTransp(a);                 if not(cmpMatrix(a, b)) then                     Writeln('HeB03M0>KH0!')                 else                 begin                     Writeln('B03M0>KH0 >');                     Writeln('MaTpuu,y Hy>KH0 TpaHcnaHup0BaTb n0 0DH0My pa3y ');                     Writeln('0TH0cuTeJIbH0 I`JIaBH0u~ u n0604H0u~ DuaI`0HaJIeu~');                 end;             end             else             begin                 Writeln('B03M0>KH0 >');                 Writeln('MaTpuu,y Hy>KH0 TpaHcnaHup0BaTb 0TH0cuTeJIbH0 n0604H0u~ DuaI`0HaJIu');             end;         end         else         begin             Writeln('B03M0>KH0 >');             Writeln('MaTpuu,y Hy>KH0 TpaHcnaHup0BaTb 0TH0cuTeJIbH0 I`JIaBH0u~ DuaI`0HaJIu');         end     end     else         Writeln('MaTpuu,u paBHbI!');     Readln; end.

2Fedor
Ты очень не внимательно читал мой пост. Если ты видишь в нем только просьбу решить за меня домашнее задание - ты плохой модератор. Я попросил подсказать мне, где в моих вариантах решения ошибка. Так вышло, что это мое домашнее задание. А допустим тебе дадут на работе задание написать прогу и ты будешь советоваться, а админы тебе скажут, мол, забаним, бо ты просишь, чтобы за тебя решили.

Я пришел сюда просить совета и помощи, а не упрашивать кого-то решить за меня. Спасибо всем, кто ответил, я все уже сдал и защитил. Пригодилось только одно решение, но за другие тоже спасибо. Варианты учту и в будущем буду использовать.

А теперь, Федор, можешь банить и закрывать / удалять пост.
Добавлено @ 15:10
Хотя да. Я попросил помочь мне решить одну задачу. С матрицами. Я не виноват, что я в них нифига не шарю. Нам их преподавали два месяца и научили нас только тому, что это такое и как его записывать. И было это так давно, что я уже не помню. Так что я и попросил помощи.