Brad Dominy

Digits of π

In celebration of Pi Day, here is an AppleScript I wrote that outputs the digits of π until the machine runs out of memory and crashes horribly.

(*

From the paper "An Unbounded Spigot Algorithm for the Digits of Pi"
http://web.comlab.ox.ac.uk/oucl/work/jeremy.gibbons/publications/spigot.pdf

*)

property MINUS : -1
property PLUS : 1

set q to {1}
set r to {0}
set t to {1}
set k to {1}

repeat

    set n to divide(add(multiply({3}, q), r), t)

if compare(divide(add(multiply({4}, q), r), t), n) = 0 then

    log n
    set q to multiply({1, 0}, q)
    set r to multiply({1, 0}, subtract(r, multiply(n, t)))
else

    set r to add(multiply(q, add(multiply({4}, k), {2})), ¬
                           multiply(r, add(multiply({2}, k), {1})))
    set q to multiply(q, k)
    set t to multiply(t, add(multiply({2}, k), {1}))
    set k to add(k, {1})
end if
end repeat

on divide(a, b)

set c to {}

if (count of a) = 1 then
    if item 1 of a = 0 then
        return {0}
    end if
end if

if (count of b) = 1 then
    if item 1 of b = 0 then
        return c
    else if item 1 of b = 1 then
        return a
    end if
end if
if item 1 of a < 0 then
    set a_signbit to MINUS
else
    set a_signbit to PLUS
end if

if item 1 of b < 0 then
    set b_signbit to MINUS
else
    set b_signbit to PLUS
end if

set item 1 of a to (item 1 of a) * a_signbit
set item 1 of b to (item 1 of b) * b_signbit

set row to {}

repeat with i from 1 to count of a

    set the end of row to item i of a
    set row to trim_zeros(row)
    set n to 0
    repeat while compare(row, b) ≠ PLUS
        set n to n + 1
        set row to subtract(row, b)
    end repeat
    set the end of c to n
end repeat

set item 1 of a to (item 1 of a) * a_signbit
set item 1 of b to (item 1 of b) * b_signbit

set c to trim_zeros(c)

set item 1 of c to (item 1 of c) * a_signbit * b_signbit

return c
end divide

on multiply(a, b)
set c to {0}

if (count of a) = 1 then
    if item 1 of a = 0 then
        return c
    else if item 1 of a = 1 then
        return b
    end if
end if
if (count of b) = 1 then
    if item 1 of b = 0 then
        return c
    else if item 1 of b = 1 then
        return a
    end if
end if

if item 1 of a < 0 then
    set a_signbit to MINUS
else
    set a_signbit to PLUS
end if

if item 1 of b < 0 then
    set b_signbit to MINUS
else
    set b_signbit to PLUS
end if

set item 1 of a to (item 1 of a) * a_signbit
set item 1 of b to (item 1 of b) * b_signbit

copy a to t --fast but uses more memory
set b_count to count of b
repeat with i from b_count to 1 by -1
    repeat (item i of b) times
        set c to add(c, t)
    end repeat
    set t to shift(t, 1)
end repeat

set item 1 of a to (item 1 of a) * a_signbit
set item 1 of b to (item 1 of b) * b_signbit

set item 1 of c to (item 1 of c) * a_signbit * b_signbit
set c to trim_zeros(c)
return c
end multiply

on shift(n, d)
repeat d times
    set the end of n to 0
end repeat
return n
end shift

on subtract(a, b)
set c to {}

if item 1 of a < 0 then
    set a_signbit to MINUS
else
    set a_signbit to PLUS
end if

if item 1 of b < 0 then
    set b_signbit to MINUS
else
    set b_signbit to PLUS
end if

if a_signbit = MINUS or b_signbit = MINUS then

    set item 1 of b to (item 1 of b) * MINUS
    set c to add(a, b)
    set item 1 of b to (item 1 of b) * MINUS

else if compare(a, b) = PLUS then

    set c to subtract(b, a)
    if item 1 of c > 0 then set item 1 of c to (item 1 of c) * MINUS

else
    set borrow to 0
    set v to 0

    set a_count to count of a
    set b_count to count of b

    set i to a_count
    set j to b_count

    repeat while i > 0 and j > 0

        set v to (item i of a) - borrow - (item j of b)
        if item i of a > 0 then set borrow to 0

        if v < 0 then
            set v to v + 10
            set borrow to 1
        end if

        set the beginning of c to v mod 10

        set i to i - 1
        set j to j - 1
    end repeat

    repeat while i > 0

        set v to (item i of a) - borrow
        if item i of a > 0 then set borrow to 0

        if v < 0 then
            set v to v + 10
            set borrow to 1
        end if

        set the beginning of c to v mod 10

        set i to i - 1

    end repeat

end if
return trim_zeros(c)
end subtract

on trim_zeros(a)
set a_count to count of a
set i to 1

repeat while i ≤ a_count
    if item i of a ≠ 0 then exit repeat
    set i to i + 1
end repeat

if i ≤ a_count then
    set a to items i thru -1 of a
else
    set a to {0}
end if
return a
end trim_zeros

on add(a, b)
set c to {}

if item 1 of a < 0 then
    set a_signbit to MINUS
else
    set a_signbit to PLUS
end if

if item 1 of b < 0 then
    set b_signbit to MINUS
else
    set b_signbit to PLUS
end if

if a_signbit ≠ b_signbit then
    if a_signbit = MINUS then
        set item 1 of a to (item 1 of a) * a_signbit
        set c to subtract(b, a)
        set item 1 of a to (item 1 of a) * a_signbit
    else
        set item 1 of b to (item 1 of b) * b_signbit
        set c to subtract(a, b)
        set item 1 of b to (item 1 of b) * b_signbit
    end if
else
    set carry to 0
    set a_count to count of a
    set b_count to count of b

    set i to a_count
    set j to b_count

    set item 1 of a to (item 1 of a) * a_signbit
    set item 1 of b to (item 1 of b) * b_signbit

    repeat while i > 0 and j > 0

        set n to (carry + (item i of a) + (item j of b))
        set the beginning of c to n mod 10
        if n < 10 then
            set carry to 0
        else
            set carry to 1
        end if

        set i to i - 1
        set j to j - 1
    end repeat

    repeat while i > 0

        set n to (carry + (item i of a))
        set the beginning of c to n mod 10
        if n < 10 then
            set carry to 0
        else
            set carry to 1
        end if

        set i to i - 1

    end repeat

    repeat while j > 0

        set n to (carry + (item j of b))
        set the beginning of c to n mod 10
        if n < 10 then
            set carry to 0
        else
            set carry to 1
        end if

        set j to j - 1

    end repeat

    set item 1 of a to (item 1 of a) * a_signbit
    set item 1 of b to (item 1 of b) * b_signbit

    if carry > 0 then set the beginning of c to carry

    set item 1 of c to (item 1 of c) * a_signbit

end if

return c
end add

on compare(a, b)

if item 1 of a < 0 then
    set a_signbit to MINUS
else
    set a_signbit to PLUS
end if

if item 1 of b < 0 then
    set b_signbit to MINUS
else
    set b_signbit to PLUS
end if

if a_signbit = MINUS and b_signbit = PLUS then return PLUS
if a_signbit = PLUS and b_signbit = MINUS then return MINUS

set a_count to count of a
set b_count to count of b
if b_count > a_count then return PLUS * a_signbit
if a_count > b_count then return MINUS * a_signbit

set r to 0
set item 1 of a to (item 1 of a) * a_signbit
set item 1 of b to (item 1 of b) * b_signbit

repeat with i from 1 to a_count
    if item i of a > item i of b then
        set r to MINUS * a_signbit
        exit repeat
    end if
    if item i of b > item i of a then
        set r to PLUS * a_signbit
        exit repeat
    end if
end repeat
set item 1 of a to (item 1 of a) * a_signbit
set item 1 of b to (item 1 of b) * b_signbit

return r
end compare

• AppleScript

Randomize Last Names

A script to randomize the last names of all of my Address Book contacts. Useful for protecting the innocent when taking screenshots of some of my other projects.

DON'T USE THIS WITHOUT MAKING A BACKUP FIRST!

Copy and paste into AppleScript Editor if you want to try it out.

set name_url to "http://names.mongabay.com/most_common_surnames.htm"

set t to do shell script "curl \"http://names.mongabay.com/most_common_surnames.htm\" -o /tmp/temp.html; cat /tmp/temp.html"

set name_list to {}
set the_lines to get every paragraph of t
set grabNamesFlag to false
set row_count to 0
repeat with this_line in the_lines

    if this_line begins with "<table" and this_line contains "table1" then
        set grabNamesFlag to true
    end if

    if grabNamesFlag then
        if this_line begins with "<tr" then
            set row_count to row_count + 1

            if row_count > 1 then
                set o1 to offset of "<td>" in this_line
                set o2 to offset of "</td>" in this_line

                set lname to text (o1 + 4) thru (o2 - 1) of this_line
                set the end of the name_list to capitalizeString(lname)
            end if
        else if this_line begins with "</table>" then
            exit repeat
        end if
    end if

end repeat

--return name_list
set out to ""
tell application "Address Book"

    set person_list to get every person

    repeat with this_person in person_list
        set old_lastname to last name of this_person
        if old_lastname is not equal to "Dominy" then
            set new_lastname to old_lastname
            repeat until new_lastname is not equal to old_lastname
                set new_lastname to some item in name_list
            end repeat
            set out to out & "replacing " & old_lastname & " with " & new_lastname & return
            set the last name of this_person to new_lastname
        end if
    end repeat

    save addressbook
end tell
return out

-- Translate characters of a text
-- Note: Pass the From and To tables as strings (same length!)
--
on translateChars(theText, fromChars, toChars)
    set the newText to ""
    if (count fromChars) is not equal to (count toChars) then
        error "translateChars: From/To strings have different length"
    end if
    repeat with char in theText
        set newChar to char
        set x to offset of char in the fromChars
        if x is not 0 then set newChar to character x of the toChars
        set newText to newText & newChar
    end repeat
    return the newText
end translateChars

-- Convert a text case to lower characters
-- Note: Requires the translateChars function
--
on lowerString(theText)
    set upper to "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
    set lower to "abcdefghijklmnopqrstuvwxyz"
    return translateChars(theText, upper, lower)
end lowerString

-- Convert a text case to upper characters
-- Note: Requires the translateChars function
--
on upperString(theText)
    set lower to "abcdefghijklmnopqrstuvwxyz"
    set upper to "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
    return translateChars(theText, lower, upper)
end upperString

-- Capitalize a text, returning only the first letter uppercased
-- Note: Requires translateChars, lowerString and upperString
--
on capitalizeString(theText)
    set firstChar to upperString(first character of theText)
    set otherChars to lowerString(characters 2 thru -1 of theText)
    return firstChar & otherChars
end capitalizeString

• AppleScript

vCards to Clipboard

A utility that puts the names of people into the clipboard from vCards. The cards can come directly from Address Book by selecting a group of cards and then dragging them onto the droplet.

Copy and paste into AppleScript Editor and then save as a droplet if you want to try it out.

on open vcards
set out to ""

repeat with this_vcard in vcards

    set p to POSIX path of this_vcard
    set s to "grep \"FN:\" " & encode(p) & "| cut -c 4-50"
    set out to do shell script s
end repeat

set the clipboard to out
end open

on encode(this_path)
set tmp to ""

repeat with i from 1 to length of this_path

    set ch to character i of this_path

    if ch is equal to space then set tmp to tmp & "\\"

    set tmp to tmp & ch
end repeat
return tmp
end encode

• AppleScript

iChat Stock Ticker

A fun little script that puts a scrolling stock ticker in your iChat status.

• Next image →
• ← Previous image

Copy and paste into AppleScript Editor if you want to try it out.

set stockList to {"^DJI", "^IXIC", "AAPL", "AKAM", "TIVO", "SIRI", "AIG", "MSFT", "STEC", "F", "ESLR", "GME", "UAUA", "BAC", "WFC"}
set upCh to "▲"
set dnCh to "▼"

repeat
set m to ""
repeat with daSymbol in stockList

    -- fetch quote page
    set q to do shell script "curl \"http://www.google.com/finance/info?client=ig&q=" & daSymbol & "\" -o /tmp/temp.html ; cat /tmp/temp.html"

    set pq to parse_quote(q)

    set m to m & _t of pq & " " & _l_cur of pq & " "
    set c to _c of pq as number

    if c < 0 then
        set m to m & dnCh
    else if c > 0 then
        set m to m & upCh
    else
        set m to m & "-"
    end if
    set m to m & " " & c & " ( " & _cp of pq & "% )       "
end repeat

set i to 0
set l to length of m

tell application "iChat" --to 
    repeat
        set i to i + 1

        set n to text i thru -1 of m

        if i > 1 then set n to n & text 1 thru (i - 1) of m

        if i ≥ l then
            set i to 0
            exit repeat
        end if

        set the status message to n
        delay 0.1
    end repeat
end tell
end repeat

on parse_quote(q)

set r to {} as record

set li to get every paragraph of q
repeat with thisLine in li

    set o1 to offset of ":" in thisLine

    if o1 > 0 then
        --log clean(thisLine)

        set k to clean(text 1 thru (o1 - 1) of thisLine)
        set v to clean(text (o1 + 1) thru -1 of thisLine)

        if k is "id" then
            set r to r & {_id:v}
        else if k is "t" then
            set r to r & {_t:v}
        else if k is "e" then
            set r to r & {_e:v}
        else if k is "l" then
            set r to r & {_l:v}
        else if k is "l_cur" then
            set r to r & {_l_cur:v}
        else if k is "ltt" then
            set r to r & {_ltt:v}
        else if k is "lt" then
            set r to r & {_lt:v}
        else if k is "c" then
            set r to r & {_c:v}
        else if k is "cp" then
            set r to r & {_cp:v}
        else if k is "ccol" then
            set r to r & {_ccol:v}
        end if
    end if

end repeat
return r
end parse_quote

on clean(t)

set out to ""

if length of t > 0 then
    repeat with i from 1 to length of t
        set ch to character i of t
        if ch is "\"" then

        else
            set out to out & ch
        end if
    end repeat
end if

if character 1 of out is "," then set out to text 2 thru -1 of out

return trim(out)
end clean

on trim(someText)

if length of someText > 1 then
    repeat until someText does not start with " "
        set someText to text 2 thru -1 of someText
    end repeat

    repeat until someText does not end with " "
        set someText to text 1 thru -2 of someText
    end repeat
end if
return someText
end trim

• AppleScript