API tools faq
paste
Advertisement
Guest User

Kalkulacka

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