OneCompiler

TD1 Kaprekar

144

with Ada.Text_IO; use Ada.Text_IO;

procedure TD1 is

subtype Number is Natural range 0..9 ;

type Num_Tab is array (Natural range <>) of Number;

Table : Num_Tab(1..5) := (1, 2, 3, 4, 5) ; -- exemple d'un tableau

A: integer :=3;
B:integer :=4;

Num : natural := 3489 ;
Size : natural := 4 ;

procedure Put_Tab (T : in Num_Tab) is -- affichage d'un tableau

begin

  put("(") ; -- setter paranthes på start
  for Number in T'Range loop -- looper for affichage av hvert element
 put(Integer'Image(T(Number))) ; -- T(number) korresponderer til tallet i den kassa i lista
  end loop ;

  Put_Line(")") ; -- etter loopen setter vi på paranthes for å signalere slutten

end Put_Tab ;


function Num_Count(Number : in Natural) return Positive is
Quantity: Positive ; -- skal være positiv fordi det ikke kan være negativt

begin
Quantity:=1 ;

  while Number >= 10**Quantity loop --  hvis tallet er større enn 10 (når vi begynner med Q=1)
 Quantity:= Quantity + 1 ;
  end loop ;
  
  return Quantity ; -- returnerer sluttverdien til Quantity
  

end Num_Count ;

procedure Test_Num_Count (N : in Natural ; Expected : Positive) is -- N er tallet, Expected er det vi forventer som verdi for Quantity
begin
Put_Line("..........") ;
Put_Line("Number N=" & Integer'Image(N)) ;
Put_Line("Exptected......:" & Integer'Image(Expected));
Put_Line("Result from Num_Count function:" & Num_Count(N)'Image);
end Test_Num_Count ;


function get_digit(N: in positive ; Grade : positive) return positive is
Specific_Number : Positive ;
begin
Specific_Number:=1; -- bare gir en random verdi her
Specific_Number:=N/10**Grade; -- Deler for å bli kvitt tallene "bak" tallet vi egt vil ha
Specific_Number:=Specific_Number mod 10 ; --for så "resten" som er det aktuelle tallet
return Specific_Number ;
end get_digit;

procedure test_get_digit(Number : in positive) is
begin
Put_Line("................");
Put_Line("Start number"&Number'Image);
Put_Line("................");
Put_Line("The digit of interest of the first number: 3");
Put_Line("................");
Put_Line("Digit of interest with get_digit:"&get_digit(Number,2)'Image);
end test_get_digit ;


-- nå skal vi ta et tall og sette hvert individuelle tall i en kasse

Function decompose_number(N : in Natural ; size : in Natural) return Num_Tab is
Table:Num_Tab(1..Size); -- i fasiten skal det være size-1 men synes det er rart
Nb : Natural ;
begin
Nb := N;
for i in Table'Range loop -- sykt smart
Table(i):=Nb mod 10;
Nb:=Nb/10;
end loop;
return Table;
end decompose_number ;

procedure Test_decompose_Number(N : in natural ; Size : Natural) is
Tableau:Num_Tab(1..size);
begin
Tableau:=decompose_number(N,Size);
Put_Line(".......");
Put_Line("Original number we want to decompose:"&N'image);
Put("Decomposed table: ");
Put("(");
for i in Tableau'Range loop
Put(Tableau(i)'Image);
end loop;
Put_Line(")");
end Test_decompose_Number;


-- nå skal vi fra en tabell få tilbake et tall

function Recompose_Number(Tab : in Num_Tab) return Natural is -- skrevet helt selv
Number: Natural;
Counter: Natural :=1;
begin
Number:=0;
for i in Tab'Range loop
Number:=Number+Tab(i)10*(Tab'Length-Counter);
Counter:=Counter+1;
end loop;
return Number;
end Recompose_Number ;

procedure test_recompose_Number(Tab : in Num_Tab) is
begin
Put_Line(".........");
Put_Line("Table we want as a number:");
Put("(");
for i in Tab'Range loop
Put(Tab(i)'Image);
end loop;
Put_Line(")");
Put_Line("The final number from Recompose_Number:"&Recompose_Number(Tab)'Image);
end test_recompose_Number;


-- gi B verdien til a

procedure Switch_Value(A, B: in out Natural) is
Value : Natural ;
begin
Value := A ;
A:= B;
B:=Value;

end Switch_Value;

procedure Test_Switch_Value(A,B : in out Natural) is
begin
Put_Line("........");
Put_Line("Original value of A:"&A'Image);
Put_Line("Original value of B:"&B'Image);
Switch_Value(A,B);
Put_Line("........");
Put_Line("New value of A:"&A'Image);
Put_Line("New value of B:"&B'Image);

end Test_Switch_Value;

 ------------------------------------------------------------------------------
 
 -- funksjon som vender på rekkefølgen til en matrise
 
 function Mirror_Table(T : Num_Tab) return Num_Tab is --genial og vanskelig
   Mirror_Tab : Num_Tab(T'range) ; -- vi lager en ny matrise som er omvendt rekkefølge
   begin
     for i in Mirror_Tab'range loop
       Mirror_Tab(i):=T(T'first+T'last-i); -- her tar man plass 1 + plass 5= 6 men -1 
       end loop;  -- ender da opp med plass 5 som korresponderer med siste tallet
     return Mirror_Tab;
   end Mirror_Table;
   
   procedure test_Mirror_Table(T : Num_Tab) is
     X : Num_Tab(T'range) ;
   begin
     Put_Line("..........");
     Put_Line("Original table:");
     Put("(");
     for i in T'Range loop
       Put(T(i)'image);
       end loop;
       Put_Line(" )");
       Put_Line("........");
       Put_Line("New Table:");
      X:=Mirror_Table(T);
      
      Put("(");
      for i in X'range loop
        Put(X(i)'image);
        end loop;
        Put_Line(" )");
       
   end test_Mirror_Table;
   

  -- bubble sort 
  
  function sort (Table : in Num_Tab) return Num_Tab is -- spørre om hjelp til hele greia
    Resulting_Table : Num_Tab(Table'Range) ;
    Finished_Sorting : boolean;
    Last_Digit : Integer ;
  begin
    Resulting_Table := Table ;
    Finished_Sorting := False ;
    Last_Digit := Resulting_Table'Last ; -- tallet som indikerer plassen til siste element
    while Last_Digit > Resulting_Table'First and not Finished_Sorting loop
      Finished_Sorting := True ;
      
      for i in Resulting_Table'First..Last_Digit-1 loop -- første index til siste index - 1: for at vi unngår at vi sammenlikner siste index med noe som ikke er i tabellen
        if Resulting_Table(i) > Resulting_Table(i+1) then
          Switch_Value(Resulting_Table(i), Resulting_Table(i+1));
          Finished_Sorting:= False ; -- fordi vi nå er i if kondisjonen, og når den er sann må vi typ fortsette å loope
        end if;
        
      end loop;
      
      Last_Digit:=Last_Digit-1; -- denne endrer vi for å komme til neste index
    end loop;
          
    return Resulting_Table ;
  end sort;
  
  function Single_Kaprekar(Number : in natural ; Size : in Positive) return Natural is
    Result: Natural ;
    Number_1, Number_2 : Natural ;
    Ascending : Num_Tab(0..Size-1);
    Descending : Num_Tab(0..Size-1);  
    begin
      Put_Line("Original number for the algorithm:"&Number'Image);
      Ascending:=sort(decompose_number(Number, Size));
      Descending:=Mirror_Table(Ascending);
      Number_1:=Recompose_Number(Descending);
      Number_2:=Recompose_Number(Ascending);
      Put_Line("Number 1 being the number in ascending order:"&Number_2'image);
      Put_Line("Number 2 being the number in descending order:"&Number_1'image);
      Result:=Number_1-Number_2 ;
      Put_Line("Number 1 minus Number 2 gives result="&Result'Image);
      return Result ;
    end Single_Kaprekar ;
    
    ------------------------------------------------------------------------------
    
    -- nå skal vi få til å få kjørt kaprekaren flere ganger
    
    procedure Full_Kaprekar(Number_Given : Natural) is
      Number_Given1, Difference : integer ;
      Stop : boolean ;
      Size : Positive := Num_Count(Number_Given);
    begin
      Put_Line("...............................................");
      Put_Line("Kaprekar is about to be completed several times");
      Put_Line(" ");
      Put_Line("Kaprekar will begin with the number N:"&Number_Given'image);
      Put_Line(" ");
      Number_Given1:=Number_Given;
      Stop := False ;
      
      while not stop loop
        Difference:=Single_Kaprekar(Number_Given1, Size);
        Stop:=(Difference=Number_Given1);
        Number_Given1:=Difference ;
        end loop;
    end Full_Kaprekar;
    
    
    ------------------------------------------------------------------------------

begin
Put_Tab(Table);
Test_Num_Count(0,1);
Test_Num_Count(34678, 5);
test_get_digit(1321);
Test_decompose_Number(54321,5);
test_recompose_Number(Table);
Test_Switch_Value(A,B);
test_Mirror_Table(Table);
Put_Line("......................................................");
Put_Line("A single Kaprekar being tested below:");
Put_Line(Single_Kaprekar(2976, 4)'image);
Full_Kaprekar(123);
end TD1 ;