API tools faq
paste
Advertisement
Bimbinbiribong

Kalkulacka

Bimbinbiribong
Feb 13th, 2016
59
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Pascal 29.15 KB | None | 0 0
raw download clone embed print report
  1. program zapoctovyProgram;
  2.  
  3. Uses Math;
  4.  
  5. type
  6.   PZaznam = ^TZaznam;
  7.   TZaznam = record
  8.     Znak: char;
  9.     Hodnota: real;
  10.     Dalsi: PZaznam;
  11.   end;
  12.  
  13. var
  14.   zacatek, konec: PZaznam;
  15.   Memory, ANS: real;       {ANS = vysledek posledniho vypoctu, Memory = pamet}
  16.   OFF: boolean;
  17.   pocitat: boolean;
  18.  
  19. function faktorial(n: real):real;
  20. begin
  21.   if (n = 0) then faktorial := 1
  22.   else begin
  23.        faktorial := n * faktorial(n-1);
  24.   end;
  25. end;
  26.  
  27. procedure prevedDoPostfixu(var zacatek, konec: PZaznam; var pocitat: boolean);  {predpoklad na konzoli je vypsany infix zapis vyrazu}
  28. type
  29.   PZaznamZas = ^TZaznamZas;
  30.   TZaznamZas = record
  31.     Znak: char;
  32.     Hodnota: real;
  33.     PrednostOperace: integer;
  34.     Dalsi: PZaznamZas;
  35.   end;
  36. var
  37.   z, u, v, w, k: char;
  38.   prednostOperaceZ, i, j: integer;
  39.   Hodnota, Hodnota1, Hodnota2: real;
  40.   bylaDesetinnaCarka, cetlCislo: boolean;
  41.   zacatekZas, pomocnaZas: PZaznamZas;
  42.   pomocna: PZaznam;
  43. begin
  44.   z := '#';
  45.   zacatekZas := nil;
  46.   cetlCislo := false;
  47.   new(zacatek); zacatek^.Dalsi := nil; konec := zacatek;
  48.   repeat
  49.     prednostOperaceZ := 0;
  50.     if (cetlCislo = false) then begin k := w; w := v; v := u; u := z; read(z); end;
  51.     while (z = ' ') do begin read(z); end;
  52.     cetlCislo := false;
  53.     case z of
  54.     '0', '1', '2', '3', '4', '5', '6', '7', '8', '9':
  55.     begin
  56.       Hodnota1 := 0; Hodnota2 := 0; Hodnota := 0; i := 0; j := 0; bylaDesetinnaCarka := false;
  57.     while (z = ',') or (z = '.') or (z in ['0'..'9']) do      {resi viceciferna cisla}
  58.     begin
  59.       if (z = ',') or (z = '.') then bylaDesetinnaCarka := true;
  60.       if (z in ['0'..'9']) and (byladesetinnaCarka = false) then      {vypocet cele casti cisla}
  61.       begin
  62.            Hodnota1 := Hodnota1 * 10 + (ord(z)-48);
  63.       end
  64.       else if (z in ['0'..'9']) and (byladesetinnaCarka = true) then       {vypocet desetinne casti}
  65.       begin
  66.            i := i + 1;
  67.            Hodnota2 := Hodnota2 + (ord(z)-48)/(power(10,i));
  68.       end;
  69.       k := w; w := v; v := u; u := z;                   {cteni}
  70.       read(z);
  71.     end;
  72.     Hodnota := Hodnota1 + Hodnota2;
  73.     new(pomocna); pomocna^.Hodnota := Hodnota; pomocna^.Znak := '?'; pomocna^.Dalsi := nil;
  74.     konec^.Dalsi := pomocna; konec := pomocna;
  75.     cetlCislo := true;
  76.     end;
  77.     '(':      {do zasobniku}
  78.     begin
  79.       new(pomocnaZas); pomocnaZas^.Znak := z; pomocnaZas^.PrednostOperace := 0;
  80.       pomocnaZas^.Dalsi := zacatekZas; zacatekZas := pomocnaZas;
  81.       case u of
  82.       'n':
  83.       begin
  84.         if (w = 's') and (v = 'i') then
  85.         begin
  86.              if (k = 'c') then
  87.              begin                                        {arkus sinus = K}
  88.                   new(pomocnaZas); pomocnaZas^.Znak := 'K'; pomocnaZas^.PrednostOperace := -10;
  89.                   pomocnaZas^.Dalsi := zacatekZas; zacatekZas := pomocnaZas;
  90.              end
  91.              else begin                                 {sinus reprezentuji jako S}
  92.                   new(pomocnaZas); pomocnaZas^.Znak := 'S'; pomocnaZas^.PrednostOperace := -10;
  93.                   pomocnaZas^.Dalsi := zacatekZas; zacatekZas := pomocnaZas;
  94.              end;
  95.         end
  96.         else if (w = 't') and (v = 'a') then       {tangens (tan) = T}
  97.         begin
  98.              if (k = 'c') then
  99.              begin                                        {arkus tangens = N}
  100.                   new(pomocnaZas); pomocnaZas^.Znak := 'N'; pomocnaZas^.PrednostOperace := -10;
  101.                   pomocnaZas^.Dalsi := zacatekZas; zacatekZas := pomocnaZas;
  102.              end
  103.              else begin                                 {tangens reprezentuji jako T}
  104.                   new(pomocnaZas); pomocnaZas^.Znak := 'T'; pomocnaZas^.PrednostOperace := -10;
  105.                   pomocnaZas^.Dalsi := zacatekZas; zacatekZas := pomocnaZas;
  106.              end;
  107.         end
  108.         else if (v = 'l') then                     {ln = E}
  109.         begin
  110.              new(pomocnaZas); pomocnaZas^.Znak := 'E'; pomocnaZas^.PrednostOperace := -10;
  111.              pomocnaZas^.Dalsi := zacatekZas; zacatekZas := pomocnaZas;
  112.         end;
  113.       end;
  114.       's':                      {cosinus = C}
  115.       begin
  116.         if (k = 'c') then
  117.              begin                                       {arkus kosinus = I}
  118.                   new(pomocnaZas); pomocnaZas^.Znak := 'I'; pomocnaZas^.PrednostOperace := -10;
  119.                   pomocnaZas^.Dalsi := zacatekZas; zacatekZas := pomocnaZas;
  120.              end
  121.              else begin                                 {cosinus = C}
  122.                   new(pomocnaZas); pomocnaZas^.Znak := 'C'; pomocnaZas^.PrednostOperace := -10;
  123.                   pomocnaZas^.Dalsi := zacatekZas; zacatekZas := pomocnaZas;
  124.              end;
  125.       end;
  126.       'g':
  127.       begin
  128.         if (v = 't') then
  129.         begin                                       {arkus tangens = N}
  130.              if (w = 'c') then
  131.              begin
  132.                   new(pomocnaZas); pomocnaZas^.Znak := 'N'; pomocnaZas^.PrednostOperace := -10;
  133.                   pomocnaZas^.Dalsi := zacatekZas; zacatekZas := pomocnaZas;
  134.              end
  135.              else begin                                  {tangens = T}
  136.                   new(pomocnaZas); pomocnaZas^.Znak := 'T'; pomocnaZas^.PrednostOperace := -10;
  137.                   pomocnaZas^.Dalsi := zacatekZas; zacatekZas := pomocnaZas;
  138.              end
  139.         end
  140.         else if (w = 'l') and (v = 'o') then         {log10 = L}
  141.         begin
  142.              new(pomocnaZas); pomocnaZas^.Znak := 'L'; pomocnaZas^.PrednostOperace := -10;
  143.              pomocnaZas^.Dalsi := zacatekZas; zacatekZas := pomocnaZas;
  144.         end
  145.       end;
  146.       't':
  147.       begin
  148.            if (k = 's' ) and (w = 'q') and (v = 'r') then
  149.            begin
  150.                 new(pomocnaZas); pomocnaZas^.Znak := 'O'; pomocnaZas^.PrednostOperace := -10;
  151.                 pomocnaZas^.Dalsi := zacatekZas; zacatekZas := pomocnaZas;
  152.            end;
  153.       end;
  154.       'd':
  155.       begin
  156.         if (w = 'r') and (v = 'a') then          {rad = konverze ze stupnu na radiany}
  157.         begin
  158.              new(pomocnaZas); pomocnaZas^.Znak := 'R'; pomocnaZas^.PrednostOperace := -10;
  159.              pomocnaZas^.Dalsi := zacatekZas; zacatekZas := pomocnaZas;
  160.         end;
  161.       end;
  162.       end;
  163.     end;
  164.     '_':
  165.     begin
  166.          if (w = 'l') and (v = 'o') and (u = 'g') then         {log_a = U}
  167.          begin
  168.               read(z);
  169.              i := 1;
  170.              while (z = ',') or (z = '.') or (z in ['0'..'9']) do      {resi viceciferna cisla}
  171.              begin
  172.                   if (z = ',') or (z = '.') then bylaDesetinnaCarka := true;
  173.                   if (z in ['0'..'9']) and (byladesetinnaCarka = false) then      {vypocet cele casti cisla}
  174.                   begin
  175.                        Hodnota1 := Hodnota1 * 10 + (ord(z)-48);
  176.                   end
  177.                   else if (z in ['0'..'9']) and (byladesetinnaCarka = true) then       {vypocet desetinne casti}
  178.                   begin
  179.                        Hodnota2 := Hodnota2 + (ord(z)-48)/(power(10,i));
  180.                        i := i + 1;
  181.                   end;
  182.                   k := w; w := v; v := u; u := z;                   {cteni}
  183.                   read(z);
  184.              end;
  185.              Hodnota := Hodnota1 + Hodnota2;
  186.              if (z = '(') then
  187.              begin
  188.                  new(pomocnaZas); pomocnaZas^.Znak := z; pomocnaZas^.PrednostOperace := 0;
  189.                  pomocnaZas^.Dalsi := zacatekZas; zacatekZas := pomocnaZas;
  190.                  new(pomocnaZas); pomocnaZas^.Znak := 'U'; pomocnaZas^.PrednostOperace := -10; pomocnaZas^.Hodnota := Hodnota;
  191.                  pomocnaZas^.Dalsi := zacatekZas; zacatekZas := pomocnaZas;
  192.              end;
  193.         end
  194.     end;
  195.     'F', 'f':                     {off - okamzite vypne program}
  196.     begin
  197.       if ((v = 'O') or (v = 'o')) and ((u = 'F') or (u = 'f')) then begin OFF := true; exit; end;
  198.     end;
  199.     'i', 'I':   {Pi}
  200.     begin
  201.       if (u = 'p') or (u = 'P') then
  202.       begin
  203.          new(pomocna); pomocna^.Hodnota := Pi; pomocna^.Znak := '?'; pomocna^.Dalsi := nil;
  204.          konec^.Dalsi := pomocna; konec := pomocna;
  205.       end;
  206.     end;                                                   {ANS funkce}
  207.     'S', 's':
  208.     begin
  209.       if ((v = 'A') or (v = 'a')) and ((u = 'n') or (u = 'N')) then
  210.       begin
  211.          new(pomocna); pomocna^.Hodnota := ANS; pomocna^.Znak := '?'; pomocna^.Dalsi := nil;
  212.          konec^.Dalsi := pomocna; konec := pomocna;
  213.       end;
  214.       if (u = 'M') and (z = 'S') then
  215.       begin
  216.            Memory := ANS; pocitat := false;
  217.       end;
  218.     end;
  219.     'e':       {eulerovo cislo}
  220.     begin
  221.          if (u <> 'd') then
  222.          begin
  223.               new(pomocna); pomocna^.Hodnota := 2.7182818284590452353; pomocna^.Znak := '?'; pomocna^.Dalsi := nil;
  224.               konec^.Dalsi := pomocna; konec := pomocna;
  225.          end
  226.     end;
  227.     'C':                                {MC = memory clean  = vycisti pamet}
  228.     begin
  229.       if (u = 'M') then
  230.       begin
  231.            Memory := 0; pocitat := false;
  232.       end;
  233.     end;
  234.     'R':               {MR = memory return = pouzije pamet, vypise ji}
  235.     begin
  236.       if (u = 'M') then
  237.       begin
  238.            new(pomocna); pomocna^.Hodnota := Memory; pomocna^.Znak := '?'; pomocna^.Dalsi := nil;
  239.            konec^.Dalsi := pomocna; konec := pomocna;
  240.       end;
  241.     end;
  242.     '!':
  243.     begin
  244.       if (u in ['0'..'9']) or (((v = 'P') or (v = 'p')) and ((u = 'i') or (u = 'I'))) or (u = 'e') then
  245.       begin
  246.            new(pomocna); pomocna^.Znak := '!'; pomocna^.Dalsi := nil;
  247.            konec^.Dalsi := pomocna; konec := pomocna;
  248.       end
  249.       else if (u = ')') then
  250.       begin
  251.            new(pomocna); pomocna^.Znak := '!'; pomocna^.Dalsi := nil;
  252.            konec^.Dalsi := pomocna; konec := pomocna;
  253.       end;
  254.     end;
  255.     '+', '-':
  256.     begin
  257.       prednostOperaceZ := 1;
  258.       if (u = '(') or (ord(u)=10) or (ord(u)=13) or (u = '#') then   {na ruznych systemech se chova ruzne, vykryt vsechny moznosti}
  259.       begin
  260.            new(pomocna); pomocna^.Hodnota := 0; pomocna^.Znak := '?'; pomocna^.Dalsi := nil;
  261.            konec^.Dalsi := pomocna; konec := pomocna;
  262.       end;
  263.       if (v = '+') and (u = '/') and (z = '-') then   {funkce zmeny znamenka na vysledek}
  264.       begin
  265.             if (ANS = 0) then writeln(0)
  266.             else begin
  267.             ANS := -ANS;
  268.             i := 0;
  269.             Hodnota1 := ANS;
  270.             while (not(((Round(Hodnota1) - power(10,i-14)) <= Hodnota1) and (Hodnota1 <= (Round(Hodnota1) + power(10,i-14)))))
  271.             and (i <= 15) do     {na zjistovani poctu desetinnych mist}
  272.             begin
  273.               Hodnota1 := Hodnota1 * 10;
  274.               i := i + 1;
  275.             end;
  276.             writeln(ANS:0:i);
  277.             end;
  278.           pocitat := false;
  279.       end
  280.       else if (u <> 'M') then
  281.       begin
  282.       if (zacatekZas = nil) or (prednostOperaceZ > zacatekZas^.PrednostOperace) then {novy operator ma vetsi hodnotu -> pridam ho do zasobniku}
  283.       begin
  284.            new(pomocnaZas); pomocnaZas^.Znak := z; pomocnaZas^.PrednostOperace := prednostOperaceZ;
  285.            pomocnaZas^.Dalsi := zacatekZas; zacatekZas := pomocnaZas;
  286.       end
  287.       else if (prednostOperaceZ = zacatekZas^.PrednostOperace) then   {novy operator ma stejnou hodnotu -> vypisu ten ze zasobniku a novy pridam  do zasobniku}
  288.       begin
  289.            new(pomocna); pomocna^.Znak := zacatekZas^.Znak; pomocna^.Dalsi := nil;
  290.            konec^.Dalsi := pomocna; konec := pomocna;
  291.            pomocnaZas := zacatekZas;
  292.            zacatekZas^.Znak := z;
  293.       end
  294.       else begin {vypis co je v zasobniku po kulatou zavorku, pridej tam z}
  295.            while (zacatekZas <> nil) and (zacatekZas^.Znak <> '(') and (zacatekZas^.Znak <> 'S')
  296.            and (zacatekZas^.Znak <> 'C') and (zacatekZas^.Znak <> 'T') and (zacatekZas^.Znak <> 'L')
  297.            and (zacatekZas^.Znak <> 'E') and (zacatekZas^.Znak <> 'U') and (zacatekZas^.Znak <> 'R')
  298.            and (zacatekZas^.Znak <> 'K') and (zacatekZas^.Znak <> 'I') and (zacatekZas^.Znak <> 'N')
  299.            and (zacatekZas^.Znak <> 'O') do
  300.            begin
  301.              new(pomocna); pomocna^.Znak := zacatekZas^.Znak; pomocna^.Dalsi := nil;
  302.              konec^.Dalsi := pomocna; konec := pomocna;
  303.              pomocnaZas := zacatekZas;
  304.              zacatekZas := zacatekZas^.Dalsi;
  305.              dispose(pomocnaZas);
  306.            end;
  307.            new(pomocnaZas); pomocnaZas^.Znak := z; pomocnaZas^.PrednostOperace := prednostOperaceZ;
  308.            pomocnaZas^.Dalsi := zacatekZas; zacatekZas := pomocnaZas;
  309.       end;
  310.       end
  311.       else begin
  312.         if (z = '+') then {pricteni ANS do pameti}
  313.         begin
  314.              Memory := Memory + ANS; pocitat := false;
  315.         end
  316.         else begin
  317.              Memory := Memory - ANS; pocitat := false;
  318.         end;
  319.       end;
  320.     end;
  321.     '*', '/':
  322.     begin
  323.       prednostOperaceZ := 2;
  324.       if (zacatekZas = nil) or (prednostOperaceZ > zacatekZas^.PrednostOperace) then
  325.       begin
  326.            new(pomocnaZas); pomocnaZas^.Znak := z; pomocnaZas^.PrednostOperace := prednostOperaceZ;
  327.            pomocnaZas^.Dalsi := zacatekZas; zacatekZas := pomocnaZas;
  328.       end
  329.       else if (prednostOperaceZ = zacatekZas^.PrednostOperace) then
  330.       begin
  331.            new(pomocna); pomocna^.Znak := zacatekZas^.Znak; pomocna^.Dalsi := nil;
  332.            konec^.Dalsi := pomocna; konec := pomocna;
  333.            pomocnaZas := zacatekZas;
  334.            zacatekZas^.Znak := z;
  335.       end
  336.       else begin
  337.         while (zacatekZas <> nil) and (zacatekZas^.Znak <> '(') and (zacatekZas^.Znak <> 'S')
  338.            and (zacatekZas^.Znak <> 'C') and (zacatekZas^.Znak <> 'T') and (zacatekZas^.Znak <> 'L')
  339.            and (zacatekZas^.Znak <> 'E') and (zacatekZas^.Znak <> 'U') and (zacatekZas^.Znak <> 'R')
  340.            and (zacatekZas^.Znak <> 'K') and (zacatekZas^.Znak <> 'I') and (zacatekZas^.Znak <> 'N')
  341.            and (zacatekZas^.Znak <> 'O') do
  342.            begin
  343.              new(pomocna); pomocna^.Znak := zacatekZas^.Znak; pomocna^.Dalsi := nil;
  344.              konec^.Dalsi := pomocna; konec := pomocna;
  345.              pomocnaZas := zacatekZas;
  346.              zacatekZas := zacatekZas^.Dalsi;
  347.              dispose(pomocnaZas);
  348.            end;
  349.            new(pomocnaZas); pomocnaZas^.Znak := z; pomocnaZas^.PrednostOperace := prednostOperaceZ;
  350.            pomocnaZas^.Dalsi := zacatekZas; zacatekZas := pomocnaZas;
  351.       end;
  352.     end;
  353.     '^':
  354.     begin
  355.       prednostOperaceZ := 3;
  356.       if (zacatekZas = nil) or (prednostOperaceZ > zacatekZas^.PrednostOperace) then
  357.       begin
  358.            new(pomocnaZas); pomocnaZas^.Znak := z; pomocnaZas^.PrednostOperace := prednostOperaceZ;
  359.            pomocnaZas^.Dalsi := zacatekZas; zacatekZas := pomocnaZas;
  360.       end
  361.       else if (prednostOperaceZ = zacatekZas^.PrednostOperace) then
  362.       begin
  363.            new(pomocna); pomocna^.Znak := zacatekZas^.Znak; pomocna^.Dalsi := nil;
  364.            konec^.Dalsi := pomocna; konec := pomocna;
  365.            pomocnaZas := zacatekZas;
  366.            zacatekZas^.Znak := z;
  367.       end
  368.       else begin
  369.         while (zacatekZas <> nil) and (zacatekZas^.Znak <> '(') and (zacatekZas^.Znak <> 'S')
  370.            and (zacatekZas^.Znak <> 'C') and (zacatekZas^.Znak <> 'T') and (zacatekZas^.Znak <> 'L')
  371.            and (zacatekZas^.Znak <> 'E') and (zacatekZas^.Znak <> 'U') and (zacatekZas^.Znak <> 'R')
  372.            and (zacatekZas^.Znak <> 'K') and (zacatekZas^.Znak <> 'I') and (zacatekZas^.Znak <> 'N')
  373.            and (zacatekZas^.Znak <> 'O') do
  374.            begin
  375.              new(pomocna); pomocna^.Znak := zacatekZas^.Znak; pomocna^.Dalsi := nil;
  376.              konec^.Dalsi := pomocna; konec := pomocna;
  377.              pomocnaZas := zacatekZas;
  378.              zacatekZas := zacatekZas^.Dalsi;
  379.              dispose(pomocnaZas);
  380.            end;
  381.            new(pomocnaZas); pomocnaZas^.Znak := z; pomocnaZas^.PrednostOperace := prednostOperaceZ;
  382.            pomocnaZas^.Dalsi := zacatekZas; zacatekZas := pomocnaZas;
  383.       end;
  384.     end;
  385.     ')':                                   {vycisti se zasobnik po pristi zavorku}
  386.     begin
  387.       while (true) do
  388.       begin
  389.         if (zacatekZas = nil) then begin break; end
  390.         else if(zacatekZas^.Znak = '(') then
  391.         begin
  392.                   pomocnaZas := zacatekZas;
  393.                   zacatekZas := zacatekZas^.Dalsi;
  394.                   dispose(pomocnaZas);
  395.                   break;
  396.         end;
  397.         new(pomocna); pomocna^.Znak := zacatekZas^.Znak; pomocna^.Dalsi := nil;
  398.         if (pomocna^.Znak = 'U') then pomocna^.Hodnota := zacatekZas^.Hodnota;
  399.         konec^.Dalsi := pomocna; konec := pomocna;
  400.         zacatekZas := zacatekZas^.Dalsi;
  401.       end;
  402.     end;
  403.  
  404.  
  405.     end;
  406.   until z = '=';
  407.   while (zacatekZas <> nil) do  {pokud cely vyraz nebyl ohranicen zavorkami, posledni zbyvajici operator se nevypise, vypisu ho manualne}
  408.   begin
  409.     new(pomocna); pomocna^.Znak := zacatekZas^.Znak; pomocna^.Dalsi := nil;        {~cisteni zasobniku}
  410.     konec^.Dalsi := pomocna; konec := pomocna;
  411.     pomocnaZas := zacatekZas;
  412.     zacatekZas := zacatekZas^.Dalsi;
  413.     dispose(pomocnaZas);
  414.   end;
  415.   if (zacatek <> nil) then begin pomocna := zacatek; zacatek := zacatek^.Dalsi; dispose(pomocna);  end;{protoze jsme na zacatku vytvorili jeden prvek
  416.   seznamu navic (aby slo algoritmem vytvaret dalsi), na konci ho smazeme}
  417.  
  418. end;
  419.  
  420. procedure vypisPostfix(zacatek: PZaznam);
  421. var
  422.   pomocna: PZaznam;
  423. begin
  424.   pomocna := zacatek;
  425.   while (pomocna <> nil) do
  426.   begin
  427.     if (pomocna^.Znak = '?') then write(pomocna^.Hodnota:0:2, ' ')
  428.     else write(pomocna^.Znak, ' ');
  429.     pomocna := pomocna^.Dalsi;
  430.   end;
  431. end;
  432.  
  433. procedure spocitejPostfix(var zacatek: PZaznam; pocitat: boolean);
  434. var
  435.   p1, p2, p3, p4, pomocna: PZaznam;
  436.   podminka: boolean;
  437.   i, j: integer;
  438.   testovaciHodnota: real;
  439. begin
  440.   if (pocitat = true) then
  441.   begin
  442.   p1 := zacatek; p2 := zacatek; p3 := zacatek;
  443.   podminka := true;
  444.   while (p1 <> nil) and (podminka = true) do
  445.   begin
  446.     if (p1^.Znak = '?') then p1 := p1^.Dalsi   {p1 otaznik = je tam hodnota, pokud ne, je tam operator nebo funkce}
  447.     else begin
  448.          case p1^.Znak of
  449.          '+', '-', '*', '/', '^':
  450.          begin
  451.            p3 := zacatek;
  452.            while (p3^.Dalsi^.Dalsi <> nil) and (p3^.Dalsi^.Dalsi <> p1) do p3 := p3^.Dalsi;
  453.            p2 := p3^.Dalsi;
  454.            p4 := p1^.Dalsi;
  455.            case p1^.Znak of
  456.            '+':
  457.            begin
  458.              if (p2^.Znak = '?') and (p3^.Znak = '?') then
  459.              begin
  460.                   p3^.Hodnota := p3^.Hodnota + p2^.Hodnota;
  461.                   p3^.Dalsi := p4;
  462.                   dispose(p2); dispose(p1);
  463.                   p1 := zacatek;
  464.              end
  465.              else begin
  466.                while (zacatek <> nil) do
  467.                  begin
  468.                    p1 := zacatek;
  469.                    zacatek := zacatek^.Dalsi;
  470.                    dispose(p1);
  471.                  end;
  472.                podminka := false;
  473.                end;
  474.            end;
  475.            '-':
  476.            begin
  477.              if (p2^.Znak = '?') and (p3^.Znak = '?') then
  478.              begin
  479.                   p3^.Hodnota := p3^.Hodnota - p2^.Hodnota;
  480.                   p3^.Dalsi := p4;
  481.                   dispose(p2); dispose(p1);
  482.                   p1 := zacatek
  483.              end
  484.              else begin
  485.                while (zacatek <> nil) do
  486.                  begin
  487.                    p1 := zacatek;
  488.                    zacatek := zacatek^.Dalsi;
  489.                    dispose(p1);
  490.                  end;
  491.                podminka := false;
  492.                end;
  493.            end;
  494.            '*':
  495.            begin
  496.              if (p2^.Znak = '?') and (p3^.Znak = '?') then
  497.              begin
  498.                   p3^.Hodnota := p3^.Hodnota * p2^.Hodnota;
  499.                   p3^.Dalsi := p4;
  500.                   dispose(p2); dispose(p1);
  501.                   p1 := zacatek;
  502.              end
  503.              else begin
  504.                while (zacatek <> nil) do
  505.                  begin
  506.                    p1 := zacatek;
  507.                    zacatek := zacatek^.Dalsi;
  508.                    dispose(p1);
  509.                  end;
  510.                podminka := false;
  511.                end;
  512.            end;
  513.            '/':
  514.            begin
  515.              if (p2^.Znak = '?') and (p3^.Znak = '?') and (p2^.Hodnota <> 0) then
  516.              begin
  517.                   p3^.Hodnota := p3^.Hodnota / p2^.Hodnota;
  518.                   p3^.Dalsi := p4;
  519.                   dispose(p2); dispose(p1);
  520.                   p1 := zacatek;
  521.              end
  522.              else begin
  523.                while (zacatek <> nil) do
  524.                  begin
  525.                    p1 := zacatek;
  526.                    zacatek := zacatek^.Dalsi;
  527.                    dispose(p1);
  528.                  end;
  529.                podminka := false;
  530.                end;
  531.            end;
  532.            '^':
  533.            begin
  534.                   if (p2^.Hodnota > 0) and (p2^.Hodnota < 1) and (Round(1/(p2^.Hodnota)) mod 2 = 0) and (p3^.Hodnota < 0)
  535.                    or ((p2^.Znak <> '?') or (p3^.Znak <> '?')) then
  536.                   begin
  537.                        while (zacatek <> nil) do
  538.                        begin
  539.                        p1 := zacatek;
  540.                        zacatek := zacatek^.Dalsi;
  541.                        dispose(p1);
  542.                        end;
  543.                        podminka := false;
  544.                   end
  545.                   else begin
  546.                        p3^.Hodnota := power(p3^.Hodnota, p2^.Hodnota);
  547.                        p3^.Dalsi := p4;
  548.                        dispose(p2); dispose(p1);
  549.                        p1 := zacatek;
  550.                   end;
  551.            end
  552.            else break;
  553.            end
  554.  
  555.          end;
  556.          'S', 'C', 'T', 'L', 'E', 'U', 'R', '!', 'K', 'I', 'N', 'O':
  557.          begin
  558.            p2 := zacatek;
  559.            while (p2 <> nil) and (p2^.Dalsi <> p1) do p2 := p2^.Dalsi;
  560.            p4 := p1^.Dalsi;
  561.            case p1^.Znak of
  562.            'O':
  563.            begin
  564.                   if (p2 = nil) or (p2^.Hodnota < 0) or (p2^.Znak <> '?') then podminka := false
  565.                   else begin
  566.                        p2^.Hodnota := sqrt(p2^.Hodnota);
  567.                        p2^.Dalsi := p4;
  568.                        dispose(p1);
  569.                        p1 := zacatek;
  570.                   end;
  571.            end;
  572.            'S':              {sinus}
  573.            begin
  574.                   if (p2 = nil) or (p2^.Znak <> '?') then
  575.                   begin
  576.                        while (zacatek <> nil) do
  577.                        begin
  578.                             p1 := zacatek;
  579.                             zacatek := zacatek^.Dalsi;
  580.                             dispose(p1);
  581.                        end;
  582.                        podminka := false;
  583.                   end
  584.                   else begin
  585.                     p2^.Hodnota := sin(p2^.Hodnota);
  586.                     p2^.Dalsi := p4;
  587.                     dispose(p1);
  588.                     p1 := zacatek;
  589.                     end;
  590.            end;
  591.            'K':                                  {arkus sinus}
  592.            begin
  593.              if (p2 = nil) or (p2^.Hodnota > 1) or (p2^.Hodnota < -1) or (p2^.Znak <> '?')then podminka := false
  594.              else begin
  595.                   p2^.Hodnota := arcsin(p2^.Hodnota);
  596.                   p2^.Dalsi := p4;
  597.                   dispose(p1);
  598.                   p1 := zacatek;
  599.                   end;
  600.            end;
  601.            'C':              {kosinus}
  602.            begin
  603.                   if (p2 = nil) or (p2^.Znak <> '?') then
  604.                   begin
  605.                        while (zacatek <> nil) do
  606.                        begin
  607.                             p1 := zacatek;
  608.                             zacatek := zacatek^.Dalsi;
  609.                             dispose(p1);
  610.                        end;
  611.                        podminka := false;
  612.                   end
  613.                   else begin
  614.                     p2^.Hodnota := cos(p2^.Hodnota);
  615.                     p2^.Dalsi := p4;
  616.                     dispose(p1);
  617.                     p1 := zacatek;
  618.                     end;
  619.            end;
  620.            'I':                              {arkus kosinus}
  621.            begin
  622.              if (p2 = nil) or (p2^.Hodnota > 1) or (p2^.Hodnota < -1) or (p2^.Znak <> '?') then podminka := false
  623.              else begin
  624.                   p2^.Hodnota := arccos(p2^.Hodnota);
  625.                   p2^.Dalsi := p4;
  626.                   dispose(p1);
  627.                   p1 := zacatek;
  628.                   end;
  629.            end;
  630.            'T':              {tangens}
  631.            begin
  632.              if (p2 = nil) or (tan(p2^.Hodnota) > power(10,15)) or (tan(p2^.Hodnota) < -power(10,15)) or (p2^.Znak <> '?') then
  633.              podminka := false   {vylepsit}
  634.              else begin
  635.                   p2^.Hodnota := tan(p2^.Hodnota);
  636.                   p2^.Dalsi := p4;
  637.                   dispose(p1);
  638.                   p1 := zacatek;
  639.              end;
  640.            end;
  641.            'N':                  {arkus tangens}
  642.            begin
  643.              begin
  644.                   if (p2 = nil) or (p2^.Znak <> '?') then
  645.                   begin
  646.                        while (zacatek <> nil) do
  647.                        begin
  648.                             p1 := zacatek;
  649.                             zacatek := zacatek^.Dalsi;
  650.                             dispose(p1);
  651.                        end;
  652.                        podminka := false;
  653.                   end
  654.                   else begin
  655.                     p2^.Hodnota := arctan(p2^.Hodnota);
  656.                     p2^.Dalsi := p4;
  657.                     dispose(p1);
  658.                     p1 := zacatek;
  659.                     end;
  660.            end;
  661.            end;
  662.            'E':                  {ln}
  663.            begin
  664.              if (p2 = nil) or (p2^.Hodnota <= 0) or (p2^.Znak <> '?') then podminka := false
  665.              else begin
  666.                   p2^.Hodnota := Logn(2.7182818284590452353, p2^.Hodnota);
  667.                   p2^.Dalsi := p4;
  668.                   dispose(p1);
  669.                   p1 := zacatek;
  670.              end;
  671.            end;
  672.            'L':                      {log_10}
  673.            begin
  674.              if (p2 = nil) or (p2^.Hodnota <= 0) or (p2^.Znak <> '?') then podminka := false
  675.              else begin
  676.                   p2^.Hodnota := Logn(10, p2^.Hodnota);
  677.                   p2^.Dalsi := p4;
  678.                   dispose(p1);
  679.                   p1 := zacatek;
  680.              end;
  681.            end;
  682.            'U':                   {log_a}
  683.            begin
  684.              if (p2 = nil) or (p2^.Hodnota <= 0) or (p2^.Znak <> '?') then podminka := false
  685.              else begin
  686.                   p2^.Hodnota := Logn(p1^.Hodnota, p2^.Hodnota);
  687.                   p2^.Dalsi := p4;
  688.                   dispose(p1);
  689.                   p1 := zacatek;
  690.              end;
  691.            end;
  692.            'R':             {stupne na radiany, alternativa pro °}
  693.            begin
  694.              if (p2 = nil) or (p2^.Znak <> '?') then podminka := false
  695.              else begin
  696.                   p2^.Hodnota := (Pi/180)*(p2^.Hodnota);
  697.                   p2^.Dalsi := p4;
  698.                   dispose(p1);
  699.                   p1 := zacatek;
  700.              end;
  701.            end;
  702.            '!':
  703.            begin
  704.              if (p2 = nil) or (Round(p2^.Hodnota) <> (p2^.Hodnota)) or (p2^.Hodnota < 0) or (p2^.Znak <> '?') then podminka := false
  705.              else begin
  706.                p2^.Hodnota := faktorial(p2^.Hodnota);
  707.                p2^.Dalsi := p4;
  708.                dispose(p1);
  709.                p1 := zacatek;
  710.                end;
  711.            end
  712.            else break;
  713.            end;
  714.          end
  715.          else begin podminka := false; break; end;
  716.            end;
  717.     end;
  718.   end;
  719.  
  720.   if (zacatek <> nil) and (zacatek^.Dalsi = nil) and (podminka = true) then
  721.   begin
  722.            if (-(power(10, -14)) <= zacatek^.Hodnota) and (zacatek^.Hodnota <= (power(10,-14))) then begin ANS := 0; writeln(0); end        {resi kladnou a zapornou nulu}
  723.        else begin
  724.             i := 0;
  725.             j := 0;
  726.             testovaciHodnota := zacatek^.Hodnota;
  727.             while (not(((Round(testovaciHodnota) - power(10,i-14)) <= testovaciHodnota) and (testovaciHodnota <= (Round(testovaciHodnota) + power(10,i-14)))))
  728.             and (i <= 15) do     {na zjistovani poctu desetinnych mist}
  729.             begin
  730.               testovaciHodnota := testovaciHodnota * 10;
  731.               i := i + 1;
  732.             end;
  733.             ANS := zacatek^.Hodnota;
  734.             if ANS > power(10, 15) then writeln('Error')
  735.             else writeln(ANS:0:i);
  736.        end;
  737.   end
  738.   else writeln('Error');
  739.   end;
  740.   while zacatek <> nil do
  741.     begin
  742.       pomocna := zacatek;
  743.       zacatek := zacatek^.Dalsi;
  744.       dispose(pomocna);
  745.     end;
  746.  
  747. end;
  748.  
  749. begin
  750.   Memory := 0; ANS := 0; OFF := false;
  751.   Writeln('Kalkulacka');
  752.   Writeln('Konstanty: pi, e');
  753.   Writeln('Operatory: +, -, *, /, ^');
  754.   Writeln('Matematicke funkce: sin(x), cos(x), tan(x), arcsin(x), arcccos(x), arctan(x), a^x, log(x), ln(x), log_a(x), n!');
  755.   Writeln('Ostatni funkce: ANS, M+, M-, MR, MC, MS, +/-, off');
  756.   Writeln('Pozn: Funkce ve vychozim nastaveni prijimaji hodnoty v radianech, funkce na konverzi stupen -> radian = rad(x)');
  757.   while (true) do
  758.   begin
  759.        pocitat := true;
  760.        prevedDoPostfixu(zacatek, konec, pocitat);
  761.        if (OFF = true) then break;
  762.        vypisPostfix(zacatek); writeln;
  763.        spocitejPostfix(zacatek, pocitat);
  764.   end;
  765.  
  766. end.
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement
Public Pastes
Advertisement
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.  OK, I Understand
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!