I have decided index origin 1 was a mistake. The biggest reason, which has annoyed me a lot, is indexing a pair with a boolean array. (a=5)⊇' ·' should work, no 1+s attached. It's time to make the biggest breaking change. As usual, first a few unrelated things.
You know the drill: code is available on GitHub.
Arctangent and Round To Nearest
Really easy functions.
arctan :: MonadError Error m => ScalarValue -> ScalarValue -> m ScalarValue
arctan (Number x) (Number y) = pure $ Number $ Cx.phase (y + x * i) :+ 0
arctan _ _ = throwError expectedNumber
roundTo :: MonadError Error m => ScalarValue -> ScalarValue -> m ScalarValue
roundTo = commute $ leftFork (TinyAPL.Functions.round `atop` divide) times
Better indexing
⌷ now works with non-vector nested entries and the code actually looks somewhat good.
indexCell :: MonadError Error m => Integer -> Array -> m Array
indexCell i x
| i < 0 = indexCell (genericLength (majorCells x) + i + 1) x
| i == 0 || i > genericLength (majorCells x) = throwError $ DomainError "Index out of bounds"
| otherwise = pure $ genericIndex (majorCells x) (i - 1)
squad :: MonadError Error m => Array -> Array -> m Array
squad i y = do
let err = DomainError "Squad left argument must be a vector of arrays of integers"
axisIndices <- fmap fromScalar <$> asVector err i
let
go :: MonadError Error m => [Array] -> Array -> m Array
go [] y = pure y
go (is:iss) y =
onScalars1 (\(Array [] [ind]) -> asNumber err ind >>= asInt err >>= flip indexCell y >>= go iss) is
go axisIndices y
from = (first `before` squad) `atRank2` (0, likePositiveInfinity)
The big change
It's actually not that big of a change in the implementation!
- indexGenerator i = pure $ vector $ Number . fromInteger . toInteger <$> [1..i]
+ indexGenerator 0 = pure $ vector []
+ indexGenerator i = pure $ vector $ Number . fromInteger . toInteger <$> [0..i - 1]
roll y =
if y == 0 then randomR (0, 1)
- else fromInteger <$> randomR (1, toInteger y)
+ else fromInteger <$> randomR (0, toInteger y - 1)
indexCell i x
- | i < 0 = indexCell (genericLength (majorCells x) + i + 1) x
- | i == 0 || i > genericLength (majorCells x) = throwError $ DomainError "Index out of bounds"
- | otherwise = pure $ genericIndex (majorCells x) (i - 1)
+ | i < 0 = indexCell (genericLength (majorCells x) + i) x
+ | i > genericLength (majorCells x) = throwError $ DomainError "Index out of bounds"
+ | otherwise = pure $ genericIndex (majorCells x) i
- gradeUp xs = pure $ map fst $ sortOn snd $ zip [1..genericLength xs] xs
+ gradeUp xs = pure $ map fst $ sortOn snd $ zip [0..genericLength xs] xs
- gradeDown xs = pure $ map fst $ sortOn snd $ zip [1..genericLength xs] (Down <$> xs)
+ gradeDown xs = pure $ map fst $ sortOn snd $ zip [0..genericLength xs] (Down <$> xs)
- indexOf = flip $ searchFunction $ pure .: scalar .: Number .: (:+ 0) .: (\n hs -> case n `genericElemIndex` hs of
- Just x -> x + 1
- Nothing -> genericLength hs + 1)
+ indexOf = flip $ searchFunction $ pure .: scalar .: Number .: (:+ 0) .: (\n hs -> fromMaybe (genericLength hs) $ n `genericElemIndex` hs)
- generateIndices = foldr (liftA2 (:) . enumFromTo 0 . subtract 1) [[]]
+ generateIndices = foldr (liftA2 (:) . (\case
+ 0 -> []
+ n -> [0..n-1])) [[]]
- io = Nilad (Just $ pure $ scalar $ Number 1) Nothing (G.quad : "io") Nothing
+ io = Nilad (Just $ pure $ scalar $ Number 0) Nothing (G.quad : "io") Nothing
Increment, Decrement and Span
What if you kinda like index origin 1? Fear not. A cool new feature is coming eventually, but for now you can use these two new primitives: increment ⧺ and decrement ⵧ.
increment :: MonadError Error m => ScalarValue -> m ScalarValue
increment (Number y) = pure $ Number $ y + 1
increment (Character y) = pure $ Character $ chr $ ord y + 1
increment _ = throwError expectedNumber
decrement :: MonadError Error m => ScalarValue -> m ScalarValue
decrement (Number y) = pure $ Number $ y - 1
decrement (Character '\0') = pure $ Character '\0'
decrement (Character y) = pure $ Character $ chr $ ord y - 1
decrement _ = throwError expectedNumber
Dyad Decrement is free so I'm putting another function related to subtraction: Span, "length of the inclusive range between two (integer) numbers".
span :: MonadError Error m => ScalarValue -> ScalarValue -> m ScalarValue
span (Number x) (Number y) = pure $ Number $ 1 + x - y
span _ _ = throwError expectedNumber
Range and One Range
Specifically for the case of ⍳, wanting ranges that begin with 1 and end with the number itself is quite common. Instead of writing 1«+»⍳, you can use Range: 1∘…. It is, of course, more powerful than that, creating an inclusive range between any two (vectors of) integers. The definition is quite short and looks like this in TinyAPL: ⍳⍤ⵧ⇾(+ᐵ)⍨ (see, Span!). In Haskell, it becomes this:
range :: MonadError Error m => Array -> Array -> m Array
range = commute $ (indexGenerator' `atop` span') `leftFork` eachLeft add'
In fact, I think 1∘… is so useful it should be its own primitive. Monad … is free and I can't come up with anything else, so I'm going to use it for One Range.
oneRange :: MonadError Error m => Array -> m Array
oneRange = range $ scalar $ Number 1
Fork
Fork is a conjunction pair « and » and doesn't do anything on its own. The way it's implemented is a bit of a hack, inspecting the left operand function and checking that it's actually part of a fork.
forkA = PrimitiveConjunction
{ conjRepr = [G.forkA]
, conjContext = Nothing
, conjOnArrayArray = Just $ \x y -> pure $ DerivedFunctionArrayArray (Just $ \_ -> message) (Just $ \_ _ -> message) Nothing forkA x y
, conjOnArrayFunction = Just $ \x g -> pure $ DerivedFunctionArrayFunction (Just $ \_ -> message) (Just $ \_ _ -> message) Nothing forkA x g
, conjOnFunctionArray = Just $ \f y -> pure $ DerivedFunctionFunctionArray (Just $ \_ -> message) (Just $ \_ _ -> message) Nothing forkA f y
, conjOnFunctionFunction = Just $ \f g -> pure $ DerivedFunctionFunctionFunction (Just $ \_ -> message) (Just $ \_ _ -> message) Nothing forkA f g }
where message = throwError $ DomainError $ [G.forkA] ++ " must be used in conjunction with " ++ [G.forkB]
forkB = PrimitiveConjunction
{ conjRepr = [G.forkB]
, conjContext = Nothing
, conjOnArrayArray = Nothing
, conjOnArrayFunction = Nothing
, conjOnFunctionArray = Just $ \left z -> case left of
DerivedFunctionArrayArray _ _ _ op x y | op == forkA -> pure $ DerivedFunctionFunctionArray (Just $ F.fork1 (F.constant1 x) (F.constant2 y) (F.constant1 z)) (Just $ F.fork2 (F.constant2 x) (F.constant2 y) (F.constant2 z)) Nothing forkB left z
DerivedFunctionArrayFunction _ _ _ op x g | op == forkA -> pure $ DerivedFunctionFunctionArray (Just $ F.fork1 (F.constant1 x) (callDyad g) (F.constant1 z)) (Just $ F.fork2 (F.constant2 x) (callDyad g) (F.constant2 z)) Nothing forkB left z
DerivedFunctionFunctionArray _ _ _ op f y | op == forkA -> pure $ DerivedFunctionFunctionArray (Just $ F.fork1 (callMonad f) (F.constant2 y) (F.constant1 z)) (Just $ F.fork2 (callDyad f) (F.constant2 y) (F.constant2 z)) Nothing forkB left z
DerivedFunctionFunctionFunction _ _ _ op f g | op == forkA -> pure $ DerivedFunctionFunctionArray (Just $ F.fork1 (callMonad f) (callDyad g) (F.constant1 z)) (Just $ F.fork2 (callDyad f) (callDyad g) (F.constant2 z)) Nothing forkB left z
_ -> message
, conjOnFunctionFunction = Just $ \left h -> case left of
DerivedFunctionArrayArray _ _ _ op x y | op == forkA -> pure $ DerivedFunctionFunctionFunction (Just $ F.fork1 (F.constant1 x) (F.constant2 y) (callMonad h)) (Just $ F.fork2 (F.constant2 x) (F.constant2 y) (callDyad h)) Nothing forkB left h
DerivedFunctionArrayFunction _ _ _ op x g | op == forkA -> pure $ DerivedFunctionFunctionFunction (Just $ F.fork1 (F.constant1 x) (callDyad g) (callMonad h)) (Just $ F.fork2 (F.constant2 x) (callDyad g) (callDyad h)) Nothing forkB left h
DerivedFunctionFunctionArray _ _ _ op f y | op == forkA -> pure $ DerivedFunctionFunctionFunction (Just $ F.fork1 (callMonad f) (F.constant2 y) (callMonad h)) (Just $ F.fork2 (callDyad f) (F.constant2 y) (callDyad h)) Nothing forkB left h
DerivedFunctionFunctionFunction _ _ _ op f g | op == forkA -> pure $ DerivedFunctionFunctionFunction (Just $ F.fork1 (callMonad f) (callDyad g) (callMonad h)) (Just $ F.fork2 (callDyad f) (callDyad g) (callDyad h)) Nothing forkB left h
_ -> message }
where message = throwError $ DomainError $ [G.forkA] ++ " must be used in conjunction with " ++ [G.forkB]
Yeah. Not my best work.
Multiline input
emanresuA has contributed a really nice feature to the web interface: multiline input using Shift + Enter. Thank you!
SBCS
Now that TinyAPL has been used for code golf (1,2,3,4,5,6), which I'm super happy about and proud of (thank you noodle person and emanresuA), an important thing to have is a SBCS. SBCS means "single byte character set" and basically it's a custom one-byte encoding of TinyAPL glyphs to make it so that each counts as 1 byte instead of whatever it would be in UTF-8. The conversion code is implemented as std:sbcs:
table ⇇ ,
[ "¯⏨ᴊ∞⍘⍘⋄→■⍝⍘n⟨⟩⦅⦆⦃⦄"
⋄ "←⇇↚↩⟃⟄‿⊏⊐⍰⍠⎕⍞∆⍙∇"
⋄ " !⍘"#$%&'()*+,-./"
⋄ "0123456789:;<=>?"
⋄ "@ABCDEFGHIJKLMNO"
⋄ "PQRSTUVWXYZ[\]^_"
⋄ "`abcdefghijklmno"
⋄ "pqrstuvwxyz{|}~·"
⋄ "⍺⍵⍶⍹⍬×÷⍟√⌊⌈⸠∧∨⍲⍱"
⋄ "≤≥≠⊲⊳⊴⊵≡≢⊕⊗⍴⊖⍮⊂⊃"
⋄ "⊇↑↓⊢⊣⍳⍸⌿∡ℜℑ∪∩§∊⌷"
⋄ "ϼ⍪⍒⍋⇂↾⍉⌹↗⊥⊤⋷⍕⍎⍷⊆"
⋄ "…⌺⧺ⵧ············"
⋄ "················"
⋄ "«»⊩⫣∙⁖⍣⇽⇾⸚⟜⊸⍛∘⍥⍤"
⋄ "⫤⊞ᑒᑣ⌓◠◡⌸ᑈᐵ¨↡↟⍅⍆⍨" ]
Encode⇇{ t←⎕Exists'⍺'⍰⍺⍠table ⋄ bytes←t⍳⍵ ⋄ ∨⍆bytes≥≢t: 2↗"invalid character" ⋄ bytes }
Decode⇇{ t←⎕Exists'⍺'⍰⍺⍠table ⋄ ∨⍆⍵≥≢t: 2↗"invalid code" ⋄ ⍵⊇t }