Initial data commit

Task/Dinesmans-multiple-dwelling-problem/M2000-Interpreter/dinesmans-multiple-dwelling-problem-1.m2000

@@ -0,0 +1,46 @@
+Module Dinesman_s_multiple_dwelling_problem {
+	// this is the standard perimutation function
+	// which create a lambda function:
+	// pointer_to_array=Func(&BooleanVariable)
+	// when BooleanVariable = true we get the last permutation
+	Function PermutationStep (a as array) {
+		c1=lambda (&f, a) ->{
+			=a : f=true
+		}
+		integer m=len(a)
+		if m=0 then Error "No items to make permutations"
+		c=c1
+		While m>1
+			c1=lambda c2=c,p=0%, m=(,) (&f, a, clear as boolean=false) ->{
+				if clear then m=(,)
+				if len(m)=0 then m=a
+				=cons(car(m),c2(&f, cdr(m)))
+				if f then f=false:p++:  m=cons(cdr(m), car(m)) : if p=len(m) then p=0 : m=(,):: f=true
+				}
+			c=c1
+			m--
+		End While
+		=lambda c, a (&f, clear as boolean=false) -> {
+			=c(&f, a, clear)
+		}
+	}
+	boolean k
+	object s=("Baker", "Cooper", "Fletcher", "Miller", "Smith")
+	StepA=PermutationStep(s)
+	while not k
+		s=StepA(&k)
+		if s#val$(4)= "Baker" then continue
+		if s#val$(0)="Cooper" then continue
+		if s#val$(0)="Fletcher" then continue
+		if s#val$(4)="Fletcher" then continue
+		if s#pos("Cooper")> s#pos("Miller") then continue
+		if abs(s#pos("Smith")-s#pos("Fletcher"))=1 then continue
+		if abs(s#pos("Cooper")-s#pos("Fletcher"))=1 then continue
+		exit  // for one solution
+	end while
+	object c=each(s)
+	while c
+		Print array$(c)+" lives on floor "+(c^+1)
+	end while
+}
+Dinesman_s_multiple_dwelling_problem

Task/Dinesmans-multiple-dwelling-problem/M2000-Interpreter/dinesmans-multiple-dwelling-problem-2.m2000

@@ -0,0 +1,78 @@
+Module Using_AmbFunction {
+	Enum Solution {First, Any=-1}
+	Function Amb(way as Solution, failure) {
+		read a
+		c1=lambda i=0, a, (&any,  &ret) ->{
+			any=(array(a,i),)
+			ret=any
+			i++
+			ok=i=len(a)
+			if ok then i=0
+			=ok
+		}
+		m=stack.size
+		if m=0 then Error "At least two arrays needed"
+		c=c1
+		while m>0 {
+			read a
+			c1=lambda c2=c, i=0, a,  (&any,  &ret) ->{
+				any=(array(a,i),)
+				ret=(,) :  ok=false :  anyother=(,)
+				ok=c2(&anyother,  &ret)
+				ret=cons(ret, any)
+				if ok then i++
+				ok=i=len(a)
+				if ok  then i=0
+				=ok
+			}
+			c=c1 :  m--
+		}
+		ok=false
+		any=(,)
+		flush
+		while not ok
+			ret=(,)
+			ok=c(&any, &ret)
+			s=stack(ret)
+			if not failure(! s)  then data ret : if way>0 then ok=true
+		End While
+		if empty then
+			ret=(("",),)
+		else
+			ret=array([])
+		end if
+		=ret
+	}
+	Range=lambda (a, f) ->{
+		for i=a to f-1: data i: next
+		=array([])
+	}
+	
+	Baker=range(1, 5)
+	Cooper=range(2, 6)
+	Fletcher=range(2, 5)
+	Miller=range(1,6)
+	Smith=range(1,6)
+	
+	failure=lambda   (Baker, Cooper, Fletcher, Miller, Smith)->{
+		if Baker=Cooper or Baker=Fletcher or Baker=Miller or Baker=Smith then =true:exit
+		if Cooper=Fletcher or Cooper =Miller or Cooper=Smith then =true:exit
+		if Fletcher=Miller or Fletcher=Smith or Miller=Smith then =true:exit
+		if Miller<Cooper or abs(Cooper-Fletcher)=1 or abs(Smith-Fletcher)=1 then =true:exit
+	}
+	all=amb(Any, failure, Baker, Cooper, Fletcher, Miller, Smith)
+	k=each(all)
+	s=("Baker", "Cooper", "Fletcher", "Miller", "Smith")
+	while k
+		z=array(k)
+		zz=each(z, , -2)
+		while zz
+			? s#val$(zz^)+" ("+array(zz)+"), ";
+		end while
+		zz=each(z, -1)
+		while zz
+			? s#val$(zz^)+" ("+array(zz)+") "
+		end while
+	end while
+}
+Using_AmbFunction