aparler/RosettaCodeData
1
0
Fork 0
Code Issues 12 Pull requests 3 Projects Releases Packages Wiki Activity Actions

Data commit

Browse source
This commit is contained in:
Ingy döt Net 2023-07-01 11:58:00 -04:00
parent 7387c8f97b
commit cb5bb5e222
199093 changed files with 3378972 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

77
Task/Amb/M2000-Interpreter/amb-1.m2000 Normal file
View file

@ -0,0 +1,77 @@
Module AmbFunction {
Function Amb (failure) {
// get an array of s items, return an array of 1 item
// we do this so we forget the type of element
getitem=lambda (n, c) -> {
dim z(1) :link c to c()
stock c(n) keep 1, z(0) // copy from c(n) to z(0) one item
=z()
}
read a
c1=lambda a, getitem (i, &any, &ret) ->{
any=getitem(i, a)
ret=any
=true
}
m=stack.size
if m=0 then Error "At least two arrays needed"
c=c1
while m>1 {
read b
c1=lambda c2=c, j=0, m=len(a), b, failure, getitem (i, &any, &ret) ->{
any=getitem(i, b)
ret=(,) : ok=false : anyother=(,)
do
if c2(j, &anyother, &ret) then
if not failure(any, anyother) then
ok=true
ret=cons(ret, any)
end if
end if
j++
until ok or j=m
if j=m then j=0
=ok
}
c=c1 : a=b : m--
}
read b
amb1=lambda c2=c, j=0, m=len(a), b, failure, getitem (&ret) ->{
ret=(,) : ok=false: anyother=(,)
k=each(b)
while k
any=getitem(k^, b)
do
if c2(j, &anyother, &ret) then
if not failure(any, anyother) then
ok=true
ret=cons(ret, any)
end if
end if
j++
until ok or j=m
if j=m then j=0
if ok then exit
end while
=ok
}
ret=(,)
if amb1(&ret) then =ret else =(,) ' default return value
}
a=(1, 2, 3)
b=(7, 6, 4, 5)
failure=lambda (a,b)->{
=a#val(0)*b#val(0)<>8
}
Print amb(failure, a, b)#str$()
a=("the", "that", "a")
b=("frog", "elephant", "thing")
c=("walked", "treaded", "grows")
d=("slowly", "quickly")
failure=lambda (a,b)->{
=left$(a#val$(0),1)<>right$(b#val$(0),1)
}
Print amb(failure, a, b, c, d)#str$()
}
AmbFunction

102
Task/Amb/M2000-Interpreter/amb-2.m2000 Normal file
View file

@ -0,0 +1,102 @@
Module AmbFunction {
Enum Solution {First, Any=-1}
Function Amb(way as Solution, failure) {
// get an array of s items, return an array of 1 item
// we do this so we forget the type of element
getitem=lambda (n, c) -> {
dim z(1) :link c to c()
stock c(n) keep 1, z(0) // copy from c(n) to z(0) one item
=z()
}
read a
c1=lambda i=0, a, getitem (&any, &ret) ->{
any=getitem(i, a)
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, getitem (&any, &ret) ->{
any=getitem(i, a)
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
}
a=(1, 2, 3)
b=(7, 6, 4, 5)
failure=lambda (a,b)->{
=a*b<>8
}
Print Amb(First, failure, a, b)#val(0)#str$()
a=("the", "that", "a")
b=("frog", "elephant", "thing")
c=("walked", "treaded", "grows")
d=("slowly", "quickly")
failure=lambda (a$, b$, c$, d$)->{
def amb(x$, y$)=right$(x$,1)<>left$(y$,1)
=amb(a$,b$) or amb(b$,c$) or amb(c$, d$)
}
Print amb(First, failure, a, b, c, d)#Val(0)#str$()
Range=lambda (a, f) ->{
for i=a to f-1: data i: next
=array([])
}
Print "Small Pythagorean triples problem:"
a=range(1,11)
failure=lambda (a, b, z)->{
=not (a^2+b^2=z^2 and b>a)
}
all=amb(Any,failure, a, a, a)
k=each(all)
while k
z=array(k)
Print z#str$()
end while
a=range(1,6)
c=range(0,6)
N=9
failure=lambda N (a, b, c, d, e)->{
=not (a+b+c+d+e=N and a>=b and b>=c and c>=d and d>=e)
}
all=amb(Any,failure, a, a, c, c, c)
k=each(all)
document ret$
while k
z=array(k)
ret$=replace$("+0", " ", z#str$("+"))+" ="+str$(N)+{
}
end while
Sort descending ret$
Print #-2, ret$
clipboard ret$
}
AmbFunction