Delphi - a function of the expression of a new algorithm
After thinking, I have made a function of the expression value, which is different from the standard algorithm. This is my closed door, the purpose is to seek simple. A bug is a decimal point 0.99999999. . . . . No automatic elimination is 1. Time is in a hurry, I can't say more, let the reader look at it again. An additional Xiji may be beneficial to open up new ideas. I am called the expression of the bracket method layer by layer. The update date is 2007.5.14. My mailbox is myvbvc @ Tom.com, QQ: 165442523. The program is not recursive, only the loop is used.
Unit unit1;
Interface
Uses Windows, Messages, Sysutils, Variants, Classes, Graphics, Controls, Forms, Dialogs, Stdctrls, Strutils, Spin
TYPE TFORM1 = Class (TFORM) Edit1: Tedit; Edit2: Tedit; Button1: Tbutton; Procedure Button1Click (Sender: Tobject); private {private declarations}
Var Form1: TFORM1;
IMPLEMENTATION
{$ R * .dfm} function nospace (s: string): string; beginResult: = StringReplace (s, '', '', [rfreplaceall); end; function is123 (c: char): Boolean; Beginif C in ['0' .. '9', '.'] The result: = trueelse result: = false;
End; function isminus (s: string; i: integer): Boolean; VART: Integer; Begin
For T: = I-1 DOWNTO 1 Do Begin IF S [] = ')' Then Begin Result: = FALSE; Break; End; IF (S [T] = '(') AND (S [T 1] = '-') THEN Begin Result: = true; Break; End; IF (not is123 (s [t])) and (((S [t] = '-') AND (S [T-1] = '('))) The begin result: = false; Break; end; end;
Function firstj (s: string): integer; vari, l: integer; beginResult: = 0; l: = length (s); for i: = 1 to l do begin if (s [i] = ')') and (not isminus (s, i)).....................
End; end; function firstc (s: string; firstj: integer): integer; var: integer; begin for t: = firstj downto 1 do beginiff (s [t [t 1) (s [t 1) ] <> '-') THEN Begin Result: = T; Break; end; end; end; function firstsign (s: string): integer; vari: integer; beginResult: = 0; for i: = 1 to Length (s ) Do IF s [' ', '-', '*', '/'] The begin Result: = i; exit; end; end; function firstaddsub (s: string; var sigh: char) : Integer; Vari: Integer; BeginResult: = 0; for i: = 1 to length (s) do begin if s [i] = ' ' Then Begin Sigh: = ' '; Result: = i; exit; End; ; If (s [i] = '-') and (s [i-1] <> '(') THEN BEGIN SIGH: = '-'; Result: = I; EXIT; End; end; end; function firstMultidiviV (s: string; vari: integer; beginResult: = 0; for i: = 1 to length (s) do begin if s [i] = '*' TEN BEGIN SIGH: = '* '; Result: = I; EXIT; END; IF S [I] =' / 'THEN BEGIN SIGH: =' / '; Result: = I; EXIT; End; End; End; Function Firstsignex (S: String; SIGH) : char): in Teger; vari: integer; beginResult: = 0; for i: = 1 to length (s) do if s [i] = SIGH THEN BEGIN RESULT: = i; exit; end; end; function firstminussignex (s: string): Integer; vari: integer; beginResult: = 0; for i: = 1 to length (s) do if (s [i] = '-') AND (S [i-1] <> '(') THEN Begin Result : = I; EXIT; End; End; function secondsign (s: string): integer; vari, j: integer; begin j: = firstsign (s);
For i: = j 1 to length (s) do if s [i] in [' ', '-', '*', '/'] the begin Result: = i; EXIT; End; Result: = Length (s); end; function secondsignex (s: string; sigh: char): Integer; vari, j: integer; begin j: = firstsignex (s, sigh); for i: = j 1 to length (s) DO if s [I] in [' ', '-', '*', '/'] The begin Result: = I; EXIT; End; Result: = Length (s); end; function leftnum (s: String; I: integer: double; var, l: integer; beginl: = length (s); if s [i-1] = ')' thenbegin for t: = i-1 Downto 1 do if s [t] = '(' Dam RESULT: = STRTOFLOAT (COPY (S, T 1, I-2-T)); exit; end; endelsebegin for t: = i-1 Downto 1 do begin if not is123 (s [t ]) THEN Begin Result: = StrtOFLOAT (COPY (S, T 1, I-1-T)); EXIT; End; if T = 1 Then Result: = STRTOFLOAT (LEFTSTR (S, I-1)); END ;
End; Function Rightnum (s: string; i: integer): double; var, l: integer; beginl: = length (s); if s [i 1] = '(' Thenbegin for t: = i 2 To L DO if s [t] = ')' Then Begin Result: = StrtOfloat (COPY (S, I 2, Ti-2)); exit; end; endelsebegin for t: = i 1 to l do begin if not NOT IS123 (s [t]) THEN Begin Result: = StrtOfloat (COPY (S, I 1, Ti-1)); EXIT; End; if T = l Then Result: = STRTOFLOAT (RightStr (s, li)); End; end; end; / function leftsigh (s: string; i: integer): integer; var, l: integer; beginl: = length (s); if s [i-1] = ')' Thenbegin for t: = I-1 DOWNTO 1 Do IF S [= '(' Then Begin Result: = T; EXIT; End; endelsebegin for t: = i-1 Downto 1 Do Begin if not is123 (s [t]) THEN BEGIN Result: = T 1; EXIT; END; IF T = 1 Then Result: = 1; End; end; end; function rightsigh (s: string; i: integer): Integer; VART, L: Integer; beginl: = Length (s); if s [i 1] = '(' thenbegin for t: = i 2 to L DO if s [t] = ')' Then Begin Result: = T; EXIT; END; endelsebegin for t : = i 1 to L do Begin IF not is123 (s [t]) THEN BEGIN RESULT: = T-1; EXIT; End; IF T = l Then Result: = L; End; end;
Function Nomultiv (String; Vari, L, Le, RI: Integer; J, K: Double; Sigh: char; beginwhile 1 = 1 dobegins: = NOSPACE (S); Result: = S; l: = Length (s); i: = firstmultidiv (s, s, siGH); if (i = 0) or (s [i] <> sigh) dam; le: = left (s, i); J: = LeftNum (s , i); K: = RightNum (S, I); RI: = RightSigh (S, I); // IF II
End; function noaddsub (s: string): string; vari, l, le, ri: integer; j, k: double; sigh: char; beginwhile 1 = 1 dobegins: = NOSPACE (s); result: = s; L : = Length (s); i: = firstaddsub (s, s, siGH); if (i = 0) or (s [i] <> sigh) THEN EXIT; LE: = Leftsigh (S, I); J: = Leftnum (S, I); K: = RightNum (S, I); RI: = RightSigh (S, I); if (Sigh <> ') and (Sigh <>' - ') Then Break; if sigh = ' ' Tenif J K> = 0 THENS: = Leftstr (s, le-1) floattostr (J K) RightStr (S, L-Ri) elses: = Leftstr (S, LE-1) ' (' FLOATTOSTR (J K) ') ' RightStr (S, L-Ri); if Sigh =' - 'Thenif JK> = 0 THENS: = Leftstr (S, LE-1) FLOATTOSTR (JK) RightStr (s, l-ri) elses: = Leftstr (S, LE-1) '(' floattostr (jk) ')' RightStr (S, L-Ri); end; result: = S; End; function nosub (s: string): string; vari, l, le, ri: integer; j, k: double; begins: = nospace (s); result: = S; l: = Length (s); i : = firstminussignex (s); if (i = 0) OR (s [i] <> '-') THEN EXIT; Le: = Leftsigh (S, I); J: = LeftNum (S, I); K: = Rightnum (S, I); RI: = RightSigh (S, I); if jk> = 0 ThenResult: = Nosub (Leftstr (s, le-1) floattostr (jk) RightStr (S, L-RI) Elseresult: = NOSUB (Leftstr (S, LE-1) '(' floattostr (jk) ')' R IgHTSTR (S, L-RI)) end; function allToone (s: string): string; begin s: = Nomultidiv (s); s: = noAdDSub (s); result: = s;
Function myexpress (s: string): String; Varc, J, L: Integer; Le, Ri, Al, Substr, S0: String; Tryit: Double; BeginWhile 1 = 1 dobegins: = nospace (s); s0: = s ; L: = Length (s); // IF (s [1] <> ') or (s [l] <>') ') THEN // S: =' (' S ') '; // if (s [1] = '(') AND (S [L] = ')') AND ((S [2] = '-') or (ISMINUS (S, L))) THEN / / S : = '(' s ')'; L: = Length (s); j: = firstj (s); c: = firstc (s, j); if j> c tellInsubstr: = Copy (S, C 1, JC-1); // Le: = LeftStr (S, C-1); // ri: = RightStr (S, LJ); Le: = Leftstr (S, C-1); Le: = Rightstr Le, Length (le)); RI: = RightStr (S, LJ); RI: = LeftStr (Ri, Length (ri)); // ShowMessage (Substr); Al: = AllToone (Substr); // ShowMessage Le Al ri); s: = le al ri; endtoone (s0); break; end; end; result: = s; if (Result [1] = '(') AND (Result Length (result)] = ')') ThenResult: = COPY (Result, 2, Length (Result) -2); end; procedure tform1.button1click (sender: TOBJECT); beginedit2.text: = myExpress (edit1.text) .
