Δευτέρα, 15 Οκτωβρίου 2018

Rational Numbers Class

This is a Rational Numbers class and an example.
Rosetta code - 1st publishing
Using a part of this class to find perfect numbers
Another way to find perfect numbers using primes

Added pz as pointer to rational number. Operators works ok with pointers but return a new rational number not a pointer.
We can get a pointer if we wish:
      zzz->(pk+pk)
      Print zzz=>toString$



Module RationalNumbers {
      Class Rational {
            numerator as decimal, denominator as decimal
            gcd=lambda->0
            lcm=lambda->0
            operator "+" {
                 Read l
                 denom=.lcm(l.denominator, .denominator)
                 .numerator<=denom/l.denominator*l.numerator+denom/.denominator*.numerator
                 if .numerator==0 then denom=1
                 .denominator<=denom
            }
            Operator Unary {
                  .numerator-!
            }
            Operator "-" {
                  Read l
                  Call Operator "+", -l
            }
            Operator "*" {
                  Read l
                  g1=.gcd(l.numerator,.denominator)
                  g2=.gcd(.numerator, l.denominator)
                  Push l.numerator/g1*.numerator/g2
                  Push l.denominator/g2*.denominator/g1
                  Read .denominator, .numerator

            }
            Function Inverse {
                  if .numerator==0 then Error "Division by zero"
                  ret=This
                  sign=sgn(ret.numerator) : if sign<0 then ret.numerator-!
                  swap ret.numerator, ret.denominator
                  if sign<0 then ret.numerator-!
                  =ret
            }
            Operator "/" {
                  Read l
                  call operator "*", l.inverse()
            }
            Function Power {
                  Read pow as long
                  ret=This
                  ret.numerator<=.numerator^pow
                  ret.denominator<=.denominator^pow
                  =ret
            }
            Operator "=" {
                  Read l
                  Def boolean T=True, F=False
                  if Abs(sgn(l.numerator))+Abs(sgn(.numerator))=0 then Push T: exit
                  if sgn(l.numerator) <>sgn(.numerator) then Push F : exit
                  pcomp=l/this
                  PUSH pcomp.numerator=1 and pcomp.denominator=1
            }
            Operator ">" {
                  Read l
                  Def boolean F
                  if Abs(sgn(l.numerator))+Abs(sgn(.numerator))=0 then Push F: exit
                  if sgn(l.numerator)=0 then {
                        PUSH .numerator>0
                  } Else {
                        pcomp=this/l
                        PUSH pcomp.real>1
                  }
            }
            Operator ">=" {
                  Read l
                  if sgn(l.numerator)=0 then {
                        PUSH .numerator>=0
                  } Else {
                        pcomp=this/l
                        PUSH pcomp.real>=1
                  }
            }      
            Operator "<" {
                  Read l
                  Def boolean F
                  if Abs(sgn(l.numerator))+Abs(sgn(.numerator))=0 then Push F: exit
                  if sgn(l.numerator)=0 then {
                        PUSH .numerator<0
                  } Else {
                        pcomp=this/l
                        PUSH pcomp.real<1
                  }
            }
            Operator "<=" {
                  Read l
                  if sgn(l.numerator)=0 then {
                        PUSH .numerator<=0
                  } Else {
                        pcomp=this/l
                        PUSH pcomp.real<=1
                  }            
            }
            Operator "<>" {
                  Read l
                  if sgn(l.numerator)=0 then {
                        PUSH .numerator<>0
                  } Else {
                        pcomp=this/l
                        PUSH pcomp.real<>1
                  }            
            }
            Group Real {
                  value {
                        link parent numerator, denominator to n, d
                        =n/d
                  }
            }
            Group ToString$ {
                 value {
                        link parent numerator, denominator to n, d
                        =Str$(n)+"/"+Str$(d,"")
                  }      
            }
            class:
            Module Rational (.numerator, .denominator) {
                  if .denominator<=0 then Error "Positive only denominator"
                  gcd1=lambda (a as decimal, b as decimal) -> {
                        if a<b then swap a,b
                        g=a mod b
                        while g {
                              a=b:b=g: g=a mod b
                        }
                              =abs(b)
                  }
                  .gcd<=gcd1
                  .lcm<=lambda gcd=gcd1 (a as decimal, b as decimal) -> {
                        =a/gcd(a,b)*b
                  }
            }
      }
      Print rational(-3,3)<>rational(-3,3)
      M=Rational(10, 150)
      N=Rational(2, 4)
      Z=M+N
      Print Z.numerator, Z.denominator
      Print 10/150@+2/4@
      Print Z.real
      Z=-M+N
      Print Z.numerator, Z.denominator
      Print -10/150@+2/4@
      Print Z.real
      Z=M-N
      Print Z.numerator, Z.denominator
      Print 10/150@-2/4@
      Print Z.real
      Z=M*N
      Print Z.numerator, Z.denominator
      Print (10/150@)*(2/4@)
      Print Z.real
      Z=M/N
      Print Z.numerator, Z.denominator
      Print (10/150@)/(2/4@)
      Print Z.real
      Z=Z.Power(2)
      Print Z.real
      Print Z=Z
      Print Z=N
      Print Z=-Z
      ZZ=-Z
      Print ZZ=ZZ
      Print -Z=-Z
      Print Z.numerator, Z.denominator
      Print Z.real, Z.tostring$
      \\ Array of rational numbers
      Dim K(100)=rational(1,1)
      M=K(4)+K(3)
      Print M.real
      Print K(4).toString$


           pk->(Z)
      Print pk=>toString$
      zzz=pk+pk
      Print zzz.toString$

}
RationalNumbers

Τρίτη, 9 Οκτωβρίου 2018

Using Tuple (arrays in M2000),

Tuples are one dimension arrays. (,) is an empty tuple, (1,) is one item tuple, and (1,2) is two item tuple. We can include a tuple in a tuple: ((1,2), (3,4)) is a tuple with two tuples. We can use a pointer to array to hold a tuple. We can change values using Return statement, using 0 for first item always. Using ++ -- += -= *= /* -! which affect all items (not those who have objects or strings). To access an item we can use Array(Pointer2Array, 2) to get 3rd item.
We can make array pointers for multidimensional arrays, and with different bases, one for all or different value for each dimension. So Array() works using the proper base(s) and dimensions.

We see in the example below, that we can make new references A1 to C1 for A to C tuples. We can make copies when we make empty arrays A(),B$(), C() and assign values as A, B, C.  We see that C() is a shallow copy of C, which means is a new array, but any pointer in the element is a copy of pointer so we get the same objects. We can change any of this, just assign a new pointer, or we can change the array which points the pointer, so we get new values for each copy.

Second part show how we use pointers to multi dimension arrays. Also we see how we change dimension preserving items and how to add items.


Using objects (Groups) is not the same as tuples. We can use Groups without pointers, or to be precise with a single pointer, which means that we get not a copy of a pointer but always a new pointer, a deep copy of group. See  example  TestGroup, A(0).K() is different from B(0).K()

For advanced readers:
We can get a pointer to a Group (internal as a weak reference) or to a copy of group (internal as true pointer), and copy it to an array element. So in TestGroup2 we have pointer to group, and for that reason we get a shallow copy, so when we change the group in A() we get the change in B() two.
Using ->(A) we get pointer from a copy of A, and using ->A we get reference to A. The second is valid until Group A erased (at the exit of module TestGroup2). In Functions we have = as identifier to return value (Function Square(x) {=x**2}) but we can use -> to return pointer (we have to return a true pointer, so something like ->A is a fault, but not for the time we return the pointer, but when we use it, and interpreter can't resolve to actual item).



Form 80, 60
\\ Tuple of items (as one dimension arrays)
A=(1,2,3,4,5)
B=("George", 10, "Bob", 5)
C=(("George", 10),("Bob", 5))
Print Len(A)=5 ' true
Print Len(B)=4 ' true
Print Len(C)=2 ' true
\\ get reference of A to A1
A1=A
B1=B
C1=C
\\ Get Shallow Copy
Dim A(), B$(), C()
A()=A
B$()=B
C()=C
A(0)=10
Print A ' 1 2 3 4 5
Print A() ' 10 2 3 4 5
Link B$() to B()
B$(0)="Hello George"
B(1)=1000
Print B ' George 10 Bob 5
Print B$() ' Hello George 1000 Bob 5
C()=C
C(0)=("New Name", 500)
Print Array(C,0), Array(C, 1) ' George 10 Bob 5
Print C(0)(), C(1)() ' New Name 500 Bob 5
\\ Test Shallow Copy
\\ we keep pointer to second array but we change values
\\ we need a pointer to C[1]
N=Array(C,1)
\\ So we can use Return to return multiple values
Return N, 0:="New Bob", 1:=5000
\\ So Array(C,1) show us new values
Print Array(C,0), Array(C, 1) ' George 10 New Bob 5000
\\ And because we get shallow copy (pointer only) we get C(1)() array with new values
Print C(0)(), C(1)() ' New Name 500 New Bob 5000
\\ Now C(1) get a new pointer
C(1)=("Another Name", 2000)
Print Array(C,0), Array(C, 1) ' George 10 New Bob 5000
Print C(0)(), C(1)() ' New Name 500 Another Name 2000
\\ we can get a copy of A using Cons() with one argument
NewArray=Cons(A) ' copy of A
Print NewArray
NewArray2=Cons(A, A) ' add A twice
Print NewArray2
\\ Get a copy of C() to a pointer
CopyC=Cons(C())
Print Array(CopyC, 0), Array(CopyC, 1)
Return CopyC, 1:=("Just Another Name", 3000)
Print Array(CopyC, 0), Array(CopyC, 1) ' New Name 500 Just Another Name 3000
Print C(0)(), C(1)() ' New Name 500 Another Name 2000

\\ Pointers for multi dimension arrays
Dim A(2 to 10, 5 to 10)=1
M=A()
Print Len(M) = 54 ' 9X6
Print array(M, 2,5)=1 \\ M point to a 2 dimension Array
\\ Return use one dimension, so 0 is the first element
Return M, 0:=1000, 6:=5000 ' 6 is the 7th item, first in second row (row, columns)
Print array(M, 2,5)=1000, array(M, 3,5)
Dim A(2 to 11, 5 to 10) ' add one row
Print Len(M) = 60 ' 10X6
Print Type$(A(11, 5))="Empty"  ' new raw has Empty as value (in calculations this is same as 0 or empty string)
\\ So now we put a value
For i=5 to 10:A(11,i)=1:Next i
\\ we can alter last item using pointer M
Return M, 59:=9999
Print A(11, 10)=9999
\\ assuming we have defalut base 0
Dim A(10,6) ' redim preserving values
Print A(9, 5)=9999, Len(A())=60
\\ we can use Base 1 or Base 0 to explicit declare base
Dim Base 1, A(10,6) ' redim preserving values
Print A(10, 6)=9999, Len(A())=60
\\ or we can use for each dimension a new base
Dim A(5 to 14, 10 to 15) ' redim preserving values
Print A(14, 15)=9999, Len(A())=60
\\ Get dimensions, width for each dimension, base (min value) for each dimension, max value for each dimension
Print Dimension(A())=2 ' 2 dimension
Print Dimension(A(),0)=5 ' first dimension base is 5
Print Dimension(A(),1)=10 ' 10 items
Print Dimension(A(),2)=6 ' 6 items, so we have 10x6 items
Print Dimension(A(),1,0)=5
Print Dimension(A(),1,1)=14
Print Dimension(A(),2,0)=10
Print Dimension(A(),2,1)=15
\\ Copy all item to stack using pointer to array (not A() but M)
Flush  ' now stack is empty stack
Push ! M ' now get 60 items
Print stack.size=60 ' true
Stack   ' now display all stack items
Flush ' now empty stack
\\ if we use Push ! M we send values in reverse
Data ! M ' now get 60 items
\\ now all item make an array and return a pointer to Z
Z=Array([])
Print stack.size=0
Link Z to Z()
Dim Z(5 to 14, 10 to 15)
Print Z()
Print Z(14,15)=9999
Z++ ' Add 1 to all items
Print Z()
Z(14,15)-- ' Subtract 1 from one item
Print Z(14,15)



Module TestGroup {
      Group A {
            X=10
            Dim K(10)=1
      }
      Dim A(), B()
      A()=(A,)
      B()=A()
      A(0).X++
      A(0).K(0)=1000
      Print A(0).X=11, A(0).K()
      Print B(0).X=10, B(0).K()
}
TestGroup


Module TestGroup2 {
      Group A {
            X=10
            Dim K(10)=1
      }
      Dim A(), B()
      A()=(0,) ' one item
      A(0)->(A) ' now A(0) has a pointer to a copy of  A
      B()=A()
      A(0).X++
      A(0).K(0)=1000
      Print A(0).X=11, A(0).K()
      Print B(0).X=11, B(0).K()
}
TestGroup2



Κυριακή, 7 Οκτωβρίου 2018

Αναθεωρηση 22 Έκδοση 9.4

Έγιναν δυο διορθώσεις στο μεταφραστή. Μια διόρθωση λόγω πρότερου ανασχεδιασμού (refactoring) στο τμήμα που διαβάζει τα στοιχεία μιας ομάδας, και ειδικότερα στα στοιχεία Γεγονότα. Μια άλλη διόρθωση έγινε σε μια ειδική περίπτωση που σε μια Επανέλαβε Μέχρι έχουμε επιλέξει το Συνέχισε, ενώ υπάρχει ένα μπλοκ εσωτερικά, το οποίο από λάθος παίρνει και αυτό το "συνέχισε" και έτσι μπαίνει σε ατέρμονη επανάληψη. Διορθώθηκε!

Έχουν γραφτεί ωραία προγράμματα στο rosettacode.


Box the compass

Module CheckIt {
      Locale 1033 'change decimal point char to dot.
      Form 80,50 ' set console to 80 characters by 50 lines
      \\ Function heading() get a positive double as degrees and return the  compass index (1 for North)
      Function heading(d) {
            d1=d div 11.25
            if d1 mod 3= 1 then d+=5.62 :d1=d div 11.25
            =d1 mod 32 +1
      }
      Dim wind$(1 to 32)
      wind$(1)="North", "North by east", "North-northeast", "Northeast by north", "Northeast"
      wind$(6)="Northeast by east", "East-northeast", "East by north", "East", "East by south", "East-southeast"
      wind$(12)="Southeast by east", "Southeast", "Southeast by south", "South-southeast", "South by east", "South"
      wind$(18)="South by west", "South-southwest", "Southwest by south", "Southwest", "Southwest by west", "West-southwest"
      wind$(24)="West by south", "West", "West by north", "West-northwest", "Northwest by west", "Northwest", "Northwest by north"
      wind$(31)="North-northwest", "North by west"
      oldvalue=-2
      newvalue=2
      Print " angle | box | compass point"
      Print "-------+-----+---------------------"
      For i=0 to 360 step 0.005
            newvalue=heading(i)
            if (newvalue mod 3) =2 then i+=5.62: newvalue=heading(i)
            if oldvalue<>newvalue then Print format$("{0:2:-6}°|  {1::-2} | {2}",i, newvalue, wind$(newvalue)) : oldvalue=newvalue : refresh
      Next i
}
CheckIt



Animate a pendulum

Module Pendulum {
      back()
      degree=180/pi
      THETA=Pi/2
      SPEED=0
      G=9.81
      L=0.5
      Profiler
      lasttimecount=0
      cc=40 ' 40 ms every draw
      accold=0
      Every cc {
            ACCEL=G*SIN(THETA*degree)/L/50
            SPEED+=ACCEL/cc
            THETA+=SPEED
            Pendulum(THETA)
            if KeyPress(32) Then Exit
      }

      Sub back()
            If not IsWine then Smooth On
            Cls 7,0
            Pen 0
            Move 0, scale.y/4
            Draw scale.x,0
            Step -scale.x/2
            circle fill #AAAAAA, scale.x/50
            Hold ' hold this as background
      End Sub

      Sub Pendulum(x)
            x+=pi/2
            Release ' place stored background to screen
            Width scale.x/2000 {
                  Draw Angle x, scale.y/2.5
                  Width 1 {
                        Circle Fill 14, scale.x/25
                  }
                  Step Angle x, -scale.y/2.5
            }
            Print @(1,1), lasttimecount
            if sgn(accold)<>sgn(ACCEL) then lasttimecount=timecount: Profiler
            accold=ACCEL
            Refresh 1000
      End Sub
}
Pendulum




Number reversal game

Module Number_Reversal_Game {
      PRINT "Given a jumbled list of the numbers 1 to 9,"
      PRINT "you must select how many digits from the left to reverse."
      PRINT "Your goal is to get the digits in order with 1 on the left and 9 on the right."
      \\ work on a new stack - old stack parked, and attached at the exit of this block
      Stack New {
            Data 1,2,3,4,5,6,7,8,9
            \\ Create jumbled list
            For i=1 to 30: Reverse(Random(2,9)):Next i
            Tries=0
            fin=false
           Repeat {
            \\ Show Stack
                  Stack
                  Try ok {
                        INPUT " -- How many numbers should be flipped:", flp%
                  }
                  if not Ok then print: Restart
                  if flp%<2 or flp%>9 then Restart
                  Reverse(flp%)
                  Tries++
                  CheckStack(&fin)
            } until Fin
            \\ show stack again
            Stack
            PRINT "You took "; tries; " tries to put the digits in order."
      }
      Sub Reverse(n)
            Shift 1, -n ' shift one item nth times in reverse
      End Sub
      Sub CheckStack(&ok)
            ok=true
            if stack.size<2 then exit sub
            Local i
            For i=2 to stack.size {
                        ok=stackitem(i)-stackitem(i-1)=1
                        if ok else exit
            }
      End Sub
}
Number_Reversal_Game


Memory allocation
Module Checkit {
      Buffer Clear Mem1 as Byte*12345
      Print Len(Mem1)
      Hex Mem1(0) ' print in Hex address of first element
      Print Mem1(Len(Mem1)-1)-Mem1(0)+1=12345
      Buffer Mem1 as Byte*20000 ' redim block
      Print Mem1(Len(Mem1)-1)-Mem1(0)+1=20000
      Try {
            Print Mem1(20000) ' it is an error
      }
      Print Error$ ' return message: Buffer Locked, wrong use of pointer
}
Checkit