Balanced ternary (for Rosetta Code)

 https://rosettacode.org/wiki/Balanced_ternary#M2000_Interpreter

Adding a nice class for balanced ternary numbers.

module balanced_ternary {
  class ternary {
  private:  
    string val="0"
    function rev() {
        =replace("a","-", replace("-","+", replace("+","a",letter$)))
    }
    function neg() {
      a=this
      a.val=.rev(.val)
      =a
    }
    function addstr(b, c) {
      d=len(b)-len(c)
      if d<0 then
        b=string$("0", -d)+b
      else.if d>0 then
        c=string$("0", d)+c
      end if
      string f=string$("0", len(c)),e="0"
      for i=len(b) to 1
        select case mid$(b,i,1)+mid$(c,i,1)+e
        case "000", "-+0", "+-0", "-0+","+0-","0+-", "0-+"
          e="0"
        case "00+", "0+0", "+00"
          insert i,1 f="+" : e="0"
        case "00-", "0-0", "-00"
          insert i,1 f="-" : e="0"
         case "--0","-0-","0--"
          insert i,1 f="+" : e="-"
        case "++0", "+0+","0++"
          insert i,1 f="-" : e="+"
        case "++-","+-+","-++"
          insert i,1 f="+" : e="0"
        case "--+","-+-","+--"
          insert i,1 f="-" : e="0"
        case "+++"
          e="+"
        case "---"
          e="-"
        end select
      next
      if e<>"0" then =e+f else =f
    }
  public:
  ' this is for negate.tostring, negate.tostring(), negate.tostring.decimal(), negate.tostring.decimalsign()  
    group negate {
    private:
      function id {
        link parent neg() to neg()
        ' space need to break identifier to neg(
        =neg( ).tostring(![])
      }
    public:      
      group tostring {
      public:        
        function decimal() {
          link parent id() to id()
          =id(1)
        }        
        function decimalsign() {
          link parent id() to id()
          =id(2)
        }
        value (){
          link parent id() to id()
          =id(![])
        }      
      }
      value {
        link parent neg() to neg()
        =neg()
      }
    }  
    function add(a as ternary) {
      a.val<=.addstr(.val, a.val)
      =a
    }
    operator unary {
      this<=.neg()
    }
  
    operator "+" (a as ternary) {
      this<=.add(a)
    }
    operator "-" (a as ternary) {
      this<=.add(a.neg())
    }  
    operator high "*" (a as ternary) {
      this<=.mul(a)
    }
    function mul(a as ternary) {
      c=""
      s=""
      r=.rev(a.val)
      for i = len(.val) to 1 step -1
        select case mid$(.val,i,1)
        case "+"
          c=.addstr(a.val+s,c)
        case "-"
          c=.addstr(r+s,c)
        end select
        s+="0"
      next
      a.val<=c
      =a
    }
    group tostring {
        enum conv {
          asis=0, decimal, decimalsign
        }
        function decimal() {
          link &this to &m
          =m(1)
        }
        function decimalsign() {
          link &this to &m
          =m(2)
        }      
    }
    property tostring {
        value {
          long how=.asis
          read ? how
          link parent val to v
          if how=.asis then
            value=v
          else
            biginteger z=1
            biginteger acc=0
            for i=len(v) to 1
              select case mid(v,i,1)
              case "-"
                acc-=z
              case "+"
                acc+=z
              end select
              z*=3
            next
            if acc>=0 and how=.decimalsign then
              value="+"+acc  
            else
              value=""+acc
            end if
          end if      
        }
    }=""
  class:  
    module ternary (a as variant) {
      if type(a)="String" then
        a=replace(chrcode$(8722), "-", a)
        f=filter(a,"0-+")
        .val<=filter(a, f)
        if .val="" then .val<="0"
      else
        try ok {
          biginteger v=a
          f=""
          sign=sgn(v)
          v=abs(v)
          do
            select case v mod 3
            case 0
              f+="0"
              v|div 3
            case 1
              if sign<0 then f+="-" else f+="+"
              v|div 3
            case 2
              if sign<0 then f+="+" else f+="-"
              v=(v+1) div 3
            end select
          until v=0  
          .val<=strrev$(f)
        }
        if not ok then error "wrong type"
      end if
    }
  }
  ' test with big numbers:
  w="123456787890123456787890123456787890123456787890123456787901"
  print ternary(123456787890123456787890123456787890123456787890123456787890u).add(ternary(11)).tostring(1)=w
  print 123456787890123456787890123456787890123456787890123456787890u+11=biginteger(w)
  ' test as rosetta code describe:
  
  ternary a("+-0++0+"), b(-436), c("+-++-")
  print a.mul(b.add(c.negate)).tostring.decimal()="-262023"
  print a.mul(b.add(c.negate)).tostring="0----0+--0++0"
  print a.tostring.decimal()="523"
  print b.tostring.decimal()="-436"
  print c.tostring(c.tostring.decimal)="65" ' using enum value
  print c.tostring(c.tostring.asis)="+-++-" ' using enum value
  ' additional:
  def v(a as ternary)=biginteger(a.tostring.decimal())
  ' using operators:
  print v(a*(b-c))=-262023
  print v(-a*(b-c))=262023
  print v(ternary("+-0++0+")*(ternary(-436)-ternary("+-++-")))=-262023
}
balanced_ternary

Suffix Tree

 https://rosettacode.org/wiki/Suffix_tree#M2000_Interpreter

https://en.wikipedia.org/wiki/Suffix_tree

'https://rosettacode.org/wiki/Suffix_tree
Module Suffix_tree {
  Class SuffixTree {
  Private:
    Nodes=List
    ' Class definition which return a pointer to object
    Class Node {
      String sub
      ch=list
      {
        Read Node.sub, Node.ch
        ->(Node)
        break
      }
    }  
    module addSuffix (suf as String) {
      long n = 0, i = 0, x2, n2
      String b
      tmp=list
      While i < Len(suf)
        b=mid(suf,i+1,1)
        x2=0
        n2=0
        do
          children=.Nodes(n).ch
          if x2=len(children) Then
            n2=len(.Nodes)
            .Nodes(n2)=.Node(Mid$(suf, i+1))
            children(X2)=n2
            break ' Exit module
          End if
          n2=children(x2)
          if left(.Nodes(n2).sub,1)=b Then Exit ' Exit do
          x2++      
        Always
        sub2=.Nodes(n2).sub
        long j=0
        While j<len(sub2)      
          if mid(suf,i+1+j,1)<>mid(sub2, j+1,1) Then
            n3=n2
            n2=len(.Nodes)
            .Nodes(n2)=.Node(Left(sub2,j), List:=0:=n3)
            .Nodes(n3).sub=Mid(sub2, j+1)
            .Nodes(n).ch(X2)=n2
            Exit
          End if
          j++
        End While
        i+=j
        n=n2
      End While
    }    
  Public:
    module visualize {
      if len(.Nodes)=0 Then ? "<empty>":Exit
      visualize_f(0, "")    
      sub visualize_f(n as long, pre as string)
        Local children=.Nodes(n).ch
        if len(children)=0 Then
          ? "- "+.Nodes(n).sub
        Else
          ? "┐ "+.Nodes(n).sub
          Pr each(children, 1 , -2), "├─"
          Pr each(children, -1), "└─"
        End if
      End sub
      Sub Pr(ch, pre2 as string)
        While ch  
        ? pre + pre2;
        visualize_f(Eval(ch), pre + "│ ")
        End While
      End Sub
    }
  Class:
    module SuffixTree (Str as String) {
      if len(Str)=0 Then Error "need one character...at least"
      .Nodes(0)=.Node()
      for i=1 to len(Str)
          .addSuffix Mid(Str, i)
      next
    }
  }
  M=SuffixTree("banana$")
  M.visualize
}
Suffix_tree

A deque object (super stack) II - with an iterator object which export from a function;

 This is the second try. 

This is a test for the page length and check two types of walking through the items on the structure, the peek() function and the iterator object. The iterator object prepared inside a method of the object superstack. The iterator is an object which defined using the Group statement. Because we want to fill the group with values, the Group statement has code which see the variables of the function. Also we want the iterator to iterate each time we read it as a value. So this group has a value { } block which tell to interpreter that this group return value through this hidden function. This group has two properties (read only), the index (we get the current index of the "current" item) and the value (as name for property here) which return  any type of value from the item at the index. We do not use peek(index) function, so we handle the pointers through the list (and the pages, which may have variable length)

A property, lets say property index, has a hidden (private) variable behind, the [index]. so the Value { } part of property do this;make a Value variable with the value of [index] we can set the value or leave it as is, at the exit of the Value { } part the value of Value variable return as the final value. Because the value get the type from [index] we have to pass the same type (or we get a conversion, if is possible). A property Property Alfa {Value} = 0&& is a long long type (=0&& is the part which set the initial value). Also the Value has no block so we tell that Alfa is readonly, and we can alter the value from a member method of the parent object using This.[Alfa]<=500 or .[Alfa]<=500 (see the dot prefix), Properties are object too. We can add methods or other propeties adding a Group Alfa { } block.

So the test swow for page 300 and page 30, time for filling the structure (and prepare the sum), time for peeking the values and make the sum, and time for iteration through iterator object.

Using iterator is faster than filling the structure; Also using iterator has a little difference from 300 to 30 length of page. The worst time was the peeking values using 30 items per page (although the data part double the page for each new page.

What happen with the pages (which are objects Node) after the end of the module?

The two objects, a and m hold pointers. Iterator if terminate erase the pointers. At the end of module all the "named" objects destroyed, so nodes destroyed.

We can put the remove part of the object, node and we can see when and how big is each node which destroyed; (See the Remove{ } block). This functionality used for those objects which are alive (in scope) through a pointer at least.. The named like a and m they didn't use the remove part (if you wish you may have one, because either a Clear a start the remove part, or you may produce a copy and hold it through a pointer.

	Class Node {
		{z=pointer()
			Read p as long=64, z, m as boolean=false
			if m then p1=0 else p1=p
		}
		dim v(p)
		long level=p1
		long low=-1
		pRead=z
		remove {
			print "destroyed:", len(.v())
		}
	}

The block inside Node { } with no name executed as code inside the function Node(). the other code is like code inside a Group Node {type:Node. .... } block. So it is another form from Group Iterator...

' super stack v0.2
' removed onetime variable (inserted for secure reasons).
' When, in peek, we start with useThis as pFirst, we didn't get again pFirst because the count stopped 

' Iterator object. We can extract

' Data module expand each time two times, so pages have not the same length.

' st=SuperStack(12)  ' number is the page length
' stack grows using nodes, each node has an array v()
' Data, Push, Peek(index from 1), Remove index from 1, Pop or Pop(), length
' When we pop values the nodes destroyed when not have values.
' Also when we delete items then nodes deleted if there are no values from v() in use
' data append to the end of stack (FIFO)
' push push to the start of stack (LIFO)
' pop always read from start - and remove item
' peek read at index

' you can combine peek and push to do OVER (like the statement of M2000 for stacks)
' yoy can combine peek, remove, push to do SHIFT (like the statement of M2000 for stacks)

' to do:
' insert at index ' so combined with peek, insert, remove you do the SHIFTBACK (like the statement of M2000 for stacks)
' split from index to a second stack
' merge two stacks

class superstack {
private:
	Class Node {
		{z=pointer()
			Read p as long=64, z, m as boolean=false
			if m then p1=0 else p1=p
		}
		dim v(p)
		long level=p1
		long low=-1
		pRead=z
	}
	CurNode=Pointer()
	pLast=Pointer()
	pFirst=Pointer()
	long counter
	long pagelen=64, ex=2
public:
	Function Iterator {
		if .CurNode is type Null then
			Usethis=.pFirst
		else
			UseThis=.CurNode
		end if
		p=.pFirst
		if useThis is type Node then
			startLevel=useThis=>level
		else
			startLevel=.pagelen
		end if
		long c=.counter, pg
		for UseThis {
			pg=len(.v())
		}
		group Iterator {
		type:NodeIterator
		private:
			pFirst=p
			StartNode=UseThis
			max=c
			left=c
			lim=pg
			pc=startLevel-1
		public:
			property index {
				value {
					link parent max,left,pc to m,l,pc
					if pc=-1 then error "use a while loop to advance the index"
					value=m-l
				}
			}=0&
			Property Value {
				value { clear ' we like to use variant as value type
					link parent StartNode, pc to SN, pc
					variant value
					if pc<0 then Error "use a while loop to advance the index" 
					for SN {
						value=.v(pc)
					}
				}
			}
			Set {
				let This=Group
			}
			value {
				if .left>0 then
					.pc++
					.left--
					=true
					if .pc>=.lim then
						.StartNode<=.StartNode=>pRead
						if .StartNode is type null then
							.StartNode<=.pFirst
						end if
						if .StartNode is type null then
							=false
						else
							For .StartNode, this {
								..pc<=.level
								..lim<=len(.v())
							}
						end if
					end if
				else
					.StartNode<=Pointer()
					.pFirst<=Pointer()
					=false
				end if
			}
		}
		=Group(Iterator)
	}
	Module Data {
		if .pLast is type Null then
			.pLast<=Pointer(.Node(.PageLen,,true))
			.pFirst<=.pLast
		end if
		boolean NeedOne
		thisnew=pointer()
		while not empty
		for .pLast, this {
			while not empty
				.low++
				if .low=len(.v()) then
					NeedOne=true
					thisnew<=Pointer(..Node(len(.v())*..ex,,true)) '..pagelen
					.pRead<=thisnew
					exit
				else  
					read .v(.low)
					..counter++
				end if
			end while
		}
		if NeedOne then
			.pLast<=thisnew:thisnew=pointer()
			NeedOne~
			end if 
		end while
	}
	Module Push {
		Long many=stack.size
		Boolean NeedOne
		if .curNode is type Null Then
				.curNode<=Pointer(.Node(.PageLen))			
		end if
		while not empty
			for .curNode {
				while not empty
					if .level=0 then NeedOne=true: Exit
					.level--
					read .v(.level)
				end while
			}
			if NeedOne then
			 .CurNode<=Pointer(.Node(.pagelen, .CurNode))
				NeedOne~
			end if
		end while
		.counter+=many
	}
	Function Peek(where as long=1) {
		if where<1 then Error "index too low"
		if .CurNode is type Null and .pFirst is type Null then Error "Empty Stack"
		if .counter=0 then Error "Empty Stack"
		if where>.counter then Error "index too high"
		
		boolean newpage=true
		z=pointer()
		if .CurNode is type Null then
			Usethis=.pFirst
		else
			UseThis=.CurNode
		end if
		newpage=false
		while where>0 and useThis is type Node
			for useThis, this {
				lim=len(.v())
				if .level=lim then
					newpage=true
					z=.pRead
					if z is type null then
						z=..pFirst
					end if							
					exit
				end if						
				st=.level
				w=len(.v())-st
				if w<where then
					newpage=true
					where-=w
					z=.pRead
					if z is type null then
						z=..pFirst
					end if
				else
					=.v(st+where-1)
					where=0
				end if
			}
			if newpage then
				useThis=Z:Z=pointer()
				newpage~
			end if
		end while
	}	
	Module Remove (where as long=1) {
		if where<1 then Error "index too low"		
		if .CurNode is type Null and .pFirst is type Null then Error "Empty Stack"
		if .counter=0 then Error "Empty Stack"
		if where>.counter then Error "index too high"

		boolean newpage=true
		z=pointer()
		if .CurNode is type Null then
			Usethis=.pFirst
		else
			UseThis=.CurNode
		end if
		newpage=false
		oldPointer=Pointer()
		boolean removelastnode
		while where>0 and useThis is type Node
			for useThis, this {
				lim=len(.v())
				if .level=lim then								
					newpage=true
					z=.pRead
					if z is type null then
						z=..pFirst
					end if							
					exit
				end if
				st=.level
				w=len(.v())-st
				if w<where then
					newpage=true:
					where-=w
					z=.pRead
					if z is type null then
						z=..pFirst
					end if
				else
					uplim=st+where-1
					if .level<uplim then
						stock .v(.level) keep uplim-.level, .v(.level+1)  
						.level++
					else
						.v(st+where-1)=0
						.level++
					end if
					..counter--
					where=0
					if .level>=len(.v()) then
						z=.pRead
						if z is type null then
							z=..pFirst
						end if
						removelastnode=true	
					end if
				end if
			}
			if removelastnode then
				newpage=false
				if oldPointer is type null then
					.CurNode<=z
				else
					oldPointer=>pRead=z						
				end if
			else.if newpage then
				oldPointer=useThis
				useThis=Z:Z=pointer()
				newpage~
			end if
		end while
	}
	Group Pop {
		value {
			link parent Pop() to p()
			=p()
		}
	}
	Function Pop() {
		if .CurNode is type Null and .pFirst is type Null then Error "Empty Stack"
		if .counter=0 then Error "Empty Stack"
		boolean newpage=true, cur
		z=pointer()
		variant cl
		if .CurNode is type Null then
			Usethis=.pFirst
			.pFirst<=Pointer()				
		else
			UseThis=.CurNode
			cur=true
			.CurNode<=Pointer()
		end if 
		while newpage and useThis is type Node
			for useThis, this {
					lim=len(.v())
					if .level=lim then
						// pen #ff2277 {print "<<>>",}
						z=.pRead
						if z is type null then
							z=..pFirst
						end if
					else
						=.v(.level)
						swap .v(.level), cl
						cl=0
						.level++
						..counter--						
						newpage~
					end if
			}
			if newpage then
				useThis<=Z:Z=pointer()
			end if
		end While
		if cur then
			.curNode<=UseThis
		else
			.pFirst<=UseThis
		end if
	}
	Property Length {
		value {
			link parent counter to c
			value=c
		}
	}=0&
class:	
	module superstack(.pagelen){
	}
}
flush
const iteratorlegend=" time to read each value through iterator, which hold last page and last position"
const peeklegend=" time to read each value using peek(i) - so each time start from first page"
const filllegend=" time to fill the structure and get the sum of all values"
N=500
Print "Page 300"
a=superstack(300)
long long acc=0, z
acc=0
z=1
profiler
for i=1 to N{
	a.push z
	a.data z+1
	acc+=z*2+1
	z+=2	
}
? int(timecount), filllegend
? acc
refresh
z=0
profiler
for i=1 to a.length
z+=a.peek(i)
next
? int(timecount), peeklegend
? z
m=a.iterator()
// beacause m return value we have to use group(m) to get the group (the object)
//? group(m) is type NodeIterator  ' true

z=0
profiler
while m
z+=m.value
end while
? int(timecount), iteratorlegend
? z

Print "Page 30"
a=superstack(30)
long long acc=0, z
acc=0
z=1
profiler
for i=1 to N{
	a.push z
	a.data z+1
	acc+=z*2+1
	z+=2	
}
? int(timecount), filllegend
? acc
refresh
z=0
profiler
for i=1 to a.length
z+=a.peek(i)
next
? int(timecount), peeklegend
? z
m=a.iterator()
z=0
profiler
while m
z+=m.value
end while
? int(timecount), iteratorlegend
? z