QB / QB64 Discussion Forum      Other Subforums, Links and Downloads

Respond to this messageReturn to Index
Original Message
  • chain, guess, test, and revise
    • (Login MCalkins)
      Moderator
      Posted May 19, 2011 10:26 PM

      It is not pretty, nor exact, but it seems to work.
      Thanks for the challenge. I started about 10 pm, and it's about 12:25 am now.
      Regards,
      Michael

      P.S.

      I've edited it to allow things like:

      a(2)=10
      (2)a=10
      a.5=10

      Be advised that entering a string without an equals sign or without expressions on both sides of the equals sign will cause an error. Causing division by zero will cause an error. I cannot guarantee the accuracy of the results, or that the program will not get stuck in an infinite loop or cause overflow.

      ---------- linear.bas
      'Note: Overwrites "!doomed!.bas" in the current folder.
      'name this file "linear.bas"
      'public domain, may 2011, michael calkins

      DEFINT A-Z
      CONST lower = &H80000000
      CONST inc = &H10000
      CONST prec = -64 'the precision will be 2 ^ this number
      CONST doomed = "!doomed!.bas" 'this file will be overwritten!
      CONST me = "linear.bas"

      COMMON c AS INTEGER
      DIM n AS INTEGER
      DIM a AS INTEGER
      DIM v AS INTEGER
      DIM e AS INTEGER
      DIM s AS STRING
      DIM sb AS STRING
      DIM q AS STRING * 1

      's = "4p+p-5.5 = 10+2p/3-1/3"

      IF c THEN SYSTEM
      PRINT
      PRINT
      q = CHR$(&H22)
      IF LEN(s) = 0 THEN
      PRINT "enter a linear equation using one variable, a single letter."
      LINE INPUT s
      END IF
      s = LCASE$(s)
      i = 1
      DO WHILE i <= LEN(s)
      n = ASC(MID$(s, i, 1))
      SELECT CASE n
      CASE &H61 TO &H7A
      v = n
      MID$(s, i, 1) = "p"
      IF i >= 2 THEN
      a = ASC(MID$(s, i - 1, 1))
      IF ((a >= &H30) AND (a <= &H39)) OR (a = &H29) THEN
      s = LEFT$(s, i - 1) + "*" + MID$(s, i)
      i = i + 1
      END IF
      END IF
      IF i < LEN(s) THEN
      a = ASC(MID$(s, i + 1, 1))
      IF ((a >= &H30) AND (a <= &H39)) OR (a = &H28) OR (a = &H2E) THEN
      s = LEFT$(s, i) + "*" + MID$(s, i + 1)
      END IF
      END IF
      CASE &H3D
      e = i
      END SELECT
      i = i + 1
      LOOP
      sb = MID$(s, e + 1)
      s = LEFT$(s, e - 1)
      'PRINT s
      'PRINT sb
      OPEN "!doomed!.bas" FOR OUTPUT AS 1
      PRINT #1, "defint a-z"
      PRINT #1, "dim p as double"
      PRINT #1, "dim i as double"
      PRINT #1, "dim o as double"
      PRINT #1, "dim d as double"
      PRINT #1, "dim od as double"
      PRINT #1, "common c as integer"
      PRINT #1, "i="; inc
      PRINT #1, "od=0"
      PRINT #1, "p="; lower
      PRINT #1, "o="; lower
      PRINT #1, "do"
      PRINT #1, "d=abs((" + s + ")-(" + sb + "))"
      PRINT #1, "if d=0 then"
      PRINT #1, "print " + q + CHR$(v) + "=" + q + "ltrim$(str$(p))"
      PRINT #1, "exit do"
      PRINT #1, "end if"
      PRINT #1, "if od=0 then od=d"
      PRINT #1, "if d>od then"
      PRINT #1, "od=0"
      PRINT #1, "p=o-i"
      PRINT #1, "i=i/2"
      PRINT #1, "if i<"; 2 ^ prec; "then"
      PRINT #1, "print " + q + CHR$(v) + "รท" + q + "ltrim$(str$(p))"
      PRINT #1, "exit do"
      PRINT #1, "end if"
      PRINT #1, "else"
      PRINT #1, "od=d"
      PRINT #1, "o=p"
      PRINT #1, "end if"
      PRINT #1, "p=p+i"
      PRINT #1, "loop"
      PRINT #1, "chain " + q + me + q
      CLOSE
      c = -1
      CHAIN doomed
    Login Status
  • You are not logged in
    • Login
      Password
       

      Optional
      Provides additional benefits such as notifications, signatures, and user authentication.


      Create Account
    Your Name
    Your Email
    (Optional)
    Message Title
    Message Text
    Options Also send responses to my email address
          


     Copyright © 1999-2014 Network54. All rights reserved.   Terms of Use   Privacy Statement