Dinesman's multiple-dwelling problem

 Using a Permutation Step Function:

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)
	document doc$={	Dinesman's multiple-dwelling problem
		Baker, Cooper, Fletcher, Miller, and Smith live on different floors of an apartment house that contains only five floors.
		• Baker does not live on the top floor.
		• Cooper does not live on the bottom floor.
		• Fletcher does not live on either the top or the bottom floor.
		• Miller lives on a higher floor than does Cooper.
		• Smith does not live on a floor adjacent to Fletcher's.
		• Fletcher does not live on a floor adjacent to Cooper's.
		
		Where does everyone live?
	
		Solution:
	}
	while c
		doc$={	•}+array$(c)+" lives on floor "+(c^+1)+{
		}
	end while
	report doc$
	clipboard doc$
}
Dinesman_s_multiple_dwelling_problem

Using Amp Function (Which use a failure function for a series of arrays, each one for each argument on the failure function). For this example this function find 1200 different sets of parameters for testing on the failure function. Need 5sec on my compute. The previous program need less than a half second, because there are only 120 permutations for 5 names (!5= 5*4*3*2=120).

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