program kurs; uses crt; function pow (a,x: longint): longint; var t, i: longint; begin t: =a; for i: =1 to x-1 do t: =t*a; pow: =t; end; {pow} {----------------------------------------} procedure DelOstatok; var dd: array [1.200] of integer; R: integer; {размерность чисел} i: longint; {делитель} k: longint; {остаток} D,a,b: longint; {элементы заданного множества} SUM: longint; {кол-во эл-ов, удовл условию} S,T: byte; q: char; e,j,l,n: integer; maxa,minj,maxj: longint; begin repeat begin writeln ('введите ко-во чисел для нахождения НОК делителей'); readln (n); writeln ('введите ',n,' чисел: '); readln (dd [1]); maxa: =dd [1] ; for i: =2 to n do begin readln (dd [i]); if dd [i] >maxa then maxa: =dd [i] ; end; i: =1; while (dd [i] <>0) and (i<=n) do inc (i); if i<>n+1 then writeln ('НОК не сущ-ет') else begin e: =1; for i: =2 to maxa do begin maxj: =0; for l: =1 to n do begin j: =0; while (dd [l] mod i=0) do begin dd [l]: =dd [l] div i; inc (j); end; if (j>maxj) then maxj: =j; end; if (maxj<>0) then for l: =1 to maxj do e: =e*i; end; writeln ('НОК делителей=',e); end; end; i: =e; write ('введите остаток='); readln (k); if ( (i<=0) or (k<0)) then {проверка {вывод эл-ов на экран} end; writeln; end; writeln ('Повторить? (Y/N) '); q: =ReadKey; until q in ['N','n'] ; clrscr; end; {DelOstatok} {----------------------------------------} procedure Factor; var numb, powers: array [1. .100] of longint; c: longint; n: longint; n1,H: longint; i: longint; k,t: longint; q: char; begin repeat write ('Введите число='); readln (c); if c<=0 then {проверка на корр числа} begin writeln ('число должно быть>0'); readln; exit; end else {вывод мн-ва делителей} begin write ('мн-во делителей: D (num) ='); for H: = 1 to c do if c mod H=0 then write (H,' '); end; {конец вывода делителей} n: = 1; n1: = 0; while c <> 1 do begin i: = 2; while c mod i <> 0 do {проверка на делимостьс/без остатка} Inc (i); Inc (n1); if n1 = 1 then begin numb [n]: = i; powers [n]: = 1; end else if numb [n] = i then Inc (powers [n]) else begin Inc (n); {увеличение кол-ва простых множителей} numb [n]: = i; powers [n]: = 1; end; {while} c: = c div i; {деление числа на простой множитель} end; {while} {\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\} writeln; writeln ('кол-во простых множителей: ',n); write ('num = '); k: =1; t: =1; writeln ('НОД=',k); if k=1 then writeln ('числа взаимно простые'); end; begin i: =1; while (b [i] <>0) and (i<=n) do inc (i); if i<>n+1 then writeln ('НОК не сущ-ет') else begin d: =1; for i: =2 to maxa do begin maxj: =0; for l: =1 to n do begin j: =0; while (b [l] mod i=0) do begin b [l]: =b [l] div i; inc (j); end; if (j>maxj) then maxj: =j; end; if (maxj<>0) then for l: =1 to maxj do d: =d*i; end; writeln ('НОК=',d); end; end; end; writeln ('Повторить? (Y/N) '); q: =ReadKey; until q in ['N','n'] ; clrscr; end; {NodNok} {----------------------------------------} procedure SuperGorner; type vector= array [1. .11] of integer; rvector=array [1. .100] of real; var sum,suma: real; i,k,j,b,c,a,n: integer; vec: vector; vecb: rvector; veca: rvector; q: char; BEGIN Writeln ('Введите степень уравнения (max = 10) '); Readln (n); if n<=0 then writeln (`степень не может быть<=0') else begin Inc (n); writeln ('введите его коэффициенты: '); for i: = 1 to n do read (vec [i]); while vec [i] =0 do Begin i: =i-1; writeln ('ответ: 0'); End; k: =1; b: =vec [i] ; for j: =1 to abs (b) do begin if (b mod j) =0 then begin vecb [k]: =j; k: =k+1; procedure AntiExp; var s: array [1. .100] of integer; a,b, i,n,t: integer; q: char; begin repeat writeln ('введите кол-во эл-ов цепной дроби='); read (n); if n<=0 then writeln (`кол-во эл-ов не может быть<=0') else begin writeln ('введите значения этих эл-ов='); for i: =1 to n do read (s [i]); a: =1; b: =s [n] ; for i: = n downto 2 do begin t: =s [i-1] *b+a; a: =b; b: =t; end; writeln; writeln (b,'/',a); end; writeln ('Повторить? (Y/N) '); q: =ReadKey; until q in ['N','n'] ; clrscr; end; {AntiExp} {----------------------------------------} var k: integer; q: char; begin writeln ('Дискретная математика'); writeln ('Курсовая работа, группа 03-119, каф308'); writeln ('выполнил: Тузов И.И. '); writeln ('руководитель: Гридин А.Н. '); writeln; writeln ('Калькулятор с функциями, описанными ниже'); writeln; Writeln ('Нажмите Enter'); readln; clrscr; repeat writeln ('Какую выполнить операцию? '); writeln; writeln ('1-вычисление мн-ва N-значных чисел с заданным делителем и остатком '); writeln ('2-факторизация числа'); writeln ('3-нахождение НОД и НОК чисел'); writeln ('4-нахождение рационльных корней уравнения с целочисл коэфф'); writeln ('5-перевод рациональной дроби в цепную'); writeln ('6-перевод цепной дроби в рациональную'); read (k); | делителя и остатка на отриц-сть} begin write ('делитель или остаток не могут быть<0 '); end else begin if i>k then {проверка на делитель>остатка} begin write ('введите размерность='); readln (R); if R<=0 then begin writeln ('некорректная размерность '); readln; end else begin if R=1 then begin a: =1; b: =9; end else begin a: =pow (10, (R-1)); {инициализация верх и нижн границ} b: =pow (10,R); b: =b-1; end; end; if b<i then {проверка на делимое>делителя} writeln ('делиоме не может быть < делителя ') else begin SUM: =0; {обнуление сумы кол-ва эл-ов} for D: = a to b do begin if (D mod i) =k then {проверка эл-ов на условие} begin SUM: =SUM+1; end; end; writeln; writeln ('кол-во эл-ов с делителем=', i: 3, ' и остатком=', k: 3, ' равно', SUM: 6); end; {b<i} end {if i>k} else write ('остаток не может быть > делителя '); end; {if otriz} {\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\} write ('вывести значения на экран? (1-да\0-нет) '); readln (S); if S=1 then if SUM=0 then writeln ('нет эл-ов, удовл. условию') else begin for D: = a to b do if (D mod i) =k then begin write (' ',D: 4); {вычисление кол-ва делителей и их мн-ва} for i: = 1 to n do begin write (numb [i], ' ^ ', powers [i]); k: =k* ( (pow (numb [i],powers [i] +1) - 1) div (numb [i] - 1)); t: =t* (powers [i] +1); {кол-во делителей} if i <> n then write (' * '); end; writeln; writeln ('кол-во множителей: tau (num) =',t); writeln ('сумма множителей: sigma (num) =',k); writeln ('Повторить? (Y/N) '); q: =ReadKey; until q in ['N','n'] ; clrscr; end; {Factor} {----------------------------------------} procedure NodNok; type TArray=array [1.200] of integer; var a,b: TArray; i,l,j,maxa,minj,maxj: longint; k,d: longint; n: integer; q: char; begin repeat clrscr; writeln ('введите ко-во чисел для нахождения НОД и НОК'); readln (n); writeln ('введите ',n,' чисел: '); if n<=0 then writeln (`кол-во чисел не может быть<=0') else begin readln (a [1]); b [1]: =a [1] ; maxa: =a [1] ; for i: =2 to n do begin readln (a [i]); b [i]: =a [i] ; if a [i] >maxa then maxa: =a [i] ; end; i: =1; while (a [i] =0) and (i<=n) do inc (i); if i=n+1 then writeln ('НОД - любое число') else begin for j: =1 to n do if a [j] =0 then a [j]: =a [i] ; k: =1; for i: =2 to maxa do begin minj: =1000; for l: =1 to n do begin j: =0; while (a [l] mod i=0) do begin a [l]: =a [l] div i; inc (j); end; if (j<minj) then minj: =j; end; if (minj<>0) then for l: =1 to minj do k: =k*i; end; vecb [k]: =-j; k: =k+1; end; end; a: =1; for j: =1 to abs (vec [1]) do begin if (vec [1] mod j) =0 then begin veca [a]: =j; a: =a+1; { veca [a]: =-j; a: =a+1; } End; end; b: =a; for j: =1 to k-1 do Begin for a: =1 to b-1 do Begin Begin c: =i; sum: =0; for i: =1 to c do Begin sum: =sum+vec [i] *pow1 (vecb [j] /veca [a],c-i); if (sum<0.00001) and (sum>-0.00001) then if vec [a] =1 then writeln ('ответ: ',round (vecb [j])) else writeln ('ответ: ',round (vecb [j]), '/',round (veca [a])); end; End; End; End; end; readln; end; {SuperGorner} {----------------------------------------} procedure Express; var a,b,t: integer; q: char; begin repeat writeln ('введите числитель='); readln (a); writeln ('введите знаменатель='); readln (b); if b=0 then writeln (`знаменатель не может быть=0') else begin write (' ['); while (a mod b>0) do begin write (a div b,','); a: =a mod b; t: =b; b: =a; a: =t; end; write (a div b, '] '); end; writeln (`Повторить? (Y/N) '); q: =ReadKey; until q in ['N','n'] ; clrscr; end; {Express} {----------------------------------------} case k of 1: DelOstatok; 2: Factor; 3: NodNok; 4: SuperGorner; 5: Express; 6: AntiExp; else writeln ('нет операции'); end; {case} writeln ('Повторить выполнение калькулятора? (Y/N) '); q: =ReadKey; until q in ['N','n'] ; clrscr; readln; end. {prog} | |
