Cycles

AA=Simple nums

function Prost(inpt: integer): boolean;
var
  i: integer;
begin
  Prost := true;                   //initially res of fuck is 1
  if inpt < 2 then                 //there arent prime nums that are less then 2
    Prost := false                 //so if input val is less than 2 then res of fuct is 0
  else
    for i := 2 to inpt div 2 do    //iterante over nums from 2 to half of the input val
      if ((inpt mod i) = 0) then   //if  there isnt any remaind of division input num on present  num from iteration
        Prost := false;            //then res of func is 0
end;
function CheckAvailProst(a,b:integer):string;
var res:string;
    i:integer;
begin
  CheckAvailProst:='';              //firstly the string is empty
  for i:=a to b do                  //iterate numbers in range from minimalm inputed to maximum
    if Prost(i) then                //if present num in range is prime then 
      res:=res+i+' ';               //add to the string present value and space
  CheckAvailProst:=res;
  end;
var
  i,a,b: integer;
begin
  read(a,b);                        //read borders of range
  if CheckAvailProst(a,b)<>'' then  //if every num in range of theese nums if prime then
    writeln(CheckAvailProst(a,b))   //write result of fucnt that include string
   else
   if CheckAvailProst(a,b)='' then  //if there arent any symbols in the string then
    writeln('0');                   //write 0
end.

AB=Perfrct nums

function CheckPerf(inpt: integer): boolean;
var
  i, res: integer;
begin
  for i := 1 to inpt-1 do           //iterate all natural values less than entered-1
    if inpt mod i = 0 then          //if entered num divides on present num of loop without reminder then
      res := res + i;               //add to all prev values of result this divider
  CheckPerf:=res=inpt;              //res of fuct is true when 
end;
function WriteDivs(inpt:integer):string;
var res:string;
    i:integer;
begin
  for i:=1 to (inpt div 2) do       //iterate all natural nums less then half of entered
    if inpt mod i=0 then            //if present num is devisor of entered
      res:=res+i+' ';               //then add to result string this num and space
  WriteDivs:=res;                   //assign to the res of fuct result recieved in loop
end;
procedure ReadInput(var inpt:integer);
begin
  read(inpt);                       //read n
end;
procedure WriteIfPerf(inpt:integer);
begin
  if CheckPerf(inpt) then           //if entered num is perfect then
  	  Writeln(WriteDivs(inpt))      //write in line all devidors of this num
  	else
  	  if not(CheckPerf(inpt)) then  //if entered num isnt perfect then
  	    Writeln('0');               //Write 0
end;
var inpt:integer;
begin
	ReadInput(inpt);
	WriteIfPerf(inpt); 
end.

AC=Perfect nums 2(Slow)

function CheckPerf(inpt: longint): boolean;
var
  i, res: longint;
begin
  res:=0;
  for i := 1 to (inpt div 2) do     //iterate all natural values less than half of entered
    if inpt mod i = 0 then          //if entered num divides on present num of loop without reminder then
      res := res + i;               //add to all prev values of result this divider
  CheckPerf:=res=inpt;              //res of fuct is true when 
end;
procedure WritePerfs(inpt:longint);
var i:longint;
checker:boolean;
begin
  Checker:=false;  //firstly checekr is false
	for i:=1 to inpt do               //iterate all longint nums from 1 to inputted value
	  if CheckPerf(i)=true then       //if present num is perfect then 
       begin
          Write(i,' ');                //write this num
  	      checker:=true;                  //cheker eq 1 if theres at least on perfect num
	     end;
	 if not(checker) then                 //if there arent perfect nums then
	   write('0');                     //write 0
end;
var inpt:longint;
begin
	Read(inpt);                       //read num
  WritePerfs(inpt);                 //write all perfect nums from 1 to inputted value
end.

AD=Mastic

procedure Read4Nums(var n1,n2,n3,n4:longint);
begin
  read(n1,n2,n3,n4);  //read 4 nums
end;
procedure FindCountMethods(i1,i2,i3:longint;a,b,c,n:longint);
var i,j,k,mtd:longint;
begin
  mtd:=0;
  for i := 0 to i1 do  //repeat cycle eq weight of prod, that we can buy from 1st box
    for j := 0 to i2 do  //repeat cycle eq weight of prod, that we can buy from 2nd box
      for k := 0 to i3 do  //repeat cycle eq weight of prod, that we can buy from 3d box
        if i * a + j * b + k * c = n then  //if weight of all product we can buy matches weight of product we need to but then
          mtd := mtd + 1;  //add to number of method 1
  writeln(mtd);  //write method
end;
procedure WriteMtds(i1,i2,i3:longint;a,b,c,n:longint);
var i,j,k:longint;
begin
  for i := 0 to i1 do  //repeat cycle eq weight of prod, that we can buy from 1st box
    for j := 0 to i2 do  //repeat cycle eq weight of prod, that we can buy from 2nd box 
      for k := 0 to i3 do  //repeat cycle eq weight of prod, that we can buy from 3d box
        if i * a + j * b + k * c = n then  //if weight of all product we can buy matches weight of product we need to but then 
          writeln(i, ' ', j, ' ', k);  //write weight of product that we can bout from 1st box, 2nd box, 3d box with spaces 
end;
var
  n, a, b, c, mtd, i1, i2, i3, i, j, k: longint;

begin
  read(a, b, c, n);  //read read wheight of every type of the product and count of product, need to buy 
  mtd := 0;  //firstly num of methods eq 0
  i1 := n div a;  //weight of product from 1st box
  i2 := n div b;  //weight of product from 2nd box 
  i3 := n div c;  //weight of product from 3d box 
  FindCountMethods(i1,i2,i3,a,b,c,n);  //Find and Write count of methods that product can be distributed
  WriteMtds(i1,i2,i3,a,b,c,n);  //write this methods
end.

B=Sum of nums

function FindSum(inpt:integer):integer;    //find sum from 1 to entered num
var s,i:integer;
begin
  for i:=1 to inpt do            //n times repeating loop
      s:=s+i;                 //summ the previuos value and present
  FindSum:=s;
end;
var n:integer;
begin
  read(n);                    //read input
                              //find sum from 1 to entered num
  
  write(FindSum(n));                   //Write output  
end.  

C=Write even nums

function InptPlus2(inpt:integer):integer;
begin
  InptPlus2:=inpt+2;            //add to input value 2
end;
var n,i,outp:integer;
begin
  read(n);                      //read input
  outp:=0;              
  for i:=1 to n do              //repeat loop n times
    begin
      outp:=InptPlus2(outp);    //add to value 2
      write(outp,' ');          //write output in line
    end;
end.

D=Sqrs

procedure CountSqrsOfNumsSet(in1,in2:integer);
var i:integer;
begin
  for i:=in1 to in2 do              //count times to square and counts to square
      Writeln(i,'*',i,'=',i*i);     //write in line i^2
end;
var a,b,i:integer;
begin
  read(a,b);                        //read nums 
  CountSqrsOfNumsSet(a,b);          
end.

//x^2 = x squared = x to the power of 2 = x to the 2-nd power
//x^y = x to the power of y

E=Sum of Sqrs

function FindSumOfSqrs(in1,in2:integer):integer;
var i,outp:integer;
begin
  for i:=in1 to in2 do              //iterate over range input nums
    begin
      outp:=outp+i*i;               //add to previous output value i^i
      FindSumOfSqrs:=outp;
    end;
end;

procedure Inpt(var a,b:integer);
begin
  read(a,b);                        //read min and max values of the range
end;
procedure outp(a,b:integer);
begin
  writeln(FindSumOfSqrs(a,b));      //write result
end;
var a,b:integer;
begin
  inpt(a,b);
  outp(a,b);
end.

F=Random nums

procedure ReadNums(var a,b,count:integer);
begin
  read(a,b,count);                      //read range borders
//  readln();                    //read nums count, need to write
end;  
procedure WriteRandNums(a,b,count:integer);
var i:integer;
begin
  for i:=1 to count do              //repeat 'count' times
    Write(a+random(b-a+1),' ');     //write random num in range from a to b
end;
var count,a,b:integer;
begin
  ReadNums(a,b,count);              //read borders of range and count of nums,need to write
  WriteRandNums(a,b,count);         //write random nums with 'count' quantity
end.

G=Reamnants

var i,a,b,c,d,checker:integer;
begin
  readln(a,b);                          //read 1st 2 nums
  readln(c,d);                          //read 2nd 2 nums
  for i:=10000 to 99999 do              //iterate all 5-discharge nums
    if (i mod a=b)and (i mod c=d) then  //if present num fits all condition demands then
      begin
        Write(i,' ');                   //write this num and space
        checker:=1;                     //checker is 1
      end;
  if checker=0 then                     //if checker is 0 then there arent any nums, demand to cinditions and
    writeln('-1');                      //wrtie -1
end.

H=Divisibility

procedure VvodCh(var a, b: longint);
begin
  readln(a, b);  //read 2 nums
end;

function CheckDivOnDshcs(inp: longint): boolean;
var
  cop_inp: longint;
  res: boolean;
begin
  cop_inp := inp;  //copy inputted val
  res := true;  //assign to the logic var true value
  while (cop_inp > 0) and res do  //repeat cycle if copied val more than 0 and res is 1
    begin
      if (cop_inp mod 10) <> 0 then  //if copied num isnt ends wth 0 then
        res := (inp mod (cop_inp mod 10)) = 0  //res is 1 if division and getting remainder inputted num on last discharge of copied val isnt 0
      else  //else
        res := false;  //logic var eq 0
      cop_inp := cop_inp div 10;  //cut las discharge of copied num
    end;
  CheckDivOnDshcs := res;  //assign to the res of func last vaalue of logic var
end;

procedure WriteNumsAccordLogicF(a, b: longint);
var
  i: longint;
begin
  for i := a to b do  //iterate all nums in range from a to b
    if CheckDivOnDshcs(i) then  //if num approach all logic func demands then
      write(' ', i);  //write space and this num
end;

var
  a, b: longint;

begin
  VvodCh(a, b);  //read 2 nums
  WriteNumsAccordLogicF(a, b);  //write nums in range if then approach logic func demands
end.

I=Armstrong nums

procedure read2nums(var a, b: longint);
begin
  read(a, b);  //read 2 nums
end;
function findPower(a,b:longint):longint;
var i,res:longint;
begin
  res:=1;  //assign to the result val 1
  for i:=1 to b do  //repeat cycle b times
    res:=res*a;  //result eq itselp multiplie wth a
  findPower:=res;  //assign to the func val result var
end;
function CountNumDschs(ch: longint): longint;
var
  kol: longint;
begin
  kol:=0;  //firstly kol variable eq 0
  while ch > 0 do  //repeat cycle while inputted num more than 0
    begin
      kol := kol + 1;  //add to the kol var 1
      ch := ch div 10;  //cut the last discharge of inputted num
    end;
  CountNumDschs := kol;  //assign the the function result value kol variable
end;

function findArmst(inp: longint): longint;
var
  num, sum, copy: longint;
begin
  sum:=0;  //firsly sum eq 0
  copy := inp;  //assign to the copied var inputted val
  while inp > 0 do  //repeat cycle while inputted more than 0
    begin
      num := inp mod 10;  //assign to the num variable last discharge of inputted variable 
      sum := sum + findPower(num, CountNumDschs(copy));  //add to the sum value whole part of power num^(count of discharges)
      inp := inp div 10;  //cut the last discharge
    end;
  findArmst := sum;  //assign to the result value sum variable
end;

procedure WriteArmsNums(a, b: longint);
var
  ch: longint;
  checker: boolean;
begin
  checker:=false;
  for ch := a to b do  //iterate nums from a to b
    begin
      if findArmst(ch) = ch then  //if num is armstrong then 
        begin
          write(ch, ' ');  //write this num
          checker := true;  //checker is true
        end;
    end;
  if not(checker) then  //if checker isnt true then
    write('-1')  //write -1
end;

var
  a, b: longint;

begin
  read2nums(a, b);  //read borders of the range
  WriteArmsNums(a, b);  //write all Armstrong num in range from a to b
end.

J=Automorph Nums

procedure VvodChisel(var a, b: longint);
begin
  read(a, b); //read 2 nums
end;

function CountNumdschs(inp: longint): longint;
var
  num: longint;
begin
  num:=0;
  while inp > 0 do  //repeat cycle while inputted num not eq 0
    begin
      num := num + 1;  //add to the num variable 1
      inp := inp div 10;  //cut the last discharge of inputted nums
    end;
  CountNumdschs := num;  //assign to the function result 'num' variable value
end;

function RaiseInDecsPow(inp: longint): longint;  //
var
  pwr, i: longint;
begin
  pwr := 1;  //assign to the power variable 
  for i := 1 to CountNumdschs(inp) do  //repeat num of inputted discharges times
    pwr := pwr * 10;  //multiple power variable on 10
  RaiseInDecsPow := pwr;  //assign to the function result power variable
end;

function FindLastNumSqr(inp: longint): longint;  //
var
  pwr, i: longint;
  lastdsch: real;
begin
  pwr := inp * inp;  //assign to the power variable sqr if inputted value
  for i := 1 to CountNumdschs(inp) do  //repeat num of inputted discharges times
    begin
      lastdsch := lastdsch / 10 + (pwr mod 10) / 10;  //assign to the last discharge variable result of dividsion it on 10 plus last discharge of power value divided on 10
      pwr := pwr div 10;  //cut the last discharge of power variable
    end;
  FindLastNumSqr := trunc(lastdsch * RaiseInDecsPow(inp));  //assign to the function result whole part of result of multiplication last discharge value and 10 in power of num of discharges
end;

procedure wrtAutomorpthNums(a, b: longint);  //
var
  i: longint;
  checker: boolean;
begin
  checker:=true;  //firstly checker is true
  for i := a to b do  //iterate all nums from a to b
  begin
    if i = FindLastNumSqr(i) then  //if num is automorph then
      begin
        write(i, ' ');  //wrrite this num wth spaces
        checker := false;  //assign to the chechcer false value
      end;
  end;
  if checker then  //if checker value is true then
    write('-1');  //write -1
end;

var
  a, b: longint;

begin
  VvodChisel(a, b);  //read borders of the range
  wrtAutomorpthNums(a, b);  //write all automorph nums in range from a to b
end.

K=Even nums

procedure ReadNum(var inp:longint);
begin
  read(inp);  //read num
end;
procedure WriteNum(inp:longint);
begin
  writeln(inp);  //write num
end;
function FindNumEvenNums(inp:longint):longint;
var outp:longint;
begin
  outp:=0;  //firstly output value eq 0
  repeat  //repeat cycle until inputted num eq 0
    if (inp mod 10)mod 2=0 then  //if last discharge of inputted num is even
      outp:=outp+1;  //add to output 1
    inp:=inp div 10;  //cut the last discharge in inputted num
  until inp=0;  //end of the cycle
  FindNumEvenNums:=outp;
end;
var n,outp:longint;
begin
  ReadNum(n);   //read 1 num
  WriteNUm(FindNumEvenNums(n));  //write count of even digit in inputted value
end.

L=Sum of numerals

procedure ReadN(var inp:longint);
begin
  read(inp);    //read any num
end;
procedure WriteN(inp:longint);
begin
  writeln(inp);   //write any num
end;
procedure FindSum(inpt:longint;var outp:longint);
begin
  repeat											//start loop
      outp:=outp+(inpt mod 10); //add to output val las num of inputted val
      inpt:=inpt div 10;        //cut the last num at inputed val
    until inpt=0;  //repeat loop until inputed val eq 0
end;
var inpt,outp:longint;
begin
  readn(inpt);                 //read inputing val
  outp:=0;    //starting val eq 0
  FindSum(inpt,outp);   //find nums sum             
  Writen(outp);              //write result
end.

M=2 same numerals nearby

function CountDschargs(inpt: integer): integer;
var
  res: integer;
begin
  repeat                                      //loop cycle until input eq 0
    res := res + 1;                           //result var eq itself+1
    inpt := inpt div 10;                      //inputed valie eq it divide 10 and get rem
  until inpt = 0;                             //end of the cycle
  CountDschargs := res;                       //assign to the func value res
end;
function FindPresDscharge(inpt: integer): integer;
begin
  FindPresDscharge := inpt mod 10;            //func value eq inputed divide 10 and get rem
end;
procedure WriteYN(num: integer);
var
  FutDsch, i, res: integer;
begin
  for i := 1 to CountDschargs(num) do         //loop cycle intil input num equal 0
    begin
      FutDsch := FindPresDscharge(num);       //assign to the future discharge value last discharge
      num := num div 10;                      //cut the last discharge
      if FindPresDscharge(num) = FutDsch then //if present discharge equal future then
        res:=res+1;                           //add to checking valiable 1
    end;
  if res>0 then                               //if checking var >0 then
    Writeln('YES')                            //write YES
  else                                        //else
    writeln('NO');                            //write NO
end;
var
  inpt: integer;
begin
  read(inpt);                                 //read num
  WriteYN(inpt);                              //write yes if there're 2 same nums near
end.

N=All same numerals

procedure readNum(var inp: longint);  //
begin
  read(inp); //read num
end;

procedure checkSameNums(var res: boolean; inp: longint);  //
var
  num: longint;
begin
  res := true;  //firstly result variable eq 1
  while (inp > 0) and res do  //repeat cycle while inputted num not eq 0 and res eq 1
    begin
      num := inp mod 10;  //assign to the num variable last discharge of inputted num
      inp := inp div 10;  //cut the last discharge of inputted num
      if inp > 0 then  //if inputted num not eq 0
        if num <> (inp mod 10) then  //if num value not eq last discharge of inputted value
          res := false;  //then result value is 0
    end;
end;

procedure WriteRes(res: boolean);
begin
  if res then  //if res eq 1 then
    writeln('Yes')  //write wth line 'YES'
  else  //else
    writeln('NO');  //write in line 'NO'
end;

var
  inp: longint;
  res: boolean;

begin
  readNum(inp);  //read num
  checkSameNums(res, inp);  //check num for saming
  WriteRes(res);  //write result
end.

O=2 same numerals

procedure readNum(var inp: longint);
begin
  read(inp);  //read num
end;

procedure CompWth1Num(inp, divis: longint; var res: boolean);
begin
  while inp <> 0 do  //repeat cycle while inputted value not eq 0
    begin
      if inp mod 10 = divis then  //if last discharge of inputted num eq divisor then
        res := true;  //result is true
      inp := inp div 10;  //cut last discharge in inputted num
    end;
end;

procedure CompWthAllNum(inp: longint; var res: boolean);
var
  divis: longint;
begin
  res := false;  //firstly result value is 0
  while inp <> 0 do  //repeat cycle while inputted value not eq 0
    begin
      divis := inp mod 10;  //assign to the divisor variable last discharge of inputted value
      inp := inp div 10;  //cut the last discharge of inputted value
      CompWth1Num(inp, divis, res);  //compare inputted value with divisor
    end;
end;

procedure output(res: boolean);
begin
  if res then  //if result value is true then
    writeln('YES')  //write YES
  else  //else
    writeln('NO');  //write NO
end;

var
  inp: longint;
  res: boolean;

begin
  readNum(inp);  //read num
  CompWthAllNum(inp, res);  //compare inputted value with every discharge from inputted value
  output(res);  //reite result
end.

P=Power of 2

procedure readnum(var inp: longint);
begin
  read(inp); //read num
end;
function pwr(in1,in2:longint):longint;
var res,i:longint;
begin
  res:=1;  //firstly result eq 1
  for i:=1 to in2 do  //repeat n2 times
    res:=res*in1;  //res eq itself multiplie on in1
  pwr:=res;  //assign to the function result res value
end;
procedure writePwrs(inp: longint);  //
var
  i: longint;
begin
  if inp <= 1 then  //if input value eq or less then inputted value then
    write('0')  //write '0'
  else  //else
    for i := inp downto 1 do  //iterate all nums from inputted to 1
      if i mod 2 = 0 then  //if present num is even then
        write(' ', pwr(2, i));  //write space and 2^i
end;


var
  inp: longint;

begin
  readnum(inp);  //read num
  writePwrs(inp);  //write powers of 2 
end.

Q=More powers of 2

procedure ReadNum(var ch: longint);
begin
  read(ch);  //read num
end;

function findPwr(inp: longint): longint;
var
  i, num: longint;
begin
  num := 1;  //num eq 1
  for i := 1 to inp do  //repeat cycle inpuuted value times
    num := num * 2;  //multiplie num on 2
  findPwr := num;  //assign to the function value num value
end;

function findMaxPwr(inp: longint): longint;
var
  i, n: longint;
begin
  i := 1;  //i eq 1
  n := 0;  //n eq 0
  while i < inp do  //repeat cycle while i is less then inputted value
    begin
      i := i * 2;  //multiplie i on 2
      n += 1;  //add to n 1
    end;
  findMaxPwr := n;  //assign to the function result n value
end;

procedure WritePrevPow(inp: longint);
var
  i: longint;
  checker: boolean;
begin
  checker := true;  //firstly checker value is 1
  for i := -findMaxPwr(inp) to -1 do  //iterate all nums from -(power of inputted num) to -1
    begin
      if(i mod 2 = 0) then  //rum cycle if i is even
        if(findPwr(-i) <= inp) then  //run cycle if power of -i eq or less then inputted num
          begin
            write(' ', findPwr(-i));  //write space and power of -i
            checker := false;  //assign to the checker val 0
          end;
    end;
  if checker then  //if checker eq 1 then
    write('0');  //write '0'
end;

var
  inp: longint;

begin
  readnum(inp);  //read input num
  WritePrevPow(inp);  //write Previous Powers of inputted num
end.

R=Euclid algo

procedure Read2Nums(var n1,n2:longint);
begin
  read(n1, n2);                //read 2 values
end;
procedure WriteNodAndLoops(var n1,n2:longint);
var nod,reps:integer;
begin
  reps:=1;                    //loop repeats at least one time
  while n1 <> n2 do           //repeat loop until values become equall
    begin
      if n1 > n2 then         //if 1st inputted val is fewer then second then
        n1 := n1 - n2         //1st val is 1st val - 2nd
      else                    //else
        n2 := n2 - n1;        //2nd val is 2nd -1st
      reps:=reps+1;           //add to loop repeating value 1
    end;
  nod := n1;                  //appropriate to nod val 1st var value
  Write(nod,' ',reps);        //write nod and repeat times wth space
end;
var
  n1, n2,repeats: longint;

begin
  read2nums(n1,n2);            //read 2 nums
  WriteNodAndLoops(n1,n2);     //find NOD and how nuch loop repeats
end.

S=Modified Euclid algo

procedure readNums(var ch1, ch2: longint);
begin
  read(ch1, ch2); //read 2 nums
end;
function FindNOD(var count: longint; in1, in2: longint):longint;
begin
  count := 0;  //firstly count eq 0
  while (in1 <> 0) and (in2 <> 0) do  //repeat cycle while inputted values not eq 0
    begin
      if in1 >= in2 then  //if 1st inputted value more or eq 2nd then
        in1 := in1 mod in2  //assign to the 1st inputted value remainder of division 1st on 2nd
      else  //else
        in2 := in2 mod in1;  //assign to the 2st inputted value remainder of division 2st on 1nd
      count := count + 1;  //add to the counter variable 1
    end;
  findNOD := in1 + in2;  //assign to the function result sum of 1st and 2nd values
end;
procedure writeNod(NOD, count: longint);
begin
  writeln(NOD, ' ', count);  //write NOD, space, count of loops in finding NOD function
end;

var
  count, in1, in2, NOD: longint;
begin
  readNums(in1, in2);  //read 2 nums
  writeNod(FindNOD(count,in1,in2),count);  //Write NOD of this 2 nums and count of loops in finding NOD function
end.

T=Sum and multiplication(wthout comments)

procedure ReadNum(var inp:integer);
begin
  readln(inp);
end;
procedure Write2NumsWthSpace(in1,in2:integer);
begin
  write(in1,' ',in2);
end;
procedure FindSumNdMltp(count:integer);
var inpt,addit,mltpl,i:integer;
begin
  mltpl:=1;
  for i:=1 to count do 
    begin
      ReadNum(inpt);
      addit:=addit+inpt; 
      mltpl:=mltpl*inpt;  
    end;
  Write2NumsWthSpace(addit,mltpl);  
end;
var count:integer;
begin 
  ReadNum(count);
  FindSumNdMltp(count);
end.    

U=Sum and mutiplication to zero

procedure readNum(var inp:longint);
begin
  read(inp);    //read num
end;
procedure write2numsWthSp(n1,n2:longint);
begin
  write(n1,' ',n2);  //write results
end;
procedure FindAdditAndMltp(var addit,mltpl:longint);
var inpt:longint;
begin
  mltpl:=1; //assign to the multiplie variable 1
  addit:=0; //assign to the sum value 0
  repeat  //loop start
    readnum(inpt);  //read new input val every cycle
    addit:=addit+inpt;  //add to the sum of all values new
    if inpt<>0 then  //if input doesnt eq 0
      mltpl:=mltpl*inpt;  //multiplie new value to all previous
  until inpt=0; //repeat loop until input val eq 0
 
end;
var addit,mltp:longint;
begin
  addit:=0; mltp:=0;  //sum and multiplication val eq 0 both
  FindAdditAndMltp(addit,mltp); //write result of summing and multiplication nums
  write2numsWthSp(addit,mltp);  //write results
end.

V=Min and max

procedure readNum(var inp:longint);
begin
  read(inp);  //read num
end;
procedure FindMinAndMax(inp:longint;var min,max:longint);
begin
min:=inp;  //assign to the min value inpted 1st time
max:=inp;  //assign to the max value inpted 1st time
  repeat  //repet cycle until inputted val eq 0
    readnum(inp);  //read num
    if (inp>max) and (inp<>0) then  //if inputted val not eq 0 and it's more than max value
      max:=inp;  //then assign to the max val inputted the last time
    if (inp<min) and (inp<>0) then  //if inputted val not eq 0 and it's less than minvalue
      min:=inp;  //then assign to the min val inputted the last time
  until inp=0;  //end of the cycle
end;
procedure Write2Nums(in1,in2:longint);
begin
  write(in1, ' ',in2);  //write 2 inputted nums wth space between
end;
var inp,max,min:longint;
begin
  readnum(inp);  //read 1st num
  findMinAndMax(inp,min,max);  //find min and max values of subsequent nums(inclue 1st inputted
  Write2Nums(min,max);  //write min and max values
end.

W=Factorial

function FindFact(inpt:longint):longint;
var i,fact:longint;
begin
  fact:=1;                //initially, factorial eq 1 because we cannot multiplie 0
  for i:=1 to inpt do     //sort out all nums from 1 to n
    fact:=fact*i;         //multiplie previous num factorial and present num
  FindFact:=fact;         //assign to the func result ending var
end;
procedure readnum(var inp:longint);
begin
  read(inp);  //read num
end;
var inpt:longint;
begin
  readnum(inpt);             //read n
  write(findFact(inpt));  //write factorial of inputted num
end.

X=Power

procedure readnum(var in1,in2:longint);
begin
  read(in1,in2);  //read 2 nums
end;
function pwr(osn,pok:longint):longint;
var i,res:longint;
begin
  res:=1;  //firstly resul eq 1
  for i:=1 to pok do  //repeat power index times
    res:=res*osn;  //multiplie result and power base
  pwr:=res;
end;
var n,a:longint;
begin
  readnum(a,n);  //read base and index of power
  Writeln(pwr(a,n));  //write a^n
end.

Y=Cut on numerals

procedure ReadNum(var inp:longint);
begin
  readln(inp);  //read num
end;
procedure WriteWthSpaces(n:longint);
var dcd:longint;
begin
  dcd:=1;  //firslty num of decs eq 1
  while n div dcd div 10>0 do   //while last discharge of first dcd discharges of inputted num manre than 0 do
    dcd:=dcd*10;  //add one dischatge to dcd variable
  repeat  //repear cycle until dcd value eq 0
    Write(n div dcd mod 10,' ');  //write last discharge of first dcd discharges of inputted num and space
    dcd:=dcd div 10;  //cut last dcd discharge
  until dcd=0;  // end of the cycle
end;
var n: LongInt;
begin
  ReadNum(n);  //read num
  WriteWthSpaces(n);  // write num wth spaces
end.

Z=Fibonachi nums

procedure Write1Fib(var count, n1, n2: longint);
begin
  count := n1;              //result value is 1st inputted
  n1 := n2 + n1;            //1st inputted val is sum of 2 inputted
  n2 := count;              //assign to the 2nd val result
  write(count, ' ');        //write result and space
end;
procedure WriteFibNums(inpt:longint);
var s2,s1,i,sum: longint;
begin
  s1 := 1;                  //1st num for fibonachi procedure eq 1
  s2 := 0;                  //2nd num for fibonachi procedure eq 0
  sum := 1;                 //result of fibonachi procedure eq 1 
  for i := 1 to inpt do        //repeat cycle n times
    Write1Fib(sum, s1, s2);       //find sum for 2 values  
end;  
var
  n: longint;

begin
  read(n);                  //read input
  WriteFibNums(n);          //Write all fibonachi nums in array from 1 to n
end.