Kirjoittaja: Jogge
Kirjoitettu: 15.12.2002 – 15.12.2002
Tagit: koodi näytille, vinkki
Tein sitten tämän lausekkeen laskijan QB:llekkin, mutta olisi varmaan voinut paremminkin tehdä :) Mut toimii kumminkin. Lausekkeen laskijani osaa oikean laskujärjestyksen (tietenkin ;), sulut, +, -, *, / ja ^ -laskut. Tällä voi laskea myös ilman laskujärjestystä, jos se nyt niin hyödyllistä on. Tuli ainakin tarkisteltua laskimen kanssa että laskee oikein. Jotain outoa sotkua voi tietenkin koodista löytyä... :)
Muokkasin koodivinkkiä ja pistin nyt sen uusimman (v1.1) lausekkeen laskijan tänne.
DECLARE FUNCTION Laske! (laus$)
DECLARE FUNCTION LaskeLauseke (lau$)
DECLARE FUNCTION LaskePala$ (laus$, alku!, loppu!)
'* * * * * * * * * * * * * * * * * * * *
'* Lausekkeen laskija v1.1 by: J0gge *
'* *
'* Funktiot: *
'* *
'* LaskeLauseke: Laskee lausekkeen *
'* laskuj?rjestyksen mukaan. *
'* *
'* Laske: Laskee lausekkeen *
'* laskuj?rjestyksen mukaan *
'* ilman sulkuja *
'* *
'* LaskePala: Laskee halutun kokoisen *
'* palan lausekkeesta ilman *
'* laskuj?rjestyst? *
'* * * * * * * * * * * * * * * * * * * *
CLS
a$ = "3+(2^(8/(2+(2^2)-2))+((1+2+3+4)/5))+10"
COLOR 3
PRINT a$ 'tulostetaan lauseke, jota lasketaan
COLOR 7
PRINT
temp = LaskeLauseke(a$) 'LaskeLauseke palauttaa laskun vastauksen
FUNCTION Laske (laus$)
m0$ = "^"
m1$ = "*/"
m2$ = "+-"
mrkkej = 0
FOR ko = 2 TO LEN(laus$)
IF INSTR(1, m0$ + m1$ + m2$, MID$(laus$, ko, 1)) <> 0 AND edl = 0 THEN mrkkej = mrkkej + 1
edl = INSTR(1, m0$ + m1$ + m2$, MID$(laus$, ko, 1))
NEXT
REDIM mrkit(mrkkej)
mrkkej = 0
FOR ko = 2 TO LEN(laus$)
IF INSTR(1, m0$ + m1$ + m2$, MID$(laus$, ko, 1)) <> 0 AND edl = 0 THEN mrkit(mrkkej) = ko: mrkkej = mrkkej + 1
edl = INSTR(1, m0$ + m1$ + m2$, MID$(laus$, ko, 1))
NEXT
DO
ko = mrkit(j)
DO
ko = ko + 1
IF INSTR(1, m0$ + m1$ + m2$, MID$(laus$, ko, 1)) <> 0 THEN EXIT DO
LOOP
ko1 = ko
ko = mrkit(j)
DO
ko = ko - 1
IF ko = 0 THEN EXIT DO
IF INSTR(1, m0$ + m1$ + m2$, MID$(laus$, ko, 1)) <> 0 THEN EXIT DO
LOOP
ko2 = ko + 1
IF INSTR(1, m0$, MID$(laus$, mrkit(j), 1)) <> 0 THEN
laus$ = LaskePala$(laus$, ko2, ko1)
j = -1
END IF
mrkkej = 0
FOR ko = 2 TO LEN(laus$)
IF INSTR(1, m0$ + m1$ + m2$, MID$(laus$, ko, 1)) <> 0 AND edl = 0 THEN mrkit(mrkkej) = ko: mrkkej = mrkkej + 1
edl = INSTR(1, m0$ + m1$ + m2$, MID$(laus$, ko, 1))
NEXT
j = j + 1
IF j >= mrkkej THEN EXIT DO
LOOP
IF LEN(laus$) < 3 THEN GOTO ohitus
mrkkej = 0
FOR ko = 2 TO LEN(laus$)
IF INSTR(1, m0$ + m1$ + m2$, MID$(laus$, ko, 1)) <> 0 AND edl = 0 THEN mrkkej = mrkkej + 1
edl = INSTR(1, m0$ + m1$ + m2$, MID$(laus$, ko, 1))
NEXT
REDIM mrkit(mrkkej)
mrkkej = 0
FOR ko = 2 TO LEN(laus$)
IF INSTR(1, m0$ + m1$ + m2$, MID$(laus$, ko, 1)) <> 0 AND edl = 0 THEN mrkit(mrkkej) = ko: mrkkej = mrkkej + 1
edl = INSTR(1, m0$ + m1$ + m2$, MID$(laus$, ko, 1))
NEXT
j = 0
DO
ko = mrkit(j)
DO
ko = ko + 1
IF INSTR(1, m0$ + m1$ + m2$, MID$(laus$, ko, 1)) <> 0 THEN EXIT DO
LOOP
ko1 = ko
ko = mrkit(j)
DO
ko = ko - 1
IF ko = 0 THEN EXIT DO
IF INSTR(1, m0$ + m1$ + m2$, MID$(laus$, ko, 1)) <> 0 THEN EXIT DO
LOOP
ko2 = ko + 1
IF INSTR(1, m1$, MID$(laus$, mrkit(j), 1)) <> 0 THEN
laus$ = LaskePala$(laus$, ko2, ko1)
j = -1
END IF
mrkkej = 0
FOR ko = 2 TO LEN(laus$)
IF INSTR(1, m0$ + m1$ + m2$, MID$(laus$, ko, 1)) <> 0 AND edl = 0 THEN mrkit(mrkkej) = ko: mrkkej = mrkkej + 1
edl = INSTR(1, m0$ + m1$ + m2$, MID$(laus$, ko, 1))
NEXT
j = j + 1
IF j >= mrkkej THEN EXIT DO
LOOP
mrkkej = 0
FOR ko = 2 TO LEN(laus$)
IF INSTR(1, m0$ + m1$ + m2$, MID$(laus$, ko, 1)) <> 0 AND edl = 0 THEN mrkkej = mrkkej + 1
edl = INSTR(1, m0$ + m1$ + m2$, MID$(laus$, ko, 1))
NEXT
IF mrkkej > 0 THEN laus$ = LaskePala$(laus$, 1, LEN(laus$))
ohitus:
Laske = VAL(laus$)
END FUNCTION
FUNCTION LaskeLauseke (lau$)
DO
sulku1 = 0: sulku2 = 0
FOR koo = 1 TO LEN(lau$)
IF INSTR(1, MID$(lau$, koo, 1), "(") <> 0 THEN sulku1 = koo
NEXT
IF sulku1 = 0 THEN EXIT DO
FOR koo = LEN(lau$) TO sulku1 STEP -1
IF INSTR(1, MID$(lau$, koo, 1), ")") <> 0 THEN sulku2 = koo
NEXT
laus = Laske(MID$(lau$, sulku1 + 1, sulku2 - sulku1 - 1))
h1$ = LEFT$(lau$, sulku1 - 1)
h2$ = RIGHT$(lau$, LEN(lau$) - sulku2)
lau$ = h1$ + LTRIM$(STR$(laus)) + h2$
LOOP
laus = Laske(lau$)
LaskeLauseke = laus
END FUNCTION
FUNCTION LaskePala$ (lauseke$, alku, loppu)
merkit$ = "+-*/^"
DO
lppu = LEN(lauseke$) - loppu
PRINT lauseke$ 'v?livaihetulostuksia...
lk = 0
FOR k = alku + 1 TO loppu
IF INSTR(1, merkit$, MID$(lauseke$, k, 1)) <> 0 AND ed = 0 THEN lk = lk + 1
IF lk = 2 THEN lp = k - 1: lk = lk + 1
IF k = loppu AND lk < 2 THEN lp = k
ed = INSTR(1, merkit$, MID$(lauseke$, k, 1))
NEXT
PRINT MID$(lauseke$, alku, lp - alku + 1); " ="; 'v?livaihetulostuksia...
b$ = "" 'm? sotkin t?nne jonku b$ muuttujan jota ei kai tartte ollenkaan, siivotkaa pois jos jaksatte
FOR k = lp TO alku + 1 STEP -1
IF INSTR(1, merkit$, MID$(lauseke$, k, 1)) = 0 OR LEN(b$) = 0 THEN b$ = b$ + MID$(lauseke$, k, 1)
IF INSTR(1, merkit$, MID$(lauseke$, k, 1)) <> 0 AND b$ <> "" THEN mrk = INSTR(1, merkit$, MID$(lauseke$, k, 1)): kk = k
NEXT
l1 = VAL(MID$(lauseke$, alku, kk - 1))
l2 = VAL(MID$(lauseke$, kk + 1, loppu))
SELECT CASE MID$(merkit$, mrk, 1)
CASE "+"
tulos = l1 + l2
CASE "-"
tulos = l1 - l2
CASE "*"
tulos = l1 * l2
CASE "/"
tulos = l1 / l2
CASE "^"
tulos = l1 ^ l2
END SELECT
PRINT tulos 'v?livaihetulostuksia...
PRINT
a1$ = LEFT$(lauseke$, kk - LEN(LTRIM$(STR$(l1))) - 1)
a2$ = RIGHT$(lauseke$, LEN(lauseke$) - kk - LEN(LTRIM$(STR$(l2))))
lauseke$ = a1$ + LTRIM$(RTRIM$(STR$(tulos))) + a2$
SLEEP 'wenataan n?pp?int?
IF lp >= loppu - 1 THEN EXIT DO
loppu = LEN(lauseke$) - lppu
LOOP
LaskePala$ = lauseke$
END FUNCTIONHieno. Sisennyskin on muistettu, mutta minusta sillä ei niinkään ole väliä. Hyödyllinenkin se on.
Vieläku potenssit olis niin ois täydellinen.
siihen on oikeastaan aika helppo lisätä se potenssihomma
mut huomasinki että se bugaa joissain laskuissa :P
Minkälaisissa/missä lasku(i)ssa se bugittaa?
ainakin mulla bugitti ku kokeilin laskea 3+(2*(8/4))+10, mutta nyt sain korjattua ja tein potenssinkin. Taidan pistää sen nettiin ja osotteen tänne kommentteihin.
uus versio (osaa potenssin ja ei sekoo yhtä helposti): http://koti.mbnet.fi/jojo/QBASIC/LLASKIJA.BAS
Kyllähän potenssi on helppo lisätä ois vaan ollu vielä parempi jos sellanen ois ollu.
mun piti tehä se tohonkin (v1.0) mutta unohtu...
Hieno/toimiva! (siis tuo uudempi versio)
laskujärjestys on muuten: sulut, kerto, jako, plus ja miinus eikä sulut, plus, miinus, kerto, jako. noh, eihän sillä oikeastaan väliä ole; kunhan sanoin.. kuitenkin vaikuttaa hyvältä (en ole VIELÄ kokeillut)