халява, или кому чем поделиться не жалко

[Екатерина Брунова]

Нет, это не алгоритм, это программа рассчитывающая детерминант матрицы. Так что пришлось на рапидшару ее залить, загрузить, чтоб можно было скачивать. А то так писать в разделе "Код" на Паскале - очень длинно и сложно. А так не листинг, а готовая прога.

[somewhere]

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

[annihilator]

Ребята, вот вам еще одна халява. Я написала программы вычисления детерминанта квадратных матриц. Скачать исходники можно здесь.

Код: Выделить всё

program determinantor;
var
     a11,a12:real;
     a21,a22:real;
     d:real;
begin
     writeln('*Vychislenije opredelitelja vtorogo porjadka*');
     writeln('Vvedite znachenija koeffitsientov pervoj stroki i nazmite <Enter> ');
     readln(a11,a12);
     writeln('Vvedite znachenija koeffitsientov vtoroj stroki i nazmite <Enter>');
     readln(a21,a22);
     d:=a11*a22-a12*a21;
        writeln('Opredelitel sistemy');
        writeln('d=', d:3:2);
     writeln('Programma zavershila rabotu.');
     writeln('Nazmite <Enter>');
     readln;
end.

Код: Выделить всё

program determinantor3;
var
     a11,a12,a13:real;
     a21,a22,a23:real;
     a31,a32,a33:real;
     d:real;
begin
     writeln('*Vychislenije opredelitelja tretjego porjadka*');
     writeln('Vvedite znachenija koeffitsientov pervoj stroki i nazmite <Enter> ');
     readln(a11,a12,a13);
     writeln('Vvedite znachenija koeffitsientov vtoroj stroki i nazmite <Enter>');
     readln(a21,a22,a23);
     writeln('Vvedite znachenija koeffitsientov tretej stroki i nazmite <Enter>');
     readln(a31,a32,a33);
     d:=a11*a22*a33-a11*a23*a32+a12*a23*a31-a12*a21*a33+a13*a21*a32-a13*a22*a31;
        writeln('Opredelitel sistemy');
        writeln('d=', d:3:2);
     writeln('Programma zavershila rabotu.');
     writeln('Nazmite <Enter>');
     readln;
end.

Код: Выделить всё

program determinantor4;
var
     a11,a12,a13,a14:real;
     a21,a22,a23,a24:real;
     a31,a32,a33,a34:real;
     a41,a42,a43,a44:real;
     d:real;
begin
     writeln('*Vychislenije opredelitelja chetvertogo porjadka*');
     writeln('Vvedite znachenija koeffitsientov pervoj stroki i nazmite <Enter> ');
     readln(a11,a12,a13,a14);
     writeln('Vvedite znachenija koeffitsientov vtoroj stroki i nazmite <Enter>');
     readln(a21,a22,a23,a24);
     writeln('Vvedite znachenija koeffitsientov tretej stroki i nazmite <Enter>');
     readln(a31,a32,a33,a34);
     writeln('Vvedite znachenija koeffitsientov chetvertoj stroki i nazmite <Enter>');
     readln(a41,a42,a43,a44);
     d:=a11*a22*a33*a44-a11*a23*a32*a44+a11*a24*a33*a42-a11*a22*a34*a43+
       +a11*a24*a43*a12-a11*a24*a32*a43+a12*a21*a33*a44-a12*a21*a34*a43+
       +a12*a23*a31*a44-a12*a23*a34*a41+a12*a24*a31*a43-a12*a24*a33*a41+
       +a13*a21*a32*a44-a13*a21*a34*a42+a13*a22*a31*a44-a13*a22*a34*a41+
       +a13*a24*a31*a42-a13*a24*a32*a41+a14*a21*a32*a43-a14*a21*a33*a42+
       +a14*a22*a31*a43-a14*a22*a33*a41+a14*a23*a31*a42-a14*a23*a32*a41;
        writeln('Opredelitel sistemy');
        writeln('d=', d:3:2);
     writeln('Programma zavershila rabotu.');
     writeln('Nazmite <Enter>');
     readln;
end.

рапида - зло, а копипаст рулит =)
как напишу - выложу модуль, который ищет файлы на винте по маске. Код пишется для патча (патчит базы данных программы для тестирования учащихся ASSIST).
Екатерина Брунова, может создадим ещё один раздел и назовём "исходники для студентов"? просто честно говоря я не рассчитывал, что здесь будут лежать похожие вещи, раздел изначально планировался под системное программирование. Но в любом случае огромное спасибо за внимание уделённое вопросу =)

[somewhere]

Кидайте в алгоритмы, это наиболее подходящий раздел, с названием темы соответствующим специфике задания для более удобного поиска.

[annihilator]

somewhere, я не согласен, потому что это не алгоритмы, а сэмплы. А в разделе "Алгоритмы" по умолчанию должны быть описания методик.

[annihilator]

код просматривает ярлыки, которые лежат в его корневой папке, и извлекает из ярлыков пути к экзешникам и директориям экзешников. Ну звиняйте что криво написано, зато работает...

Код: Выделить всё

{$I-}
uses dos,crt;
const
chrrudos='©жгЄҐ*Јий§екдлў*Їа®«¤¦нпзб¬ЁвмЎоср‰–“Љ…Ќѓ?™‡•љ”›‚ЂЏђЋ‹„†ќџ—‘Њ€’њЃћ';
chrruwin='йцукенгшщзхъфывапролджэячсмитьбюёЁЙЦУКЕНГШЩЗХЪФЫВАПРОЛДЖЭЯЧСМТЬБЮ';
chars='abcdefghijklmnopqrstuvwxyzQWERTYUIOPASDFGHJKLZXCVBNM!@#$%^&()_-+=~`;., \/';
disks='QWERTYUIOPASDFGHJKLZXCVBNM';
var f:file of char;
s,s1,path:string;c,rw,rd,e:boolean;
i,j:integer;
dirinfo:searchrec;
pn:string;
arr:array[1..6553]of char;


begin
findfirst('*.lnk',anyfile,dirinfo);
if ioresult=0 then
        repeat
        writeln;
        writeln(dirinfo.name);

                assign(f,dirinfo.name);
                reset(f);
                i:=1; c:=false;
                repeat
                read(f,arr[i]);
                IF (pos(arr[i-2],disks)>0)and ((arr[i-1]=':')=true)and((arr[i]='\') or (arr[i]='/'))=true
                then begin s:=arr[i-2]+':';  s1:=arr[i-2]+':';   c:=true;end;

                if pos(arr[i],chars)>0 then e:=true;
                 if pos(arr[i],chrruwin)>0 then rw:=true;
                  if pos(arr[i],chrrudos)>0 then rd:=true;

                 if ( (e=true) or (rw=true) or (rd=true) )and (c=true) then
                      begin s:=s+arr[i];
                      if rw=true then s1:=S1+chrrudos[pos(arr[i],chrruwin)] else s1:=s1+arr[i];
                      end;

                 if (i>5)and (c=true)and(arr[i-3]='.' )and (arr[i-2]='e') and (arr[i-1]='x') and (arr[i]='e') then c:=false;

                inc(i);rw:=false; rd:=false; e:=false;
                until eof(f);
                writeln(s1);
                {по итогам - в строке s лежит путь к экзешнику, а строка s1 выводит его на экран в читабельном виде}
                for i:=length(s)downto 1 do
                if s[i]='\' then break;
                path[0]:=chr(0);
                for j:=1 to i do
                path:=path+s[j];
                {ну а path содержит путь к директории экзешника}
        findnext(dirinfo);
        if ioresult<>0 then break;
        if dirinfo.name=pn then break;
        pn:=dirinfo.name;
        readln;
        until false;
end.

[Игорь Акопян]

Екатерина Брунова, при всём уважении... Я бы сказал что выкладывать exe файл - в корне не верно, ибо никто его качать не будет А вдруг вы аццкий хакер и это троян?

[C_O_D_E]

Прога на рекурсию. Вводишь основание степени и 5 степеней в которые нужно возвести это число (такие степени как -2 тож просматриваются)
Прога лично моя, нигде не содранная. я ее сдавала в качестве лаб работы на отлично

Кста, выход на ESC

[syntax='Delphi']

{Выч-ть 5 чисел х в N-ой степени}
program recyrsija;
uses crt;
var
x:real;
n,k,f,i:integer;
esc:char; rez:array[1..5] of real; res:array[1..5] of integer;
Function PoverN(n:integer;x:real):real;
begin
For i:=1 to n do
Begin
PoverN:=x*exp((n-1)*ln(x)) ;
end;
End;
begin
repeat
esc:=#27;
clrscr;
Writeln('Введите основание степени') ; textcolor(10);
readln(x); textcolor(2);
writeln('Введите значение степеней(5-ти)') ;textcolor(10);
for f:=1 to 5 do
readln(res[f]);
textcolor(05); textbackground(1);
for f:=1 to 5 do
begin
n:=res[f];
IF n>0 then
BegiN
rez[f]:=PoverN(n,x);
end
ElsE
BegiN
IF n<0 then
BegiN
rez[f]:=1/(poverN(n,x));
end
ElsE
rez[f]:=1;
end;
write(rez[f]:6:2) ; delay(65000);delay(65000);
End;
writeln;writeln;
textcolor(2); writeln;writeln;textbackground(0);
writeln('Выход на ESC') ;
esc:=readkey;
until esc=#27;
end.

[/syntax]

[somewhere]

C_O_D_E, код обрамляйте тегом [сode]ваш код[/сode], пардон за сплошную тофтологию ))))

[C_O_D_E]

Так лучше? Буду исправляться. Спасибо за замечание.