Версия для печати темы
Нажмите сюда для просмотра этой темы в оригинальном формате
Форум программистов > Object Pascal: кроссплатформенные технологии > 3 задачи


Автор: Нурик Сакура 25.5.2005, 02:00
Доброго всем времени суток. Прошу прощения за топик в стиле "ночика", но мне реально надо хелп.. короче говоря, задали нам на практике 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]

Автор: poor_yorik 27.5.2005, 23:39
Nurik вторая и тертья задачи были написаны абсолютно неправильно. smile
А с первой я тебе помогу.
Тут тебе нужно исправить строку
Код

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

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

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

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

Автор: Chrisstoff 28.5.2005, 22:35
Задача 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.

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

Автор: Chrisstoff 30.5.2005, 17:13
Надоело учить FASM smile ... решил расслабица ...
Задача 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.

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

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

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

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

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

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

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

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

Автор: Chrisstoff 1.6.2005, 17:52
Хехе ... вышмат, вышмат ... никада не любил .. smile
А транспанирование это типа когда в матрице каждый 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

Автор: Chrisstoff 1.6.2005, 21:25
Код

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.

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

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

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

Powered by Invision Power Board (http://www.invisionboard.com)
© Invision Power Services (http://www.invisionpower.com)