Заполнение матрицы по спирали, желательно на функциональном яп. Опции

[packa]

Интересует алгоритм заполнения матрицы по спирали.

Что значит заполнение по спирали

Код

01 02 03 04 05 06 07
24 25 26 27 28 29 08
23 40 41 42 43 30 09
22 39 48 49 44 31 10
21 38 47 46 45 32 11
20 37 36 35 34 33 12
19 18 17 16 15 14 13

Что в данном случае матрица:

Матрица это список списков

Код

'( (01 02 03 04 05 06 07)
(24 25 26 27 28 29 08)
(23 40 41 42 43 30 09)
(22 39 48 49 44 31 10)
(21 38 47 46 45 32 11)
(20 37 36 35 34 33 12)
(19 18 17 16 15 14 13) )

Собственно внешний контур еще как то удается обработать
(взять первый элемент матрицы,
взять первый элемент в каждом инвертированном элементе матрицы
взять первый элемент инвертированной матрицы
и наконец взять первый элемент в каждом элементе матрицы)

Как поступать далее не знаю. Собственно из описания видно что самое лучшее что мы умеем это брать первый элемент чего-то(соответственно и последний)
Что то из середины брать довольно трудно и нет специальных инструментов
Конечно их можно попробовать сделать, но это другая опера.

язык scheme но не думаю что кто то здесь достаточно хорошо с ним знаком)

[gamecreator]

реализация на common lisp (+ бонусная функция вывода матрицы на экран)

(Раскрыть)

Код

(defun -vector-print (vector)
    (cond (vector
        (princ (car vector))
        (princ #\TAB)
        (-vector-print (cdr vector))
    ))
)

(defun vector-print (vector)
    (princ #\NEWLINE)
    (-vector-print vector)
)

(defun matrix-print (matrix)
    (cond (matrix
        (vector-print (car matrix))
        (matrix-print (cdr matrix))
    ))
)

(defun -make-range-list (start end)
    (cond
        ((= start end) (cons start nil))
        ((< start end) (cons start (-make-range-list (+ start 1) end)))
        (t             (cons start (-make-range-list (- start 1) end)))
    )
)

(defun -mapcar2 (function-2args list1 list2)
    (cond
        ((or list1 list2)
            (cons
                (funcall function-2args (car list1) (car list2))
                (-mapcar2 function-2args (cdr list1) (cdr list2))
            )
        )
        (t nil)
    )
)

(defun -spiral-matrix-du (start width height)
    (cond
        ((or (>= 0 width) (>= 0 height)) nil)
        (t
            (-mapcar2
                'cons
                (-make-range-list (+ start height -1) start)
                (-spiral-matrix-lr (+ start height) (- width 1) height)
            )
        )
    )
)

(defun -spiral-matrix-rl (start width height)
    (cond
        ((or (>= 0 width) (>= 0 height)) nil)
        (t
            (append
                (-spiral-matrix-du (+ start width) width (- height 1))
                (cons (-make-range-list (+ start width -1) start) nil)
            )
        )
    )
)

(defun -spiral-matrix-ud (start width height)
    (cond
        ((or (>= 0 width) (>= 0 height)) nil)
        (t
            (-mapcar2
                (lambda (a b) (append a (cons b nil)))
                (-spiral-matrix-rl (+ start height) (- width 1) height)
                (-make-range-list start (+ start height -1))
            )
        )
    )
)

(defun -spiral-matrix-lr (start width height)
    (cond
        ((or (>= 0 width) (>= 0 height)) nil)
        (t
            (cons
                (-make-range-list start (+ start width -1))
                (-spiral-matrix-ud (+ start width) width (- height 1))
            )
        )
    )
)

(defun spiral-matrix (width height)
    (cond
        ((and (numberp width) (numberp height)) (-spiral-matrix-lr 1 width height))
        (t nil)
    )
)

[Shurup]

На джаваскрипт

Код

    var directions=[[1,0],[0,1],[-1,0],[0,-1]];
    var matrix = [
        [0,0,0,0,0,0,0],
        [0,0,0,0,0,0,0],
        [0,0,0,0,0,0,0],
        [0,0,0,0,0,0,0],
        [0,0,0,0,0,0,0],
        [0,0,0,0,0,0,0],
        [0,0,0,0,0,0,0],        
    ]


    function fillSpirale(col,row,direction,W,H,index){
        var    curdir =  directions[direction];
        var count = curdir[0]?W:H;
        if (!count){
            return;
        }
        for (var i=0;i<count;i++){
            col += curdir[0];
            row += curdir[1];
            matrix[row][col]=index++;            
        }
        direction++;
        if (direction >3){
            direction=0;
        }
        W-=Math.abs(curdir[1]);     //если проходили  вертикально - то теперь ширина меньше на 1.
        H-=Math.abs(curdir[0]);
        fillSpirale(col,row,direction,W,H,index);
    }

    fillSpirale(-1,0,0,7,7,1);

Можно было бы конечно не использовать глобальный массив, а передавать его в функцию, да и решение с "-1" колонкой мне тоже не очень нравится. Но смысл вроде понятен.

[gamecreator]

более изящное решение (использует -make-range-list из предыдущего)

(Раскрыть)

Код

(defun -multi-and (lst)
    (cond
        ((listp lst)
            (cond
                ((cdr lst) (and (car lst) (-multi-and (cdr lst))))
                (t (car lst))
            )
        )
        (t lst)
    )
)

(defun rotate-matrix (matrix)
    (cond
        ((-multi-and matrix)
            (cons
                (reverse (mapcar 'car matrix))
                (rotate-matrix (mapcar 'cdr matrix))
            )
        )
        (t nil)
    )
)

(defun -spiral-matrix-alt (start width height)
    (cond
        ((or (>= 0 width) (>= 0 height)) nil)
        (t
            (cons
                (-make-range-list start (+ start width -1))
                (rotate-matrix (-spiral-matrix-alt (+ start width) (- height 1) width))
            )
        )
    )
)

(defun spiral-matrix-alt (width height)
    (cond
        ((and (numberp width) (numberp height)) (-spiral-matrix-alt 1 width height))
        (t nil)
    )
)

[packa]

t = else
nil = null ?

Кто вообще придумал такое? Не можно чтоли более говорящие название, а не "t"

Почему кстати не через if? у тебя же одноступенчатые

[tolich]

packa: это LISP, детка!

t = else

t это ... true

[packa]

Довольно неожиданно.
Всмысле условие при true идет в конце???

Опять они со своим синтаксисом шутят?)

[tolich]

Да, последняя ветка для условия true. Можно было бы сказать, что да, это такое else, но это не совсем верно.

[gamecreator]

nil = null ?

да, или ложь. в зависимости от контекста.

Почему кстати не через if? у тебя же одноступенчатые

мне больше нравится cond, он универсальный

[tolich]

Он кондовее. )))

[packa]

На паре вот так запилили:

Код

    #lang racket
    
    (define (matr n name)
      ;==========
      (define (build-matr m n func)
        (build-list m (λ (x) (build-list n (λ (y) (func x y))))))
         ;==========
      (define (proc i j)
        (define (iter i j s n)
          (cond
            ((= i (- n 1)) (+ s (* 2 (- n 1)) (- n j)))
            ((= i 0)       (+ s j 1))
            ((= j (- n 1)) (+ s n i))
            ((= j 0)       (- (+ s (* n 4) ) i 3))
            (else (iter (- i 1) (- j 1) (+ s(* 4 (- n 1)) ) (- n 2)))))
        (iter i j 0 n))
         ;=========
      (define out (open-output-file name #:exists 'replace))
      (define mat (build-matr n n proc))
      (for-each (λ (line)
                  (for-each (λ (ch)
                              (write ch out) (write-char #\ out)) line)
                  (write-char #\return out)
                  (write-char #\newline out)) mat)
      (close-output-port out))

[gamecreator]

кто вас только учит форматировать код

[Guevara-chan]

Списки, списки everywhere... Никакой вам лямбды, но душа на месте:

Код

Structure OfIntegarz : List _.i() : EndStructure
NewList Matrix.OfIntegarz(); Essential.
#TestWidth = 6 : #TestHeight = #TestWidth : #Edge = 99; Settings.

Procedure SetUp(List List.OfIntegarz(), Width, Height, Edge = #Edge); Make.it, kinda essential as well...
Define I, K, *Childe.OfIntegarz : ResetList(List())
For I = 1 To Height : AddElement(List()) : *Childe = @List()
For K = 1 To Width  : AddElement(*Childe\_()) : *Childe\_() = Random(Edge)
Next K : Next I
EndProcedure
;/-\-/-\-/-\-/-\-/-\-/-\-/-\-/-\-/-\-/-\-/-\-/-\-/-\-/-\-/-\-/-\-/-\-/-\-/-\-/-\-/-\-/-\-/-\-/-\-/-\-/-\-/-\-/-\-/-\-/-\
Macro NE : NextElement     : EndMacro
Macro PE : PreviousElement : EndMacro
Macro AEdge(Val, Neg, Pos, Det, Sect) : Bool(Val >= (Neg+Det) And Val < (Pos-(Det)) And (Sect)) : EndMacro
Macro REdge(Val, Neg, Pos, Det, Sect) : Bool(Val > (Neg+Det) And Val <= (Pos-(Det)) And (Sect)) : EndMacro

Procedure Fillomania(List List.OfIntegarz()); Spiral.it, you asked for that.
Define Y, YBound = ListSize(List()) - 1, *P.Point
Define X, XBound = ListSize(List()\_()) - 1, Accum
Define XHalf.f = (XBound+1) / 2.0
Define YHalf.f = (YBound+1) / 2.0
NewList Edgez.Point(); Caching.
ForEach List() : AddElement(Edgez()) : *P = @Edgez(); Speeding future up...
FirstElement(List()\_()) : *P\X = @List()\_() : LastElement(List()\_()) : *P\Y = @List()\_()
Next : FirstElement(List()) : FirstElement(List()\_()) : FirstElement(Edgez())
List()\_() = Accum : Repeat : Select #True
Case AEdge(X, -1, XBound, Y, Y < YHalf)  : NE(List()\_()) : X + 1
Case AEdge(Y, 0, YBound, XBound-X, 1.0+X > XHalf) : NE(List()) : NE(Edgez()) : Y + 1 : ChangeCurrentElement(List()\_(), EdgeZ()\Y)
PE(List()\_()) : EdgeZ()\Y = @List()\_() : NE(List()\_())
Case REdge(X, 0, XBound, YBound-Y, 1.0+Y > YHalf) : PE(List()\_())  : X - 1
Case REdge(Y, 1, YBound, X, X < XHalf)   : PE(List()) : PE(Edgez()) : Y - 1 : ChangeCurrentElement(List()\_(), EdgeZ()\X)
NE(List()\_()) : EdgeZ()\X = @List()\_() : PE(List()\_())
Default : Break; Acceptable. From reality.
EndSelect : Accum + 1 : List()\_() = Accum  : ForEver
EndProcedure
;\-/-\-/-\-/-\-/-\-/-\-/-\-/-\-/-\-/-\-/-\-/-\-/-\-/-\-/-\-/-\-/-\-/-\-/-\-/-\-/-\-/-\-/-\-/-\-/-\-/-\-/-\-/-\-/-\-/-\-/
;{ Graphic whistlez:
Macro Delim() : LSet("", 28, "=") : EndMacro
Macro Service() : ConsoleColor(3, 0) : EndMacro
Macro Dourly()  : ConsoleColor(7, 0) : EndMacro
Macro Digitz(Val) : (Int(Log10(Val))+1) : EndMacro

Procedure ShowDown(List List.OfIntegarz(), Padding); Show.it, I'm just gonna leave it here:
Define IP = Digitz(ListSize(List())-1)
ForEach List() : Print("["+RSet(Str(ListIndex(List())), IP, "0") + "]: ")
Define *Childe.OfIntegarz = @List()
ForEach *Childe\_() : Print(RSet(Str(*Childe\_()), Padding, "0") + ", ") : Next
Print(#BS$+#BS$+";"+#CRLF$) : Next
EndProcedure

OpenConsole() : ConsoleColor(10, 0) : PrintN("Broken Helix v"+Pow(10, -10)+#CRLF$+Delim())
SetUp(Matrix(), #TestWidth, #TestHeight) : Dourly() : ShowDown(Matrix(), Digitz(#Edge))
Service() : PrintN(Delim()+#CRLF$+"Now, here goes some spiralz:"+#CRLF$+Delim())
Fillomania(Matrix()) : Dourly() : ShowDown(Matrix(), Digitz(#TestWidth*#TestHeight-1))
Service() : Print(Delim()+#CRLF$+"Press ENTER to exit...")
Input(); Press ENTER key to exit. No, really.
;} EndWhistlez.

P.S. Для прямоугольной матрицы можно, в принципе, упростить секторные тесты до счетчика: будет чуть быстрее и красивше.