Permutations with repetitions: Difference between revisions
→Applescript lazy evaluation: Switched to generator, updated output & primitives
(→Applescript lazy evaluation: Switched to generator, updated output & primitives) |
|||
Line 154:
===Partial evaluation===
Permutations with repetition by treating the <math>n^k</math> elements as an ordered set, and writing a function from a zero-based index to the nth permutation. This allows us terminate a repeated generation on some condition, or explore a sub-set without needing to generate the whole set:
<lang AppleScript>use AppleScript version "2.4"
use framework "Foundation"
use scripting additions
-- permutesWithRepns :: [a] -> Int -> Generator [[a]]
on permutesWithRepns(xs, n)
script
property f : curry3(my nthPermutationWithRepn)'s |λ|(xs)'s |λ|(n)
property limit : (length of xs) ^ n
property i : -1
on |λ|()
set i to i + 1
if i < limit then
return f's |λ|(i)
else
missing value
end if
end |λ|
end script
end permutesWithRepns
-- nthPermutationWithRepn :: [a] -> Int -> Int -> [a]
on nthPermutationWithRepn(xs,
set intBase to length of xs
set ds to baseDigits(intBase, xs, intIndex)
replicate(intGroup - (length of
missing
end if
end nthPermutationWithRepn
-- baseDigits :: Int -> [a] -> [a]
on
script
else
v div intBase))
end if
end |λ|
end script
unfoldr(result, n)
end baseDigits
-- TEST
on run
set cs to "ACKR"
set wordLength to
set gen to permutesWithRepns(cs, wordLength)
set v to gen's |λ|() -- First permutation drawn from series
set alpha to v
set psi to alpha
repeat while missing value is not v
set s to concat(v)
if "crack" = toLower(s) then
return ("Permutation " & (i as text) & " of " & ¬
(((length of cs) ^ wordLength) as integer) as text) & ¬
": " & s & linefeed & ¬
"Found after searching from " & alpha & " thru " & psi
else
set i to 1 + i
set psi to v
end if
set v to gen's |λ|()
end repeat
end run
-- GENERIC
--
on
{type:"Maybe", Nothing:false, Just:x}
end Just
-- Nothing :: Maybe a
on Nothing()
{type:"Maybe", Nothing:true}
end Nothing
-- Tuple (,) :: a -> b -> (a, b)
on Tuple(a, b)
{type:"Tuple", |1|:a, |2|:b, length:2}
end Tuple
-- concat :: [[a]] -> [a]
-- concat :: [String] -> String
on concat(xs)
set lng to length of xs
if 0 < lng and string is class of (item 1 of xs) then
set acc to ""
else
set
end if
end repeat
end
--
on
|λ|(a, b, c) of mReturn(f)
end
end script
end |λ|
end script
end |λ|
end script
end curry3
-- Lift 2nd class handler function into 1st class script wrapper
-- mReturn ::
on mReturn(f)
if class of f is script then
Line 244 ⟶ 294:
end mReturn
-- Egyptian multiplication - progressively doubling a list, appending
-- stages of doubling to an accumulator where needed for binary
-- assembly of a target length
-- replicate :: Int -> a -> [a]
on replicate(n, a)
Line 263 ⟶ 311:
end replicate
-- take :: Int -> [a] -> [a]
-- take :: Int -> String -> String
on take(n, xs)
set c to class of xs
if list is c then
if 0 < n then
items 1 thru min(n, length of xs) of xs
else
{}
end if
else if string is c then
if 0 < n then
text 1 thru min(n, length of xs) of xs
else
""
end if
else if script is c then
set ys to {}
repeat with i from 1 to n
set end of ys to xs's |λ|()
end repeat
return ys
else
missing value
end if
end take
-- toLower :: String -> String
on toLower(str)
set ca to current application
((ca's NSString's stringWithString:(str))'s ¬
lowercaseStringWithLocale:(ca's NSLocale's currentLocale())) as text
end toLower
-- > unfoldr (\b -> if b == 0 then Nothing else Just (b, b-1)) 10
-- > [10,9,8,7,6,5,4,3,2,1]
-- unfoldr :: (b -> Maybe (a, b)) -> b -> [a]
on unfoldr(f, v)
set
set
tell mReturn(f)
repeat
set
if Nothing of mb then
exit repeat
else -- New (value, remainder) tuple,
set xr to Just of mb
-- and value appended to output list.
set end of xs to |1| of xr
end if
end repeat
end tell
return
end
{{Out}}
<pre>Permutation 589 of 1024: CRACK
Found after searching from AAAAA thru ARACK</pre>
=={{header|ALGOL 68}}==
| |||