DZone Snippets: series code

R3 compatible MAP

gregg.irwin (Gregg Irwin) — Fri, 29 Feb 2008 05:36:32 GMT

; Not terrribly efficient, but it works.



    ; R3-compatible interface

    map: func ['word data [block!] body [block!]] [

        collect/only res compose/deep [

            repeat (word) data [res: do bind/copy body (to lit-word! word)]

        ]

    ]

execute a task serially on different hosts, not in parallel

stephen.judkins (stephen judkins) — Wed, 18 Apr 2007 19:37:06 GMT

// This code will let you define a task, using the same conventions as Capistrano's "task", that executes serially on the hosts defined by its role rather than in parallel. This is useful if you are deploying to multiple live servers behind a load balancer, the deployment process takes down the server, and you want only one server down at a given time.

This efinitely uses magic. we're not sure if this will work in future versions of Capistrano, but changing it should be relatively simple.



def serial_task(name, options = {}, &block)

  servers = self.roles[options[:roles]].collect {|server| server.host}

  task_syms = []

  servers.each do |hostname|

    role_sym = "_serial_task_#{name.to_s}_#{hostname}".to_sym

    task_sym = "_do_task_#{name.to_s}_#{hostname}".to_sym

    task_syms << task_sym

    role role_sym, hostname

    task task_sym, :roles => role_sym, &block

  end

  task name do

    task_syms.each do |t|

      self.send t

    end

  end

end

Here is an example. Note the syntax is just the same as Capistrano's "task".



serial_task :pwd, :roles => web do

  run "pwd"

end

MERGE two series

gregg.irwin (Gregg Irwin) — Wed, 11 Apr 2007 16:19:19 GMT



merge: func [

    "Merge A and B together, like a zipper, alternating elements"

    a [series!]

    b [series!]

    /only "Merge items as sub-blocks"

    /local res val

][

    res: make a length? a

    repeat i max length? a length? b [

        val: reduce [pick a i  pick b i]

        either only [append/only res val] [append res val]

    ]

    res

]

LIMIT - Make sure val falls between lower and upper bounds, inclusive; uses length for series values.

gregg.irwin (Gregg Irwin) — Fri, 08 Dec 2006 22:46:02 GMT



    limit: func [

        "Make sure val falls between lower and upper bounds, inclusive; uses length for series values."

        val

        lower [integer!]

        upper [integer!]

        /show "For series values, show extension/truncation (dot/none for extension, 3 dots for truncation)."

        /local fill

    ][

        either not series? val [max min val upper lower] [

            either all [

                upper >= length? val

                lower <= length? val

            ] [val] [

                ; If extending the series, use NONE as the fill value, so the

                ; block can still be processed easily.

                fill: either any-string? val ["."] [none]

                head either lower >= length? val [

                    insert/only/dup tail val fill subtract lower length? val

                ][

                    clear skip val upper

                    either show [change/dup skip tail val -3 '. 3] [val]

                ]

            ]

        ]

    ]

sparse-rec-to-fixed-block

gregg.irwin (Gregg Irwin) — Sun, 19 Nov 2006 02:22:05 GMT



	sparse-rec-to-fixed-block: func [

		rec [block!]

		col-names [block!] "All column names in full schema"

	][

		if not all-words? col-names [alert join "sparse-rec-to-fixed-block: col-names has non-word values: " mold col-names]

		collect/only val [

			foreach name col-names [

				val: attempt [first select/skip rec name 2]

			]

		]

	]

sparse-rec?

gregg.irwin (Gregg Irwin) — Sun, 19 Nov 2006 02:17:56 GMT



	; Like named-fields?, this func can't guarantee that a record is really

	; a sparse rec; it can only tell us if it's not.

	sparse-rec?: func [

		rec [block!]

		col-names [block!] "All column names in full schema"

	][

		if not all-words? col-names [alert join "sparse-rec?: col-names has non-word values: " mold col-names]

		all [

			named-fields? rec

			(length? rec) <> (2 * length? col-names) 

		]

	]

sort-by-length - sort a series by element length

gregg.irwin (Gregg Irwin) — Mon, 02 Oct 2006 23:21:03 GMT



    sort-by-length: func [series] [sort/compare series :cmp-length]

cmp-length - compare the length of two series and return -1, 0, or 1, to support stable sorts by length

gregg.irwin (Gregg Irwin) — Mon, 02 Oct 2006 23:19:39 GMT



    ; Support func for stable sort comparator

    cmp-length: func [a [series!] b [series!] /local len-a len-b] [

        len-a: length? a

        len-b: length? b

        case [

            len-a < len-b [-1]

            len-a > len-b [1]

            len-a = len-b [0]

        ]

    ]

drop-highest - remove the highest value from a series

gregg.irwin (Gregg Irwin) — Fri, 29 Sep 2006 18:31:03 GMT



drop-highest: func [block] [head remove maximum-of block]

drop-lowest - remove the lowest value from a series

gregg.irwin (Gregg Irwin) — Fri, 29 Sep 2006 18:30:17 GMT



drop-lowest:  func [block] [head remove minimum-of block]