YAPC::EU 2018 Glasgow Update!
This commit is contained in:
Ingy döt Net
parent
22f33d4004
commit
4e2d22a71d
1170 changed files with 15042 additions and 3047 deletions
|
|
@ -1,83 +1,167 @@
|
|||
-- SPIRAL MATRIX -------------------------------------------------------------
|
||||
-- spiral :: Int -> [[Int]]
|
||||
on spiral(n)
|
||||
script go
|
||||
on |λ|(rows, cols, start)
|
||||
if 0 < rows then
|
||||
{enumFromTo(start, start + pred(cols))} & ¬
|
||||
map(my |reverse|, ¬
|
||||
(transpose(|λ|(cols, pred(rows), start + cols))))
|
||||
else
|
||||
{{}}
|
||||
end if
|
||||
end |λ|
|
||||
end script
|
||||
|
||||
-- spiral :: Int -> Int -> Int -> [[Int]]
|
||||
on spiral(lngRows, lngCols, nStart)
|
||||
if lngRows > 0 then
|
||||
{enumFromTo(nStart, (nStart + lngCols) - 1)} & ¬
|
||||
map(my |reverse|, ¬
|
||||
transpose(spiral(lngCols, lngRows - 1, nStart + lngCols)))
|
||||
else
|
||||
{{}}
|
||||
end if
|
||||
go's |λ|(n, n, 0)
|
||||
end spiral
|
||||
|
||||
|
||||
-- TEST ----------------------------------------------------------------------
|
||||
-- TEST ------------------------------------------------------------------
|
||||
on run
|
||||
set n to 5
|
||||
set lstSpiral to spiral(n, n, 0)
|
||||
|
||||
-- {{0, 1, 2, 3, 4}, {15, 16, 17, 18, 5}, {14, 23, 24, 19, 6},
|
||||
-- {13, 22, 21, 20, 7}, {12, 11, 10, 9, 8}}
|
||||
|
||||
wikiTable(lstSpiral, ¬
|
||||
wikiTable(spiral(5), ¬
|
||||
false, ¬
|
||||
"text-align:center;width:12em;height:12em;table-layout:fixed;")
|
||||
end run
|
||||
|
||||
|
||||
-- WIKI TABLE FORMAT ---------------------------------------------------------
|
||||
|
||||
-- wikiTable :: [Text] -> Bool -> Text -> Text
|
||||
on wikiTable(lstRows, blnHdr, strStyle)
|
||||
script fWikiRows
|
||||
on |λ|(lstRow, iRow)
|
||||
set strDelim to cond(blnHdr and (iRow = 0), "!", "|")
|
||||
set strDelim to if_(blnHdr and (iRow = 0), "!", "|")
|
||||
set strDbl to strDelim & strDelim
|
||||
linefeed & "|-" & linefeed & strDelim & space & ¬
|
||||
intercalate(space & strDbl & space, lstRow)
|
||||
intercalateS(space & strDbl & space, lstRow)
|
||||
end |λ|
|
||||
end script
|
||||
|
||||
linefeed & "{| class=\"wikitable\" " & ¬
|
||||
cond(strStyle ≠ "", "style=\"" & strStyle & "\"", "") & ¬
|
||||
intercalate("", ¬
|
||||
if_(strStyle ≠ "", "style=\"" & strStyle & "\"", "") & ¬
|
||||
intercalateS("", ¬
|
||||
map(fWikiRows, lstRows)) & linefeed & "|}" & linefeed
|
||||
end wikiTable
|
||||
|
||||
-- GENERIC ------------------------------------------------------------------
|
||||
|
||||
-- GENERIC FUNCTIONS ---------------------------------------------------------
|
||||
-- comparing :: (a -> b) -> (a -> a -> Ordering)
|
||||
on comparing(f)
|
||||
script
|
||||
on |λ|(a, b)
|
||||
tell mReturn(f)
|
||||
set fa to |λ|(a)
|
||||
set fb to |λ|(b)
|
||||
if fa < fb then
|
||||
-1
|
||||
else if fa > fb then
|
||||
1
|
||||
else
|
||||
0
|
||||
end if
|
||||
end tell
|
||||
end |λ|
|
||||
end script
|
||||
end comparing
|
||||
|
||||
-- cond :: Bool -> a -> a -> a
|
||||
on cond(bool, x, y)
|
||||
-- concatMap :: (a -> [b]) -> [a] -> [b]
|
||||
on concatMap(f, xs)
|
||||
set lng to length of xs
|
||||
if 0 < lng and class of xs is string then
|
||||
set acc to ""
|
||||
else
|
||||
set acc to {}
|
||||
end if
|
||||
tell mReturn(f)
|
||||
repeat with i from 1 to lng
|
||||
set acc to acc & |λ|(item i of xs, i, xs)
|
||||
end repeat
|
||||
end tell
|
||||
return acc
|
||||
end concatMap
|
||||
|
||||
-- enumFromTo :: Int -> Int -> [Int]
|
||||
on enumFromTo(m, n)
|
||||
if m ≤ n then
|
||||
set lst to {}
|
||||
repeat with i from m to n
|
||||
set end of lst to i
|
||||
end repeat
|
||||
return lst
|
||||
else
|
||||
return {}
|
||||
end if
|
||||
end enumFromTo
|
||||
|
||||
-- foldl :: (a -> b -> a) -> a -> [b] -> a
|
||||
on foldl(f, startValue, xs)
|
||||
tell mReturn(f)
|
||||
set v to startValue
|
||||
set lng to length of xs
|
||||
repeat with i from 1 to lng
|
||||
set v to |λ|(v, item i of xs, i, xs)
|
||||
end repeat
|
||||
return v
|
||||
end tell
|
||||
end foldl
|
||||
|
||||
-- if_ :: Bool -> a -> a -> a
|
||||
on if_(bool, x, y)
|
||||
if bool then
|
||||
x
|
||||
else
|
||||
y
|
||||
end if
|
||||
end cond
|
||||
end if_
|
||||
|
||||
-- enumFromTo :: Int -> Int -> [Int]
|
||||
on enumFromTo(m, n)
|
||||
if m > n then
|
||||
set d to -1
|
||||
else
|
||||
set d to 1
|
||||
end if
|
||||
set lst to {}
|
||||
repeat with i from m to n by d
|
||||
set end of lst to i
|
||||
end repeat
|
||||
return lst
|
||||
end enumFromTo
|
||||
|
||||
-- Text -> [Text] -> Text
|
||||
on intercalate(strText, lstText)
|
||||
set {dlm, my text item delimiters} to {my text item delimiters, strText}
|
||||
set strJoined to lstText as text
|
||||
-- intercalateS :: String -> [String] -> String
|
||||
on intercalateS(sep, xs)
|
||||
set {dlm, my text item delimiters} to {my text item delimiters, sep}
|
||||
set s to xs as text
|
||||
set my text item delimiters to dlm
|
||||
return strJoined
|
||||
end intercalate
|
||||
return s
|
||||
end intercalateS
|
||||
|
||||
-- length :: [a] -> Int
|
||||
on |length|(xs)
|
||||
length of xs
|
||||
end |length|
|
||||
|
||||
-- max :: Ord a => a -> a -> a
|
||||
on max(x, y)
|
||||
if x > y then
|
||||
x
|
||||
else
|
||||
y
|
||||
end if
|
||||
end max
|
||||
|
||||
-- maximumBy :: (a -> a -> Ordering) -> [a] -> a
|
||||
on maximumBy(f, xs)
|
||||
set cmp to mReturn(f)
|
||||
script max
|
||||
on |λ|(a, b)
|
||||
if a is missing value or cmp's |λ|(a, b) < 0 then
|
||||
b
|
||||
else
|
||||
a
|
||||
end if
|
||||
end |λ|
|
||||
end script
|
||||
|
||||
foldl(max, missing value, xs)
|
||||
end maximumBy
|
||||
|
||||
-- Lift 2nd class handler function into 1st class script wrapper
|
||||
-- mReturn :: First-class m => (a -> b) -> m (a -> b)
|
||||
on mReturn(f)
|
||||
if class of f is script then
|
||||
f
|
||||
else
|
||||
script
|
||||
property |λ| : f
|
||||
end script
|
||||
end if
|
||||
end mReturn
|
||||
|
||||
-- map :: (a -> b) -> [a] -> [b]
|
||||
on map(f, xs)
|
||||
|
|
@ -91,17 +175,28 @@ on map(f, xs)
|
|||
end tell
|
||||
end map
|
||||
|
||||
-- Lift 2nd class handler function into 1st class script wrapper
|
||||
-- mReturn :: Handler -> Script
|
||||
on mReturn(f)
|
||||
if class of f is script then
|
||||
f
|
||||
else
|
||||
script
|
||||
property |λ| : f
|
||||
end script
|
||||
end if
|
||||
end mReturn
|
||||
-- pred :: Enum a => a -> a
|
||||
on pred(x)
|
||||
(-1) + x
|
||||
end pred
|
||||
|
||||
-- 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)
|
||||
set out to {}
|
||||
if n < 1 then return out
|
||||
set dbl to {a}
|
||||
|
||||
repeat while (n > 1)
|
||||
if (n mod 2) > 0 then set out to out & dbl
|
||||
set n to (n div 2)
|
||||
set dbl to (dbl & dbl)
|
||||
end repeat
|
||||
return out & dbl
|
||||
end replicate
|
||||
|
||||
|
||||
-- reverse :: [a] -> [a]
|
||||
on |reverse|(xs)
|
||||
|
|
@ -112,19 +207,48 @@ on |reverse|(xs)
|
|||
end if
|
||||
end |reverse|
|
||||
|
||||
-- If some of the rows are shorter than the following rows,
|
||||
-- their elements are skipped:
|
||||
-- transpose({{10,11},{20},{},{30,31,32}}) -> {{10, 20, 30}, {11, 31}, {32}}
|
||||
-- transpose :: [[a]] -> [[a]]
|
||||
on transpose(xss)
|
||||
script column
|
||||
on |λ|(_, iCol)
|
||||
script row
|
||||
on |λ|(xs)
|
||||
item iCol of xs
|
||||
end |λ|
|
||||
end script
|
||||
|
||||
map(row, xss)
|
||||
on transpose(xxs)
|
||||
set intMax to |length|(maximumBy(comparing(my |length|), xxs))
|
||||
set gaps to replicate(intMax, {})
|
||||
script padded
|
||||
on |λ|(xs)
|
||||
set lng to |length|(xs)
|
||||
if lng < intMax then
|
||||
xs & items (lng + 1) thru -1 of gaps
|
||||
else
|
||||
xs
|
||||
end if
|
||||
end |λ|
|
||||
end script
|
||||
set rows to map(padded, xxs)
|
||||
|
||||
map(column, item 1 of xss)
|
||||
script cols
|
||||
on |λ|(_, iCol)
|
||||
script cell
|
||||
on |λ|(row)
|
||||
item iCol of row
|
||||
end |λ|
|
||||
end script
|
||||
concatMap(cell, rows)
|
||||
end |λ|
|
||||
end script
|
||||
map(cols, item 1 of rows)
|
||||
end transpose
|
||||
|
||||
-- unlines :: [String] -> String
|
||||
on unlines(xs)
|
||||
set {dlm, my text item delimiters} to ¬
|
||||
{my text item delimiters, linefeed}
|
||||
set str to xs as text
|
||||
set my text item delimiters to dlm
|
||||
str
|
||||
end unlines
|
||||
|
||||
-- unwords :: [String] -> String
|
||||
on unwords(xs)
|
||||
intercalateS(space, xs)
|
||||
end unwords
|
||||
|
|
|
|||
|
|
@ -1,11 +1,27 @@
|
|||
import Data.List (transpose)
|
||||
import Data.List (intercalate, transpose)
|
||||
import Control.Monad (join)
|
||||
|
||||
spiral :: Int -> Int -> Int -> [[Int]]
|
||||
spiral rows cols start =
|
||||
if rows > 0
|
||||
then [start .. start + cols - 1] :
|
||||
(reverse <$> transpose (spiral cols (rows - 1) (start + cols)))
|
||||
else [[]]
|
||||
spiral :: Int -> [[Int]]
|
||||
spiral n = go n n 0
|
||||
where
|
||||
go rows cols start =
|
||||
if 0 < rows
|
||||
then [start .. start + pred cols] :
|
||||
fmap reverse (transpose $ go cols (pred rows) (start + cols))
|
||||
else [[]]
|
||||
|
||||
main :: IO ()
|
||||
main = mapM_ print $ spiral 5 5 0
|
||||
main = putStrLn $ wikiTable (spiral 5)
|
||||
|
||||
|
||||
-- TABLE FORMATTING ----------------------------------------
|
||||
|
||||
wikiTable :: Show a => [[a]] -> String
|
||||
wikiTable =
|
||||
join .
|
||||
("{| class=\"wikitable\" style=\"text-align:center;" :) .
|
||||
("width:12em;height:12em;table-layout:fixed;\"\n|-\n" :) .
|
||||
return .
|
||||
(++ "\n|}") .
|
||||
intercalate "\n|-\n" .
|
||||
fmap (('|' :) . (' ' :) . intercalate " || " . fmap show)
|
||||
|
|
|
|||
|
|
@ -1,67 +1,122 @@
|
|||
(n => {
|
||||
(() => {
|
||||
'use strict';
|
||||
|
||||
// spiral :: the first row plus a smaller spiral rotated 90 degrees clockwise
|
||||
// spiral :: Int -> Int -> Int -> [[Int]]
|
||||
function spiral(lngRows, lngCols, nStart) {
|
||||
return lngRows ? [range(nStart, (nStart + lngCols) - 1)]
|
||||
.concat(
|
||||
transpose(
|
||||
spiral(lngCols, lngRows - 1, nStart + lngCols)
|
||||
// main :: () -> String
|
||||
const main = () =>
|
||||
unlines(
|
||||
map(unwords, spiral(5))
|
||||
);
|
||||
|
||||
// spiral :: Int -> [[Int]]
|
||||
const spiral = n => {
|
||||
const go = (rows, cols, start) =>
|
||||
0 < rows ? [
|
||||
enumFromTo(start, start + pred(cols)),
|
||||
...map(
|
||||
reverse,
|
||||
transpose(
|
||||
go(
|
||||
cols,
|
||||
pred(rows),
|
||||
start + cols
|
||||
)
|
||||
)
|
||||
)
|
||||
.map(reverse)
|
||||
) : [[]];
|
||||
}
|
||||
] : [
|
||||
[]
|
||||
];
|
||||
return go(n, n, 0);
|
||||
};
|
||||
|
||||
// transpose :: [[a]] -> [[a]]
|
||||
function transpose(xs) {
|
||||
return xs[0]
|
||||
.map((_, iCol) => xs
|
||||
.map((row) => row[iCol]));
|
||||
}
|
||||
// GENERIC FUNCTIONS ----------------------------------
|
||||
|
||||
// comparing :: (a -> b) -> (a -> a -> Ordering)
|
||||
const comparing = f =>
|
||||
(x, y) => {
|
||||
const
|
||||
a = f(x),
|
||||
b = f(y);
|
||||
return a < b ? -1 : (a > b ? 1 : 0);
|
||||
};
|
||||
|
||||
// concatMap :: (a -> [b]) -> [a] -> [b]
|
||||
const concatMap = (f, xs) =>
|
||||
0 < xs.length ? (() => {
|
||||
const unit = 'string' !== typeof xs ? (
|
||||
[]
|
||||
) : '';
|
||||
return unit.concat.apply(unit, xs.map(f))
|
||||
})() : [];
|
||||
|
||||
// enumFromTo :: Int -> Int -> [Int]
|
||||
const enumFromTo = (m, n) =>
|
||||
m <= n ? iterateUntil(
|
||||
x => n <= x,
|
||||
x => 1 + x,
|
||||
m
|
||||
) : [];
|
||||
|
||||
// iterateUntil :: (a -> Bool) -> (a -> a) -> a -> [a]
|
||||
const iterateUntil = (p, f, x) => {
|
||||
const vs = [x];
|
||||
let h = x;
|
||||
while (!p(h))(h = f(h), vs.push(h));
|
||||
return vs;
|
||||
};
|
||||
|
||||
// length :: [a] -> Int
|
||||
const length = xs => xs.length;
|
||||
|
||||
// map :: (a -> b) -> [a] -> [b]
|
||||
const map = (f, xs) => xs.map(f);
|
||||
|
||||
// Ordering: (LT|EQ|GT):
|
||||
// GT: 1 (or other positive n)
|
||||
// EQ: 0
|
||||
// LT: -1 (or other negative n)
|
||||
|
||||
// maximumBy :: (a -> a -> Ordering) -> [a] -> a
|
||||
const maximumBy = (f, xs) =>
|
||||
0 < xs.length ? (
|
||||
xs.slice(1)
|
||||
.reduce((a, x) => 0 < f(x, a) ? x : a, xs[0])
|
||||
) : undefined;
|
||||
|
||||
|
||||
// pred :: Enum a => a -> a
|
||||
const pred = x => x - 1;
|
||||
|
||||
// reverse :: [a] -> [a]
|
||||
function reverse(xs) {
|
||||
return xs.slice(0)
|
||||
.reverse();
|
||||
}
|
||||
const reverse = xs =>
|
||||
'string' !== typeof xs ? (
|
||||
xs.slice(0).reverse()
|
||||
) : xs.split('').reverse().join('');
|
||||
|
||||
// range(intFrom, intTo, optional intStep)
|
||||
// Int -> Int -> Maybe Int -> [Int]
|
||||
function range(m, n, step) {
|
||||
let d = (step || 1) * (n >= m ? 1 : -1);
|
||||
// replicate :: Int -> a -> [a]
|
||||
const replicate = (n, x) =>
|
||||
Array.from({
|
||||
length: n
|
||||
}, () => x);
|
||||
|
||||
return Array.from({
|
||||
length: Math.floor((n - m) / d) + 1
|
||||
}, (_, i) => m + (i * d));
|
||||
}
|
||||
// transpose :: [[a]] -> [[a]]
|
||||
const transpose = tbl => {
|
||||
const
|
||||
gaps = replicate(
|
||||
length(maximumBy(comparing(length), tbl)), []
|
||||
),
|
||||
rows = map(xs => xs.concat(gaps.slice(xs.length)), tbl);
|
||||
return map(
|
||||
(_, col) => concatMap(row => [row[col]], rows),
|
||||
rows[0]
|
||||
);
|
||||
};
|
||||
|
||||
// unlines :: [String] -> String
|
||||
const unlines = xs => xs.join('\n');
|
||||
|
||||
// unwords :: [String] -> String
|
||||
const unwords = xs => xs.join(' ');
|
||||
|
||||
// TESTING
|
||||
|
||||
// replicate :: Int -> String -> String
|
||||
function replicate(n, a) {
|
||||
var v = [a],
|
||||
o = '';
|
||||
|
||||
if (n < 1) return o;
|
||||
while (n > 1) {
|
||||
if (n & 1) o = o + v;
|
||||
n >>= 1;
|
||||
v = v + v;
|
||||
}
|
||||
return o + v;
|
||||
}
|
||||
|
||||
|
||||
return spiral(n, n, 0)
|
||||
.map(
|
||||
xs => xs.map(x => {
|
||||
let s = `${x}`;
|
||||
return replicate(4 - s.length, ' ') + s;
|
||||
})
|
||||
.join('')
|
||||
)
|
||||
.join('\n');
|
||||
|
||||
})(5);
|
||||
// MAIN ---
|
||||
return main();
|
||||
})();
|
||||
|
|
|
|||
|
|
@ -1,46 +1,53 @@
|
|||
# Project : Spiral matrix
|
||||
# Date : 2018/03/23
|
||||
# Author : Gal Zsolt [~ CalmoSoft ~]
|
||||
# Email : <calmosoft@gmail.com>
|
||||
|
||||
load "guilib.ring"
|
||||
load "stdlib.ring"
|
||||
n = 5
|
||||
result = newlist(n,n)
|
||||
k = 1
|
||||
top = 1
|
||||
bottom = n
|
||||
left = 1
|
||||
right = n
|
||||
while (k<=n*n)
|
||||
for i=left to right
|
||||
result[top][i]=k
|
||||
k = k + 1
|
||||
next
|
||||
top = top + 1
|
||||
for i=top to bottom
|
||||
result[i][right]=k
|
||||
k = k + 1
|
||||
next
|
||||
right = right - 1
|
||||
for i=right to left step -1
|
||||
result[bottom][i]=k
|
||||
k = k + 1
|
||||
next
|
||||
bottom = bottom - 1
|
||||
for i=bottom to top step -1
|
||||
result[i][left] = k
|
||||
k = k + 1
|
||||
next
|
||||
left = left + 1
|
||||
end
|
||||
for m = 1 to n
|
||||
for p = 1 to n
|
||||
if m = 1
|
||||
see " " + result[m][p]
|
||||
else
|
||||
see "" + result[m][p] + " "
|
||||
ok
|
||||
next
|
||||
see nl
|
||||
next
|
||||
see nl
|
||||
new qapp
|
||||
{
|
||||
win1 = new qwidget() {
|
||||
setwindowtitle("Spiral matrix")
|
||||
setgeometry(100,100,600,400)
|
||||
n = 5
|
||||
result = newlist(n,n)
|
||||
spiral = newlist(n,n)
|
||||
k = 1
|
||||
top = 1
|
||||
bottom = n
|
||||
left = 1
|
||||
right = n
|
||||
while (k <= n*n)
|
||||
for i= left to right
|
||||
result[top][i] = k
|
||||
k = k + 1
|
||||
next
|
||||
top = top + 1
|
||||
for i = top to bottom
|
||||
result[i][right] = k
|
||||
k = k + 1
|
||||
next
|
||||
right = right - 1
|
||||
for i = right to left step -1
|
||||
result[bottom][i] = k
|
||||
k = k + 1
|
||||
next
|
||||
bottom = bottom - 1
|
||||
for i = bottom to top step -1
|
||||
result[i][left] = k
|
||||
k = k + 1
|
||||
next
|
||||
left = left + 1
|
||||
end
|
||||
for m = 1 to n
|
||||
for p = 1 to n
|
||||
spiral[p][m] = new qpushbutton(win1) {
|
||||
x = 150+m*40
|
||||
y = 30 + p*40
|
||||
setgeometry(x,y,40,40)
|
||||
settext(string(result[m][p]))
|
||||
}
|
||||
next
|
||||
next
|
||||
show()
|
||||
}
|
||||
exec()
|
||||
}
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue