Решение нескольких задач

[ViNcHeStEr]

Меня друг попросил выложить здесь несколько его задач (сам не может, т.к. временно нет доступа в интернет)
=========
1) Показать, что если поменять местами два параллельных ряда определителя, то он изменит знак на противоположный.

2) Изобразить на экране решетчатую модель шара и реализовать ее перемещение.

3) Строка Т состоит из слов, разделенных двоеточиями, слова представляют собой фамилии в именительном падеже, определить, сколько фамилий мужских и сколько женских.

Язык: Паскаль

[Serge_Bliznykov]

а язык то какой?

по первой задачи ищите - вычисление определителя тут писали буквально вчера/позавчера - алгоритм такой - подсчитать определитель, поменять в матрице два ряда, опять подсчитать - вывести оба определителя (до обмена и после) на экран...

задача 2. опять таки - через поиск - хотя эта задачка не так проста, как кажется ;-(

задача 3. в общем случае - не решаема в принципе:
ибо нет достоверного алгоритма опеределения пола по фамилии (только для фамилий на -ва -ая -на можно предположить, что это женские, остальные автоматом мужские...)
А с Ли/Рабинович/Петренко/Авду/Лаврик/Либасан (реальные фамилии, сейчас из справочника взял...) и т.п. что делать?
я уже молчу про Диаз/Турман/Джадд/Альба/Стоун/Джоли... :-)

[puporev]

Я уже выкладывал две программы по определителям, но там всегда учитывалось, что при перестановке строк знак меняется и это дело устранялось. Здесь же наоборот, изменение знака не нужно учитывать.
Кстати если еще раз переставить, знак восстановится.
Вот код.

program opred;
uses crt;
type
   Tmatr=array [1..20,1..20] of real;
var n:integer;
    a,a1:Tmatr;
    det,det1:real;
    i,j,k1,k2:integer;
procedure Per(i1,i2:integer;var a:Tmatr);//перестановка двух строк
var z:real;
begin
for j:=1 to n do
   begin
     z:=a[i1,j];a[i1,j]:=a[i2,j];a[i2,j]:=z;
     end;
end;
procedure opr(n:integer;var a:Tmatr;var det:real);//собственно нахождение определителя
var k,i,j,p:integer;
    r:real;
begin
det:=1;
for k:=1 to n do
   begin
     det:=det*a[k,k];
     for j:=k+1 to n do
       begin
         r:=a[j,k]/a[k,k];
         for i:=k to n do
           begin
             a[j,i]:=a[j,i]-r*a[k,i];
           end;
       end;
   end;
end;
begin
clrscr;
write('n=');readln(n);
writeln('Ischodnaia matritsha A:');
randomize;
for i:=1 to n do
  begin
    for j:=1 to n do
      begin
        a[i,j]:=random(10)+random;
        write(a[i,j]:6:2);
      end;
  writeln;
  end;
a1:=a;
opr(n,a,det); //первый определитель
writeln('opr=',det:4:2);
writeln('Pomenjat stroki ');readln(k1,k2);
Per(k1,k2,a1); //делаем перестановку
writeln('Posle perestanovki:');
for i:=1 to n do
  begin
    for j:=1 to n do
    write(a1[i,j]:6:2);
    writeln;
  end;
opr(n,a1,det1);
write('opr=',det1:4:2);//второй определитель
readln
end.

[puporev]

Задача 3.
Как правильно подметил Serge_Bliznykov задача решается

только для фамилий на -ва -ая -на

Поэтому такой код.

uses crt;
var s:string;
    i,kz,km:integer;
begin
clrscr;
write('s: ');readln(s);
writeln;
s:=s+':';//добавим для удобства двоеточие в коце строки
kz:=0;km:=0;
for i:=1 to length(s) do
if (s[i]=':')and(s[i-1] in ['а','я'])
then kz:=kz+1
else if (s[i]=':')and not (s[i-1] in ['а','я'])
then km:=km+1;
writeln('Muzskih familij=',km,' Zenskih familij=',kz);
readln
end.

[puporev]

Сделал заготовку для второй задачи, там еще над красотой поработать надо.

uses graph,crt;
var gd,gm:integer;
    i,x,dx:integer;
procedure Paint1;
begin
Setcolor(15);
Ellipse(x,150,0,360,100,100);
Ellipse(x,150,0,360,100,70);
Ellipse(x,150,0,360,70,100);
Ellipse(x,150,0,360,100,30);
Ellipse(x,150,0,360,30,100);
Ellipse(x,150,0,360,100,10);
Ellipse(x,150,0,360,10,100);
end;
procedure Paint2;
begin
Setcolor(0);
Ellipse(x,150,0,360,100,100);
Ellipse(x,150,0,360,100,70);
Ellipse(x,150,0,360,70,100);
Ellipse(x,150,0,360,100,30);
Ellipse(x,150,0,360,30,100);
Ellipse(x,150,0,360,100,10);
Ellipse(x,150,0,360,10,100);
end;
begin
gd:=VGA;
Gm:=VGAHi;
Initgraph (gd,gm,'..\bgi');
x:=110;dx:=2;
for i:=1 to 200 do
   begin
    Paint1;
    delay(20);
    Paint2;
    x:=x+dx;
   end;
Setcolor(4);
Settextstyle(3,0,2);
OuttextXY(120,240,'VSE, BOLSHE KINA NE BUDET, ZMI ENTER!');
readln;
end.