Solving lineair equations

Post Reply
Henko
Posts: 814
Joined: Tue Apr 09, 2013 12:23 pm
My devices: iPhone,iPad
Windows
Location: Groningen, Netherlands
Flag: Netherlands

Solving lineair equations

Post by Henko »

rem solving a set of n lineair equations with n unknowns
rem
option base 1
dim mat(7,7),inv(7,7),x(7),rhs(7)
mat(1,1)=0
inv(1,1)=0
rhs(1)=0
x(1)=0
draw color 0,0,0
fill color .8,.8,.8
get_n:
input "Enter the number of equations (2 - 7)":n
if n<2 or n>7 then goto get_n
graphics
cls
orient:
if screen_width()<900 then
  draw font size 40
  draw text "please rotate to landscape" at 50,300
  draw font size 20
  goto orient
  end if
cls
top=100
wide=99*n
hght=29+30*n
draw text "Enter the values of the coefficients" at 30,30
draw text "(press Return key to accept each value entry!)" at 30,60
win_open ("Coefficients",30,top,30+wide,top+hght)
draw text "x" at 35+wide,top+hght/2
win_open ("unknown",52+wide,top,160+wide,top+hght)
draw text "=" at 165+wide,top+hght/2
win_open ("RHS",182+wide,top,276+wide,top+hght)
mat_in (n,n,mat,35,top+30)
fill rect 30,30 to 500,50
draw text "Enter the values of the right hand side (RHS)" at 30,30
vec_in (n,rhs,187+wide,top+30)
                        rem End of user interface
mat_inv (n,mat,inv)
mat_vec (n,n,inv,rhs,x)
vec_out ("",n,x,55+wide,top+36,8,2)
end

def win_open (title$,xtop,ytop,xbot,ybot)
r=10
draw color 0,0,0
draw size 4
draw circle xtop,ytop to xtop+20,ytop+20
draw circle xbot-20,ytop to xbot,ytop+20
draw circle xtop,ybot-20 to xtop+20,ybot
draw circle xbot-20,ybot-20 to xbot,ybot
draw line xtop+r,ytop to xbot-r,ytop
draw line xtop+r,ybot to xbot-r,ybot
draw line xtop,ytop+r to xtop,ybot-r
draw line xbot,ytop+r to xbot,ybot-r
fill rect xtop+r,ytop+2 to xbot-r,ybot-2
fill rect xtop+2,ytop+r to xbot-2,ybot-r
if title$<>"" then
  l=(xbot-xtop-12*len(title$))/2
  draw line xtop,ytop+24 to xbot,ytop+24
  draw color 0,0,1
  draw text title$ at xtop+l,ytop-2
  draw color 0,0,0
  end if
end def

def n2a$(num,lang,dec)
b$="               "
fac=10^dec
num$=int(fac*num+.5)/fac
tot=lang-len(num$)
if tot<1 then tot=1
a$=substr$(b$,1,tot) & num$
n2a$=a$
end def

def vec_in (n,v(),x,y)
dim b$(20)
for i=1 to n
b$(i)="      a" & i
field b$(i) text b$(i) at x,y+30*(i-1) size 80,25
next i
som=0
loop:
for i=1 to n
if field_changed(b$(i)) then
  v(i)=field_text$(b$(i))
  field b$(i) delete
  draw text n2a$(v(i),6,2) at x,y+30*(i-1)
  som=som+1
end if
next i
if som<n then goto loop
end def

def vec_out (n$,n,v(),x,y,l,d)
ys=y-35
if n$<>"" then
  draw text n$ at x,y
  ys=ys+30
end if
for i=1 to n
  a$=n2a$(v(i),l,d)
  draw text a$ at x-12,ys+30*i
next i
end def

def mat_in (n,m,mat(,),x,y)
dim b$(100)
b$(1)=0
for i=1 to n
  for j=1 to m
    k=m*(i-1)+j
    b$(k)="     a" & i & j
    tt$=b$(k)
    field tt$ text tt$ at x+100*(j-1),y+30*(i-1) size 80,25
  next j
next i
som=0
loop1:
for i=1 to n
  for j=1 to m
    k=m*(i-1)+j
    if field_changed(b$(k)) then
      mat(i,j)=field_text$(b$(k))
      field b$(k) delete
      draw text n2a$(mat(i,j),6,2) at x+100*(j-1),y+30*(i-1)
      som=som+1
    end if
  next j
next i
if som<n*m then goto loop1
end def

def mat_inv (nvar,a(,),ainv(,))
dim w(7,14)                      
for i=1 TO nvar                 
  for j=1 TO nvar
    w(i,j)=a(i,j)
    w(i,j+nvar)=0 
    next j
  w(i,i+nvar)=1
  next i
for piv=1 TO nvar
  fac=w(piv,piv)
  for j=piv TO piv+nvar
    w(piv,j)=w(piv,j)/fac
    next j
  for i=1 TO nvar
    IF i<>piv then
      fac=w(i,piv)
      for j=piv TO piv+nvar
        w(i,j)=w(i,j)-fac*w(piv,j)
        next j
      endif
    next i
  next piv
for i=1 TO nvar
  for j=1 TO nvar
    ainv(i,j)=w(i,j+nvar)
    next j
  next i
end def

def mat_vec (n,m,mat(,),vin(),vuit())
for i=1 to n
  tot=0
  for j=1 to m
    tot=tot+mat( i,j)*vin(j)
  next j
  vuit(i)=tot
next i
end def

def cls()
fill rect 0,0 to screen_width(),screen_height()
end def
Last edited by Henko on Sun May 26, 2013 11:46 am, edited 1 time in total.

User avatar
Dutchman
Posts: 851
Joined: Mon May 06, 2013 9:21 am
My devices: iMac, iPad Air, iPhone
Location: Netherlands
Flag: Netherlands

Re: Solving lineair equations

Post by Dutchman »

Hello Henk (Oldie?)
I am getting some beginners-experience with smart basic by running and experimenting with some programs.
This program does not run under version 2.1
It gives an error on v(i)=field_text$(b$(i)) telling : variable is used incorrectly.
It is in the function Vec_in
I can not find the solution. (i am a beginner on SmartBasic)
Can you or somebody else please help?

Operator
Posts: 138
Joined: Mon May 06, 2013 5:52 am

Re: Solving lineair equations

Post by Operator »

Looks like arrays must be defined otherwise
in the functions:... X() or Y(,).... starting with version (?)

Check this: Works Now :)


rem solving a set of n lineair equations with n unknowns
rem
option base 1
dim mat(7,7),inv(7,7),x(7),rhs(7)
mat(1,1)=0
inv(1,1)=0
rhs(1)=0
x(1)=0
draw color 0,0,0
fill color .8,.8,.8
get_n:
input "Enter the number of equations (2 - 7)":n
if n<2 or n>7 then goto get_n
graphics
cls
orient:
if screen_width()<900 then
draw font size 40
draw text "please rotate to landscape" at 50,300
draw font size 20
goto orient
end if
cls
top=100
wide=99*n
hght=29+30*n
draw text "Enter the values of the coefficients" at 30,30
draw text "(press Return key to accept each value entry!)" at 30,60
win_open ("Coefficients",30,top,30+wide,top+hght)
draw text "x" at 35+wide,top+hght/2
win_open ("unknown",52+wide,top,160+wide,top+hght)
draw text "=" at 165+wide,top+hght/2
win_open ("RHS",182+wide,top,276+wide,top+hght)
mat_in (n,n,mat,35,top+30)
fill rect 30,30 to 500,50
draw text "Enter the values of the right hand side (RHS)" at 30,30
vec_in (n,rhs,187+wide,top+30)
rem End of user interface
mat_inv (n,mat,inv)
mat_vec (n,n,inv,rhs,x)
vec_out ("",n,x,55+wide,top+36,8,2)
end

def win_open (title$,xtop,ytop,xbot,ybot)
r=10
draw color 0,0,0
draw size 4
draw circle xtop,ytop to xtop+20,ytop+20
draw circle xbot-20,ytop to xbot,ytop+20
draw circle xtop,ybot-20 to xtop+20,ybot
draw circle xbot-20,ybot-20 to xbot,ybot
draw line xtop+r,ytop to xbot-r,ytop
draw line xtop+r,ybot to xbot-r,ybot
draw line xtop,ytop+r to xtop,ybot-r
draw line xbot,ytop+r to xbot,ybot-r
fill rect xtop+r,ytop+2 to xbot-r,ybot-2
fill rect xtop+2,ytop+r to xbot-2,ybot-r
if title$<>"" then
l=(xbot-xtop-12*len(title$))/2
draw line xtop,ytop+24 to xbot,ytop+24
draw color 0,0,1
draw text title$ at xtop+l,ytop-2
draw color 0,0,0
end if
end def

def n2a$(num,lang,dec)
b$=" "
fac=10^dec
num$=int(fac*num+.5)/fac
tot=lang-len(num$)
if tot<1 then tot=1
a$=substr$(b$,1,tot) & num$
n2a$=a$
end def

def vec_in (n,v(),x,y)
dim b$(20)
for i=1 to n
b$(i)=" a" & i
field b$(i) text b$(i) at x,y+30*(i-1) size 80,25
next i
som=0
loop:
for i=1 to n
if field_changed(b$(i)) then
v(i)=field_text$(b$(i))
field b$(i) delete
draw text n2a$(v(i),6,2) at x,y+30*(i-1)
som=som+1
end if
next i
if som<n then goto loop
end def

def vec_out (n$,n,v(),x,y,l,d)
ys=y-35
if n$<>"" then
draw text n$ at x,y
ys=ys+30
end if
for i=1 to n
a$=n2a$(v(i),l,d)
draw text a$ at x-12,ys+30*i
next i
end def

def mat_in (n,m,mat(,),x,y)
dim b$(100)
b$(1)=0
for i=1 to n
for j=1 to m
k=m*(i-1)+j
b$(k)=" a" & i & j
tt$=b$(k)
field tt$ text tt$ at x+100*(j-1),y+30*(i-1) size 80,25
next j
next i
som=0
loop1:
for i=1 to n
for j=1 to m
k=m*(i-1)+j
if field_changed(b$(k)) then
mat(i,j)=field_text$(b$(k))
field b$(k) delete
draw text n2a$(mat(i,j),6,2) at x+100*(j-1),y+30*(i-1)
som=som+1
end if
next j
next i
if som<n*m then goto loop1
end def

def mat_inv (nvar,a(,),ainv(,))
dim w(7,14)
for i=1 TO nvar
for j=1 TO nvar
w(i,j)=a(i,j)
w(i,j+nvar)=0
next j
w(i,i+nvar)=1
next i
for piv=1 TO nvar
fac=w(piv,piv)
for j=piv TO piv+nvar
w(piv,j)=w(piv,j)/fac
next j
for i=1 TO nvar
IF i<>piv then
fac=w(i,piv)
for j=piv TO piv+nvar
w(i,j)=w(i,j)-fac*w(piv,j)
next j
endif
next i
next piv
for i=1 TO nvar
for j=1 TO nvar
ainv(i,j)=w(i,j+nvar)
next j
next i
end def

def mat_vec (n,m,mat(,),vin(),vuit())
for i=1 to n
tot=0
for j=1 to m
tot=tot+mat(i,j)*vin(j)
next j
vuit(i)=tot
next i
end def

def cls()
fill rect 0,0 to screen_width(),screen_height()
end def
Last edited by Operator on Fri May 24, 2013 3:21 pm, edited 2 times in total.

Operator
Posts: 138
Joined: Mon May 06, 2013 5:52 am

Re: Solving lineair equations

Post by Operator »

@Henko:
Forgot to mention: Ultra Very Nice :D
( now that I run it on my iPad mini )
( 99% of the time used by my wife )

Henko
Posts: 814
Joined: Tue Apr 09, 2013 12:23 pm
My devices: iPhone,iPad
Windows
Location: Groningen, Netherlands
Flag: Netherlands

Re: Solving lineair equations

Post by Henko »

Dutchman wrote:Hello Henk (Oldie?)
I am getting some beginners-experience with smart basic by running and experimenting with some programs.
This program does not run under version 2.1
It gives an error on v(i)=field_text$(b$(i)) telling : variable is used incorrectly.
It is in the function Vec_in
I can not find the solution. (i am a beginner on SmartBasic)
Can you or somebody else please help?
Operator already indicated the problem and the solution. This program was published before the modification re. the way arrays are passed to functions.
And... Indeed my nickname at the Basic forum was "Oldie". Left there because of several reasons, but in short:
"Basic!" is a TOY and smartBasic is a TOOL (IMHO).
Henk

User avatar
Dutchman
Posts: 851
Joined: Mon May 06, 2013 9:21 am
My devices: iMac, iPad Air, iPhone
Location: Netherlands
Flag: Netherlands

Re: Solving lineair equations

Post by Dutchman »

I agree, therefore I'll say bye to Basic!
Nice to meet you here again. :D

Henko
Posts: 814
Joined: Tue Apr 09, 2013 12:23 pm
My devices: iPhone,iPad
Windows
Location: Groningen, Netherlands
Flag: Netherlands

Re: Solving lineair equations

Post by Henko »

After 5 years it's time for an update of this little tool, using some new SB facilities.
The calculation is performed as soon as each cell has been entered. The solution appears in the white fields. After this, each individual cell of the coefficient matrix or the right hand side values may be modified, upon which an immediate recalculation takes place. The maximum number of equations is 6. Larger systems are usually generated within an application, and not entered manually.

Code: Select all

init_prog()
dim m(n,n),mi(n,n),mm(n,n),x(n),r(n),rr(n)
do slowdown
for i=1 to n ! for j=1 to n
  if b_p("m"&i&j) then
    m(i,j)=numpad(0,0) ! button "m"&i&j text m(i,j) ! mm(i,j)=1
    m_ok=check_m(n,mm)
    if m_ok then
      if mat_inv(n,m,mi)=0 then error()
      if r_ok then
        mat_vec(n,n,mi,r,x)
        for k=1 to n ! field "x"&k text x(k) ! next k
        end if
      end if
    end if
  next j ! next i
for i=1 to n
  if b_p("r"&i) then
    r(i)=numpad(0,0) ! button "r"&i text r(i) ! rr(i)=1
    r_ok=check_r(n,rr)
    if m_ok and r_ok then
      mat_vec(n,n,mi,r,x)
      for k=1 to n ! field "x"&k text x(k) ! next k
      end if
    end if
  next i
if b_p("quit") then stop
until forever
end

def check_m(n,mm(,))
for i=1 to n ! for j=1 to n
  if mm(i,j)=0 then return 0
  next j ! next i
return 1
end def

def check_r(n,rr())
for i=1 to n ! if rr(i)=0 then return 0 ! next i
return 1
end def

def error()
m$="system cannot be solved (singular matrix?)"
draw text m$ at 30,init_prog.ye+20
stop
end def

def init_prog()
set toolbar off ! option base 1
init_numpad(30,300,60,.7,.7,.7,1)
set orientation 1 ! get screen size sw,sh
bx=100 ! by=40 ! spx=12 ! spy=25
n_or=floor((sw-5*spx-2*bx-80)/(spx+bx))
n_max=floor((sh-5*spx-2*bx-80)/(spx+bx))
print "# of equations? "; ! n=numpad(0,n_max) ! .n=n
if n>n_or then set orientation 2
x1=10 ! x2=x1+(n+1)*spx+n*bx ! x3=x2+30
x4=x3+bx+2*spx ! x5=x4+30 ! x6=x5+bx+2*spx
graphics ! graphics clear ! draw color 0,0,0
draw font size 20 ! set buttons font size 20
for i=1 to n
  ye=20+(i-1)*(by+spy)
  field "x"&i text "" at x3+spx,ye size bx,by RO
  button "r"&i text "" at x5+spx,ye size bx,by
  for j=1 to n
    xb=x1+spx+(j-1)*(spx+bx)
    button "m"&i&j text "" at xb,ye size bx,by
    next j
  next i
draw size 3 ! ye=20+(n-1)*(by+spy)+by
xx=x1+7 ! draw line xx,20 to xx,ye
draw line xx,20 to xx+8,20 ! draw line xx,ye to xx+8,ye
xx=x2-7 ! draw line xx,20 to xx,ye
draw line xx,20 to xx-8,20 ! draw line xx,ye to xx-8,ye
xx=x3+7 ! draw line xx,20 to xx,ye
draw line xx,20 to xx+5,20 ! draw line xx,ye to xx+5,ye
xx=x4-7 ! draw line xx,20 to xx,ye
draw line xx,20 to xx-5,20 ! draw line xx,ye to xx-5,ye
xx=x5+7 ! draw line xx,20 to xx,ye
draw line xx,20 to xx+8,20 ! draw line xx,ye to xx+8,ye
xx=x6-7 ! draw line x6-8,20 to x6-8,ye
draw line xx,20 to xx-8,20 ! draw line xx,ye to xx-8,ye
draw font size 40
draw text "*" at x2+4,ye/2 ! draw text "=" at x4+4,ye/2
draw font size 20
button "quit" text "Stop" at 20,ye+50 size 120,50
.m_ok=0 ! .r_ok=0
end def

def init_numpad(xtop,ytop,bs,R,G,B,alpha)
name$="numpad" ! cn=10
page name$ set 
page name$ frame xtop,ytop,0,0
set buttons custom
if bs<20 then bs=20
sp=4 ! th=.5*bs+4 ! ww=4*bs+5*sp ! hh=th+4*bs+6*sp
fsize=.5*bs
draw font size fsize ! set buttons font size fsize
draw color 1,1,1 ! fill color .7,.7,.7
button "rec" title "" at 0,0 size ww,hh
button "res" title "" at 0,0 size ww,th+4
fill color R,G,B ! fill alpha alpha
button "0" title "0" at sp,th+3*bs+5*sp size bs,bs
for k=1 to 9
  x=(k-1)%3 ! y=2-floor((k-1)/3)
  button k title k at (x+1)*sp+x*bs,th+y*bs+(y+2)*sp size bs,bs
  next k
button "-" title "-" at 2*sp+bs,th+3*bs+5*sp size bs,bs
button "." title "." at 3*sp+2*bs,th+3*bs+5*sp size bs,bs
button "Cl" title "C" at 4*sp+3*bs,th+2*sp size bs,bs
button "del" title "<-" at 4*sp+3*bs,th+bs+3*sp size bs,bs
button "ok" title "ok" at 4*sp+3*bs,th+2*bs+4*sp size bs,2*bs+sp
page name$ hide
page name$ frame xtop,ytop,ww,hh
end def

def numpad(minval,maxval)
page "numpad" set ! page "numpad" show
a$="" ! pflag=0 ! sflag=0 ! ob=1-option_base()
nump1:
if b_p("ok") then
  number=val(a$) ! a$="" ! button "res" text ""
  if minval<>0 or maxval<>0 then
    if number<minval or number>maxval then
      button "res" text "range error"
      pflag=0 ! a$="" ! pause 1
      button "res" text ""
      goto nump1
      end if
    end if
  page "numpad" hide ! page "" set
  return number
  end if
if b_p("Cl") then
  a$ = "" ! pflag=0 ! sflag=0 ! goto nump3
  end if
if b_p("del") and len(a$) then
  ll=len(a$) ! if substr$(a$,ll-ob,ll-ob)="." then pflag=0
  a$ = left$(a$,ll-1) ! sflag=0 ! goto nump3
  end if
if b_p("-") then
  a$ = "-" ! pflag=0 ! sflag=0 ! goto nump3
  end if
if b_p(".") and not pflag and not sflag then
  a$ &= "." ! pflag=1 ! goto nump3
  end if
for k=0 to 9
  t$=k
  if b_p(t$) and not sflag then
    a$ &= t$ ! goto nump3
    end if
  next k
goto nump1
nump3:
if len(a$)>10 then ! sflag=1 ! goto nump1 ! end if
button "res" text a$
goto nump1
end def

' produce the inverse of square matrix a() giving matrix ainv()
' returns 1 on success, 0 if matrix is singular
'
def mat_inv (nvar,a(,),ainv(,))
dim w(nvar,2*nvar)                      
for i=1 to nvar                 
  for j=1 to nvar ! w(i,j)=a(i,j) ! w(i,j+nvar)=0  ! next j
  w(i,i+nvar)=1
  next i
for piv=1 to nvar
  fac=w(piv,piv) ! if fac=0 then return 0
  for j=piv to piv+nvar ! w(piv,j)=w(piv,j)/fac ! next j
  for i=1 to nvar
    if i<>piv then
      fac=w(i,piv)
      for j=piv to piv+nvar ! w(i,j)=w(i,j)-fac*w(piv,j) ! next j
      endif
    next i
  next piv
for i=1 to nvar
  for j=1 to nvar ! ainv(i,j)=w(i,j+nvar) ! next j
  next i
return 1
end def

' produce product of a matrix and a vector vin(), giving vout()
' the matrix has size nxm, the vin() has size m, vout() has size n
'
def mat_vec (n,m,mat(,),vin(),vout())
dim v(n)
for i=1 to n
  tot=0
  for j=1 to m ! tot=tot+mat( i,j)*vin(j) ! next j
  v(i)=tot
next i
for i=1 to n ! vout(i)=v(i) ! next i
end def

def b_p(but$) = button_pressed(but$)
IMG_1474.PNG
IMG_1474.PNG (1.31 MiB) Viewed 6295 times

Henko
Posts: 814
Joined: Tue Apr 09, 2013 12:23 pm
My devices: iPhone,iPad
Windows
Location: Groningen, Netherlands
Flag: Netherlands

Re: Solving lineair equations

Post by Henko »

A slight error removed (minimum # of equations now 1 instead of 0) and some remarks in the code.

Code: Select all

' solve a set of linear equations (max. 6 equations)
' easy handling of variations in matrix or RHS vector
' 27-02-2018 by Henko
' 
init_prog()
dim m(n,n),mi(n,n),mm(n,n),x(n),r(n),rr(n)
do slowdown
for i=1 to n ! for j=1 to n
  if b_p("m"&i&j) then           ' check entries in the  matrix
    m(i,j)=numpad(0,0) ! button "m"&i&j text m(i,j) ! mm(i,j)=1
    m_ok=check_m(n,mm)
    if m_ok then                 ' matrix completed ?
      if mat_inv(n,m,mi)=0 then error()
      if r_ok then solve()       ' RHS vector also completed ?
      end if
    end if
  next j ! next i
for i=1 to n 
  if b_p("r"&i) then          ' check entries in the RHS vector
    r(i)=numpad(0,0) ! button "r"&i text r(i) ! rr(i)=1
    r_ok=check_r(n,rr)
    if m_ok and r_ok then solve() ' all completed ?
    end if
  next i
if b_p("quit") then stop
until forever
end

def check_m(n,mm(,))
for i=1 to n ! for j=1 to n
  if mm(i,j)=0 then return 0
  next j ! next i
return 1
end def

def check_r(n,rr())
for i=1 to n ! if rr(i)=0 then return 0 ! next i
return 1
end def

def error()
m$="system cannot be solved (singular matrix?)"
draw text m$ at 30,init_prog.ye+20
' stop
end def

def solve()
mat_vec(.n,.n,.mi,.r,.x)
for k=1 to .n ! field "x"&k text .x(k) ! next k
end def

def init_prog()
set toolbar off ! option base 1
init_numpad(30,300,60,.7,.7,.7,1)
set orientation 1 ! get screen size sw,sh
bx=100 ! by=40 ! spx=12 ! spy=25
n_or=floor((sw-5*spx-2*bx-80)/(spx+bx))
n_max=floor((sh-5*spx-2*bx-80)/(spx+bx))
print "# of equations? "; ! n=numpad(1,n_max) ! .n=n
if n>n_or then set orientation 2
x1=10 ! x2=x1+(n+1)*spx+n*bx ! x3=x2+30
x4=x3+bx+2*spx ! x5=x4+30 ! x6=x5+bx+2*spx
graphics ! graphics clear ! draw color 0,0,0
draw font size 20 ! set buttons font size 20
for i=1 to n
  ye=20+(i-1)*(by+spy)
  field "x"&i text "" at x3+spx,ye size bx,by RO
  button "r"&i text "" at x5+spx,ye size bx,by
  for j=1 to n
    xb=x1+spx+(j-1)*(spx+bx)
    button "m"&i&j text "" at xb,ye size bx,by
    next j
  next i
draw size 3 ! ye=20+(n-1)*(by+spy)+by
xx=x1+7 ! draw line xx,20 to xx,ye
draw line xx,20 to xx+8,20 ! draw line xx,ye to xx+8,ye
xx=x2-7 ! draw line xx,20 to xx,ye
draw line xx,20 to xx-8,20 ! draw line xx,ye to xx-8,ye
xx=x3+7 ! draw line xx,20 to xx,ye
draw line xx,20 to xx+5,20 ! draw line xx,ye to xx+5,ye
xx=x4-7 ! draw line xx,20 to xx,ye
draw line xx,20 to xx-5,20 ! draw line xx,ye to xx-5,ye
xx=x5+7 ! draw line xx,20 to xx,ye
draw line xx,20 to xx+8,20 ! draw line xx,ye to xx+8,ye
xx=x6-7 ! draw line x6-8,20 to x6-8,ye
draw line xx,20 to xx-8,20 ! draw line xx,ye to xx-8,ye
draw font size 40
draw text "*" at x2+4,ye/2 ! draw text "=" at x4+4,ye/2
draw font size 20
button "quit" text "Stop" at 20,ye+50 size 120,50
.m_ok=0 ! .r_ok=0
end def


' numerical keypad object
' 
' produce a simple keypad to quickly enter a number in an app
' upon entry, the keypad disappears
' initialize once, multiple use after
' left upper corner is placed at "xtop,ytop"
' "bs" is the button size (keypad becomes 4.3 times larger)
' size of number is accepted between "minval" and "maxval"
' if both "minval" and "maxval" are zero, then no restrictions
' max number of tokens in the number is 10 (minus and dot included)
' works for option base 0 and 1
'
def init_numpad(xtop,ytop,bs,R,G,B,alpha)
name$="numpad" ! cn=10
page name$ set 
page name$ frame xtop,ytop,0,0
set buttons custom
if bs<20 then bs=20
sp=4 ! th=.5*bs+4 ! ww=4*bs+5*sp ! hh=th+4*bs+6*sp
fsize=.5*bs
draw font size fsize ! set buttons font size fsize
draw color 1,1,1 ! fill color .7,.7,.7
button "rec" title "" at 0,0 size ww,hh
button "res" title "" at 0,0 size ww,th+4
fill color R,G,B ! fill alpha alpha
button "0" title "0" at sp,th+3*bs+5*sp size bs,bs
for k=1 to 9
  x=(k-1)%3 ! y=2-floor((k-1)/3)
  button k title k at (x+1)*sp+x*bs,th+y*bs+(y+2)*sp size bs,bs
  next k
button "-" title "-" at 2*sp+bs,th+3*bs+5*sp size bs,bs
button "." title "." at 3*sp+2*bs,th+3*bs+5*sp size bs,bs
button "Cl" title "C" at 4*sp+3*bs,th+2*sp size bs,bs
button "del" title "<-" at 4*sp+3*bs,th+bs+3*sp size bs,bs
button "ok" title "ok" at 4*sp+3*bs,th+2*bs+4*sp size bs,2*bs+sp
page name$ hide
page name$ frame xtop,ytop,ww,hh
end def

def numpad(minval,maxval)
page "numpad" set ! page "numpad" show
a$="" ! pflag=0 ! sflag=0 ! ob=1-option_base()
nump1:
if b_p("ok") then
  number=val(a$) ! a$="" ! button "res" text ""
  if minval<>0 or maxval<>0 then
    if number<minval or number>maxval then
      button "res" text "range error"
      pflag=0 ! a$="" ! pause 1
      button "res" text ""
      goto nump1
      end if
    end if
  page "numpad" hide ! page "" set
  return number
  end if
if b_p("Cl") then
  a$ = "" ! pflag=0 ! sflag=0 ! goto nump3
  end if
if b_p("del") and len(a$) then
  ll=len(a$) ! if substr$(a$,ll-ob,ll-ob)="." then pflag=0
  a$ = left$(a$,ll-1) ! sflag=0 ! goto nump3
  end if
if b_p("-") then
  a$ = "-" ! pflag=0 ! sflag=0 ! goto nump3
  end if
if b_p(".") and not pflag and not sflag then
  a$ &= "." ! pflag=1 ! goto nump3
  end if
for k=0 to 9
  t$=k
  if b_p(t$) and not sflag then
    a$ &= t$ ! goto nump3
    end if
  next k
goto nump1
nump3:
if len(a$)>10 then ! sflag=1 ! goto nump1 ! end if
button "res" text a$
goto nump1
end def

' produce the inverse of square matrix a() giving matrix ainv()
' returns 1 on success, 0 if matrix is singular
'
def mat_inv (nvar,a(,),ainv(,))
dim w(nvar,2*nvar)                      
for i=1 to nvar                 
  for j=1 to nvar ! w(i,j)=a(i,j) ! w(i,j+nvar)=0  ! next j
  w(i,i+nvar)=1
  next i
for piv=1 to nvar
  fac=w(piv,piv) ! if fac=0 then return 0
  for j=piv to piv+nvar ! w(piv,j)=w(piv,j)/fac ! next j
  for i=1 to nvar
    if i<>piv then
      fac=w(i,piv)
      for j=piv to piv+nvar ! w(i,j)=w(i,j)-fac*w(piv,j) ! next j
      endif
    next i
  next piv
for i=1 to nvar
  for j=1 to nvar ! ainv(i,j)=w(i,j+nvar) ! next j
  next i
return 1
end def

' produce product of a matrix and a vector vin(), giving vout()
' the matrix has size nxm, the vin() has size m, vout() has size n
'
def mat_vec (n,m,mat(,),vin(),vout())
dim v(n)
for i=1 to n
  tot=0
  for j=1 to m ! tot=tot+mat( i,j)*vin(j) ! next j
  v(i)=tot
next i
for i=1 to n ! vout(i)=v(i) ! next i
end def

def b_p(but$) = button_pressed(but$)

ingab
Posts: 1
Joined: Tue Dec 09, 2014 7:55 am

Re: Solving lineair equations

Post by ingab »

Is it possible to use complex numbers also?
Thanks in advance.

Andrew

Henko
Posts: 814
Joined: Tue Apr 09, 2013 12:23 pm
My devices: iPhone,iPad
Windows
Location: Groningen, Netherlands
Flag: Netherlands

Re: Solving lineair equations

Post by Henko »

Not in the present program, as the coefficients are not entered using the standard "keyboard", but with a homebrew little numeric pad (called "numpad"). And this little thing does not have the "i" and "+" signs which are needed to enter complex numbers.

But mathematically, it is quite possible. If the coefficients in the equations and/or in the right hand side are complex, then the system has a solution, and this solution is always complex as well.

I tested this using the matrix inversion function in my "matlib" library to solve a complex system of lineair equations and it produces a correct result, without any modification in the code! (This is a compliment, not for the coding but for the SB interpreter).

Post Reply