September Morn Update

This commit is contained in:
Ingy döt Net 2019-09-12 10:33:56 -07:00
parent 4e2d22a71d
commit aac6731f2c
6856 changed files with 141342 additions and 21127 deletions

1
Task/Amb/00META.yaml Normal file
View file

@ -0,0 +1 @@
--- {}

View file

@ -1,75 +1,81 @@
import system'routines.
import extensions.
import extensions'routines.
import system'routines;
import extensions;
import extensions'routines;
joinable(former,later) = (former[former length - 1] == later[0]).
joinable(former,later) = (former[former.Length - 1] == later[0]);
dispatcher =
{
eval(object a, Func2 f)
[
^ f(a[0],a[1]).
]
{
^ f(a[0],a[1])
}
eval(object a, Func3 f)
[
^ f(a[0], a[1],a[2]).
]
{
^ f(a[0], a[1],a[2])
}
eval(object a, Func4 f)
[
^ f(a[0],a[1],a[2],a[3]).
]
{
^ f(a[0],a[1],a[2],a[3])
}
eval(object a, Func5 f)
[
^ f(a[0],a[1],a[2],a[3],a[4]).
]
}.
{
^ f(a[0],a[1],a[2],a[3],a[4])
}
};
class AmbValueCollection
{
object theCombinator.
object theCombinator;
generic constructor new(V<object> args)
[
theCombinator := SequentialEnumerator new(args).
]
constructor new(params object[] args)
{
theCombinator := SequentialEnumerator.new(params args)
}
seek : cond
[
theCombinator reset.
seek(cond)
{
theCombinator.reset();
theCombinator seekEach(:v)(dispatcher eval(v,cond))
]
theCombinator.seekEach:(v => dispatcher.eval(v,cond))
}
do : aFunction
[
var aResult := theCombinator get.
if (nil != aResult)
[ dispatcher eval(aResult,aFunction) ];
[ InvalidArgumentException new; raise ]
]
do(f)
{
var result := theCombinator.get();
if (nil != result)
{
dispatcher.eval(result,f)
}
else
{
InvalidArgumentException.raise()
}
}
}
ambOperator =
singleton ambOperator
{
generic for(V<object> args)
= AmbValueCollection new(args).
}.
for(params object[] args)
= AmbValueCollection.new(params args);
}
public program
[
try(ambOperator
for(("the","that","a"),("frog", "elephant", "thing"),("walked", "treaded", "grows"),("slowly", "quickly"));
seek(:a:b:c:d) ( joinable(a,b) && joinable(b,c) && joinable(c,d) );
do(:a:b:c:d) [ console printLine(a," ",b," ",c," ",d) ])
public program()
{
try
{
on(Exception e)
[
console printLine:"AMB is angry"
]
}.
ambOperator
.for(new {"the","that","a"},new {"frog", "elephant", "thing"},new {"walked", "treaded", "grows"}, new {"slowly", "quickly"})
.seek:(a,b,c,d => joinable(a,b) && joinable(b,c) && joinable(c,d) )
.do:(a,b,c,d) { console.printLine(a," ",b," ",c," ",d) }
}
catch(Exception e)
{
console.printLine:"AMB is angry"
};
console readChar
]
console.readChar()
}

53
Task/Amb/Haskell/amb-2.hs Normal file
View file

@ -0,0 +1,53 @@
joins :: String -> String -> Bool
joins left right = last left == head right
-- First desugaring (dropping the do notation)
-- in terms of the bind operator (>>=) for the list monad
exampleBind :: String
exampleBind =
["the", "that", "a"] >>=
(\w1 ->
["frog", "elephant", "thing"] >>=
\w2 ->
["walked", "treaded", "grows"] >>=
\w3 ->
["slowly", "quickly"] >>=
(\w4 ->
if joins w1 w2
then (if joins w2 w3
then (if joins w3 w4
then unwords [w1, w2, w3, w4]
else [])
else [])
else []))
-- Second desugaring (still dropping the do notation)
-- in terms of the concatMap, which is >>= with its arguments flipped
exampleConcatMap :: String
exampleConcatMap =
concatMap
(\w1 ->
concatMap
(\w2 ->
concatMap
(\w3 ->
concatMap
(\w4 ->
if joins w1 w2
then (if joins w2 w3
then (if joins w3 w4
then unwords [w1, w2, w3, w4]
else [])
else [])
else [])
["slowly", "quickly"])
["walked", "treaded", "grows"])
["frog", "elephant", "thing"])
["the", "that", "a"]
main :: IO ()
main = do
print exampleBind
print exampleConcatMap

22
Task/Amb/Haskell/amb-3.hs Normal file
View file

@ -0,0 +1,22 @@
example :: [String]
example =
["the", "that", "a"] >>=
\w1 ->
when True ["frog", "elephant", "thing"] >>=
\w2 ->
when (joins w1 w2) ["walked", "treaded", "grows"] >>=
\w3 ->
when (joins w2 w3) ["slowly", "quickly"] >>=
\w4 -> when (joins w3 w4) [w1, w2, w3, w4]
joins :: String -> String -> Bool
joins left right = last left == head right
when :: Bool -> [a] -> [a]
when p xs =
if p
then xs
else []
main :: IO ()
main = print $ unwords example

16
Task/Amb/Haskell/amb-4.hs Normal file
View file

@ -0,0 +1,16 @@
joins :: String -> String -> Bool
joins left right = last left == head right
example :: [String]
example =
[ unwords [w1, w2, w3, w4]
| w1 <- ["the", "that", "a"]
, w2 <- ["frog", "elephant", "thing"]
, w3 <- ["walked", "treaded", "grows"]
, w4 <- ["slowly", "quickly"]
, joins w1 w2
, joins w2 w3
, joins w3 w4 ]
main :: IO ()
main = print example

View file

@ -0,0 +1,55 @@
(() => {
'use strict';
// amb :: [a] -> (a -> [b]) -> [b]
const amb = xs => f =>
xs.reduce((a, x) => a.concat(f(x)), []);
// when :: Bool -> [a] -> [a]
const when = p =>
xs => p ? (
xs
) : [];
// TEST -----------------------------------------------
const main = () => {
// joins :: String -> String -> Bool
const joins = (a, b) =>
b[0] === last(a);
console.log(
amb(['the', 'that', 'a'])
(w1 => when(true)(
amb(['frog', 'elephant', 'thing'])
(w2 => when(joins(w1, w2))(
amb(['walked', 'treaded', 'grows'])
(w3 => when(joins(w2, w3))(
amb(['slowly', 'quickly'])
(w4 => when(joins(w3, w4))(
unwords([w1, w2, w3, w4])
))
))
))
))
);
};
// GENERIC FUNCTIONS ----------------------------------
// last :: [a] -> a
const last = xs =>
0 < xs.length ? xs.slice(-1)[0] : undefined;
// unwords :: [String] -> String
const unwords = xs => xs.join(' ');
// MAIN ---
return main();
})();

15
Task/Amb/Python/amb-2.py Normal file
View file

@ -0,0 +1,15 @@
# joins :: String -> String -> Bool
def joins(a, b):
return a[-1] == b[0]
print (
[
' '.join([w1, w2, w3, w4])
for w1 in ['the', 'that', 'a']
for w2 in ['frog', 'elephant', 'thing']
for w3 in ['walked', 'treaded', 'grows']
for w4 in ['slowly', 'quickly']
if joins(w1, w2) and joins(w2, w3) and joins(w3, w4)
]
)

37
Task/Amb/Python/amb-3.py Normal file
View file

@ -0,0 +1,37 @@
def main():
print (
unlines([
unwords([w1, w2, w3, w4])
for w1 in ['the', 'that', 'a']
if True
for w2 in ['frog', 'elephant', 'thing']
if joins(w1, w2)
for w3 in ['walked', 'treaded', 'grows']
if joins(w2, w3)
for w4 in ['slowly', 'quickly']
if joins(w3, w4)
])
)
# joins :: String -> String -> Bool
def joins(a, b):
return a[-1] == b[0]
# unlines :: [String] -> String
def unlines(xs):
return '\n'.join(xs)
# unwords :: [String] -> String
def unwords(xs):
return ' '.join(xs)
if __name__ == '__main__':
main()

79
Task/Amb/Python/amb-4.py Normal file
View file

@ -0,0 +1,79 @@
from itertools import chain
# amb :: [a] -> (a -> [b]) -> [b]
def amb(xs):
return lambda f: list(
chain.from_iterable(
map(f, xs)
)
)
# main :: IO ()
def main():
xs = enumFromTo(1)(10)
print ('Pythagorean triples from integers 1-10:')
print (
amb(xs)(
lambda x: amb(xs)
(lambda y: amb(xs)
(lambda z: when(
x * x + y * y == z * z
)(
(x, y, z)
)
))
)
)
# joins :: String -> String -> Bool
def joins(a, b):
return a[-1] == b[0]
print ('\nRC problem given above:')
print (
amb(['the', 'that', 'a'])(
lambda w1: amb(
['frog', 'elephant', 'thing']
)(lambda w2: amb(
['walked', 'treaded', 'grows']
)(lambda w3: amb(
['slowly', 'quickly']
)(lambda w4: when(
joins(w1, w2) and joins(w2, w3) and joins(w3, w4)
)(
(w1, w2, w3, w4)
))))
)
)
print('\nAdditional problem reference in procedural version above:')
print(
amb([1, 2, 3])
(
lambda x: amb([4, 5, 6])
(
lambda y: when(x * y != 8)
(
(x, y)
)
)
)
)
# GENERIC -------------------------------------------------
# enumFromTo :: (Int, Int) -> [Int]
def enumFromTo(m):
return lambda n: list(range(m, 1 + n))
# when :: Bool -> [a] -> [a]
def when(p):
return lambda x: [x] if p else []
# MAIN ---
if __name__ == '__main__':
main()

42
Task/Amb/Python/amb-5.py Normal file
View file

@ -0,0 +1,42 @@
from itertools import chain
# amb :: [a] -> (a -> [b]) -> [b]
def amb(xs):
return lambda f: list(
chain.from_iterable(
map(f, xs)
)
)
# when :: Bool -> [a] -> [a]
def when(p):
return lambda xs: xs if p else []
# TEST ----------------------------------------------------
# joins :: String -> String -> Bool
def joins(a, b):
return a[-1] == b[0]
print (
amb(['the', 'that', 'a'])(
lambda w1: when(True)
(amb(['frog', 'elephant', 'thing'])
(lambda w2: when(joins(w1, w2))
(amb(['walked', 'treaded', 'grows'])
(lambda w3: when(joins(w2, w3))
(amb(['slowly', 'quickly'])
(lambda w4: when(joins(w3, w4))(
[w1, w2, w3, w4]
))))))
)
)
)

View file

@ -1,22 +1,20 @@
/*REXX program demonstrates the Amd operator, choosing a word from each set. */
@.=; @.1 = "the that a"
@.2 = "frog elephant thing"
@.3 = "walked treaded grows"
@.4 = "slowly quickly"
@.1 = "the that a"
@.2 = "frog elephant thing"
@.3 = "walked treaded grows"
@.4 = "slowly quickly"
@.0 = 4 /*define the number of sets being ised.*/
call Amb 1 /*find all word combinations that works*/
exit /*stick a fork in it, we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
Amb: procedure expose @.; parse arg # x; arg . u /*ARG uppercases U values. */
do j=1 until @.j=='' /*locate a null string. */
end /*j*/
t= j-1 /*define number of sets. */
if #>t then do; y=word(u, 1) /*Y: is a uppercased U. */
do n=2 to words(u); ?=word(u, n)
if left(?, 1) \== right(y, 1) then return; y=?
end /*n*/
say space(x) /*¬show superfluous blanks.*/
end
do k=1 for words(@.#); call Amb #+1 x word(@.#, k)
end /*k*/ /* [↑] generate all combs */
return /* recursively. */
Amb: procedure expose @.; parse arg # x; arg . u /*ARG uppercases U value. */
if #>@.0 then do; y= word(u, 1) /*Y: is a uppercased U. */
do n=2 to words(u); ?= word(u, n)
if left(?, 1) \== right(y, 1) then return; y= ?
end /*n*/
say strip(x) /*¬show superfluous blanks.*/
end
/* [↓] generate all combos recursively*/
do j=1 for words(@.#); call Amb #+1 x word(@.#, j)
end /*j*/
return