DF2 :: ФОРУМЫ > Заполнение матрицы по спирали

packa

17 Mar 2013, 11:25

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

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

Код

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

17 Mar 2013, 13:26

реализация на 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

17 Mar 2013, 14:26

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

Код

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

gamecreator

17 Mar 2013, 16:18

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

(Раскрыть)

packa

17 Mar 2013, 19:37

t = else
nil = null ?

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

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

tolich

17 Mar 2013, 19:47

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

Цитата(packa @ 17 Mar 2013, 19:37)

t = else

t это ... true

packa

17 Mar 2013, 20:45

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

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

tolich

17 Mar 2013, 21:03

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

gamecreator

17 Mar 2013, 22:02

Цитата(packa @ 17 Mar 2013, 18:37)

nil = null ?

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

Цитата(packa @ 17 Mar 2013, 18:37)

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

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

tolich

17 Mar 2013, 22:10

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

packa

18 Mar 2013, 19:49

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

Код

    #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

19 Mar 2013, 18:50

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

Guevara-chan

20 Mar 2013, 11:01

Списки, списки 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. Для прямоугольной матрицы можно, в принципе, упростить секторные тесты до счетчика: будет чуть быстрее и красивше.