package main

import "fmt"

// If your numbers happen to be in the range of Unicode code points (0 to 0x10ffff), this function
// satisfies the task:
func lessRune(a, b []rune) bool {
    return string(a) < string(b) // see also bytes.Compare
}

// Otherwise, the following function satisfies the task for all integer
// and floating point types, by changing the type definition appropriately.
type numericType int

func lessNT(a, b []numericType) bool {
    l := len(a)
    if len(b) < l {
        l = len(b)
    }
    for i := 0; i < l; i++ {
        if a[i] != b[i] {
            return a[i] < b[i]
        }
    }
    return l < len(b)
}

var testCases = [][][]numericType{
    {{0}, {}},
    {{}, {}},
    {{}, {0}},

    {{-1}, {0}},
    {{0}, {0}},
    {{0}, {-1}},

    {{0}, {0, -1}},
    {{0}, {0, 0}},
    {{0}, {0, 1}},
    {{0, -1}, {0}},
    {{0, 0}, {0}},
    {{0, 0}, {1}},
}

func main() {
    // demonstrate the general function
    for _, tc := range testCases {
        fmt.Printf("order %6s before %6s : %t\n",
            fmt.Sprintf("%v", tc[0]),
            fmt.Sprintf("%v", tc[1]),
            lessNT(tc[0], tc[1]))
    }
    fmt.Println()

    // demonstrate that the byte specific function gives identical results
    // by offsetting test data to a printable range of characters.
    for _, tc := range testCases {
        a := toByte(tc[0])
        b := toByte(tc[1])
        fmt.Printf("order %6q before %6q : %t\n",
            string(a),
            string(b),
            lessByte(a, b))
    }
}

func toByte(a []numericType) []byte {
    b := make([]byte, len(a))
    for i, n := range a {
        b[i] = 'b' + byte(n)
    }
    return b
}

"Function to compare and order two numerical lists lexicographically, returning true if the first list should be ordered before the second, and false otherwise."


Classic version[edit]
func Ackermann(m, n uint) uint {
	switch 0 {
	case m:
		return n + 1
	case n:
		return Ackermann(m - 1, 1)
	}
	return Ackermann(m - 1, Ackermann(m, n - 1))
}

Expanded version[edit]
func Ackermann2(m, n uint) uint {
  switch {
    case m == 0:
      return n + 1
    case m == 1:
      return n + 2
    case m == 2:
      return 2*n + 3
    case m == 3:
      return 8 << n - 3
    case n == 0:
      return Ackermann2(m - 1, 1)
  }
  return Ackermann2(m - 1, Ackermann2(m, n - 1))
}

Expanded version with arbitrary precision[edit]
package main

import (
	"fmt"
	"math/big"
	"math/bits" // Added in Go 1.9
)

var one = big.NewInt(1)
var two = big.NewInt(2)
var three = big.NewInt(3)
var eight = big.NewInt(8)

func Ackermann2(m, n *big.Int) *big.Int {
	if m.Cmp(three) <= 0 {
		switch m.Int64() {
		case 0:
			return new(big.Int).Add(n, one)
		case 1:
			return new(big.Int).Add(n, two)
		case 2:
			r := new(big.Int).Lsh(n, 1)
			return r.Add(r, three)
		case 3:
			if nb := n.BitLen(); nb > bits.UintSize {
				// n is too large to represent as a
				// uint for use in the Lsh method.
				panic(TooBigError(nb))

				// If we tried to continue anyway, doing
				// 8*2^n-3 as bellow, we'd use hundreds
				// of megabytes and lots of CPU time
				// without the Exp call even returning.
				r := new(big.Int).Exp(two, n, nil)
				r.Mul(eight, r)
				return r.Sub(r, three)
			}
			r := new(big.Int).Lsh(eight, uint(n.Int64()))
			return r.Sub(r, three)
		}
	}
	if n.BitLen() == 0 {
		return Ackermann2(new(big.Int).Sub(m, one), one)
	}
	return Ackermann2(new(big.Int).Sub(m, one),
		Ackermann2(m, new(big.Int).Sub(n, one)))
}

type TooBigError int

func (e TooBigError) Error() string {
	return fmt.Sprintf("A(m,n) had n of %d bits; too large", int(e))
}

func main() {
	show(0, 0)
	show(1, 2)
	show(2, 4)
	show(3, 100)
	show(3, 1e6)
	show(4, 1)
	show(4, 2)
	show(4, 3)
}

func show(m, n int64) {
	defer func() {
		// Ackermann2 could/should have returned an error
		// instead of a panic. But here's how to recover
		// from the panic, and report "expected" errors.
		if e := recover(); e != nil {
			if err, ok := e.(TooBigError); ok {
				fmt.Println("Error:", err)
			} else {
				panic(e)
			}
		}
	}()

	fmt.Printf("A(%d, %d) = ", m, n)
	a := Ackermann2(big.NewInt(m), big.NewInt(n))
	if a.BitLen() <= 256 {
		fmt.Println(a)
	} else {
		s := a.String()
		fmt.Printf("%d digits starting/ending with: %s...%s\n",
			len(s), s[:20], s[len(s)-20:],
		)
	}
}

Implement the Ackermann function which is a recursive function that takes two non-negative arguments and returns a value based on the specified conditions. The function should ideally support arbitrary precision due to its rapid growth.


implement the Gamma function using either the Lanczos or Stirling's approximation. The codes also compare the results of the custom implementation with the built-in/library function if available. The Gamma function is computed through numerical integration.


Niklaus Wirth algorithm (Wikipedia)[edit]
// A fairly literal translation of the example program on the referenced
// WP page.  Well, it happened to be the example program the day I completed
// the task.  It seems from the WP history that there has been some churn
// in the posted example program.  The example program of the day was in
// Pascal and was credited to Niklaus Wirth, from his "Algorithms +
// Data Structures = Programs."
package main

import "fmt"

var (
    i int
    q bool
    a [9]bool
    b [17]bool
    c [15]bool // offset by 7 relative to the Pascal version
    x [9]int
)

func try(i int) {
    for j := 1; ; j++ {
        q = false
        if a[j] && b[i+j] && c[i-j+7] {
            x[i] = j
            a[j] = false
            b[i+j] = false
            c[i-j+7] = false
            if i < 8 {
                try(i + 1)
                if !q {
                    a[j] = true
                    b[i+j] = true
                    c[i-j+7] = true
                }
            } else {
                q = true
            }
        }
        if q || j == 8 {
            break
        }
    }
}

func main() {
    for i := 1; i <= 8; i++ {
        a[i] = true
    }
    for i := 2; i <= 16; i++ {
        b[i] = true
    }
    for i := 0; i <= 14; i++ {
        c[i] = true
    }
    try(1)
    if q {
        for i := 1; i <= 8; i++ {
            fmt.Println(i, x[i])
        }
    }
}

Implement the solution for the N-queens puzzle, including the eight queens puzzle, using Knuth's Algorithm X and dancing links technique as provided in the dlx package. The code also calculates the number of solutions for small values of N as referenced in OEIS: A000170.


package main

import "fmt"

func main() {
    // Example 1:  Idiomatic in Go is use of the append function.
    // Elements must be of identical type.
    a := []int{1, 2, 3}
    b := []int{7, 12, 60} // these are technically slices, not arrays
    c := append(a, b...)
    fmt.Println(c)

    // Example 2:  Polymorphism.
    // interface{} is a type too, one that can reference values of any type.
    // This allows a sort of polymorphic list.
    i := []interface{}{1, 2, 3}
    j := []interface{}{"Crosby", "Stills", "Nash", "Young"}
    k := append(i, j...) // append will allocate as needed
    fmt.Println(k)

    // Example 3:  Arrays, not slices.
    // A word like "array" on RC often means "whatever array means in your
    // language."  In Go, the common role of "array" is usually filled by
    // Go slices, as in examples 1 and 2.  If by "array" you really mean
    // "Go array," then you have to do a little extra work.  The best
    // technique is almost always to create slices on the arrays and then
    // use the copy function.
    l := [...]int{1, 2, 3}
    m := [...]int{7, 12, 60} // arrays have constant size set at compile time
    var n [len(l) + len(m)]int
    copy(n[:], l[:]) // [:] creates a slice that references the entire array
    copy(n[len(l):], m[:])
    fmt.Println(n)

}

demonstrate how to concatenate two arrays using the specific syntax of the programming language.


package main

import "fmt"

type item struct {
    string
    w, v int
}

var wants = []item{
    {"map", 9, 150},
    {"compass", 13, 35},
    {"water", 153, 200},
    {"sandwich", 50, 160},
    {"glucose", 15, 60},
    {"tin", 68, 45},
    {"banana", 27, 60},
    {"apple", 39, 40},
    {"cheese", 23, 30},
    {"beer", 52, 10},
    {"suntan cream", 11, 70},
    {"camera", 32, 30},
    {"T-shirt", 24, 15},
    {"trousers", 48, 10},
    {"umbrella", 73, 40},
    {"waterproof trousers", 42, 70},
    {"waterproof overclothes", 43, 75},
    {"note-case", 22, 80},
    {"sunglasses", 7, 20},
    {"towel", 18, 12},
    {"socks", 4, 50},
    {"book", 30, 10},
}

const maxWt = 400

func main() {
    items, w, v := m(len(wants)-1, maxWt)
    fmt.Println(items)
    fmt.Println("weight:", w)
    fmt.Println("value:", v)
}

func m(i, w int) ([]string, int, int) {
    if i < 0 || w == 0 {
        return nil, 0, 0
    } else if wants[i].w > w {
        return m(i-1, w)
    }
    i0, w0, v0 := m(i-1, w)
    i1, w1, v1 := m(i-1, w-wants[i].w)
    v1 += wants[i].v
    if v1 > v0 {
        return append(i1, wants[i].string), w1 + wants[i].w, v1
    }
    return i0, w0, v0
}

The code determines the optimal combination of items a tourist can carry in his knapsack, given a maximum weight limit of 4kg. It uses the 0-1 knapsack problem solution to maximize the total value of items in the knapsack without exceeding the weight limit. The code does not allow for fractional items or multiple instances of the same item.


package main

import "fmt"

// Asymetry in the algorithm suggests different data structures for the
// map value types of the proposers and the recipients.  Proposers go down
// their list of preferences in order, and do not need random access.
// Recipients on the other hand must compare their preferences to arbitrary
// proposers.  A slice is adequate for proposers, but a map allows direct
// lookups for recipients and avoids looping code.
type proposers map[string][]string

var mPref = proposers{
    "abe": []string{
        "abi", "eve", "cath", "ivy", "jan",
        "dee", "fay", "bea", "hope", "gay"},
    "bob": []string{
        "cath", "hope", "abi", "dee", "eve",
        "fay", "bea", "jan", "ivy", "gay"},
    "col": []string{
        "hope", "eve", "abi", "dee", "bea",
        "fay", "ivy", "gay", "cath", "jan"},
    "dan": []string{
        "ivy", "fay", "dee", "gay", "hope",
        "eve", "jan", "bea", "cath", "abi"},
    "ed": []string{
        "jan", "dee", "bea", "cath", "fay",
        "eve", "abi", "ivy", "hope", "gay"},
    "fred": []string{
        "bea", "abi", "dee", "gay", "eve",
        "ivy", "cath", "jan", "hope", "fay"},
    "gav": []string{
        "gay", "eve", "ivy", "bea", "cath",
        "abi", "dee", "hope", "jan", "fay"},
    "hal": []string{
        "abi", "eve", "hope", "fay", "ivy",
        "cath", "jan", "bea", "gay", "dee"},
    "ian": []string{
        "hope", "cath", "dee", "gay", "bea",
        "abi", "fay", "ivy", "jan", "eve"},
    "jon": []string{
        "abi", "fay", "jan", "gay", "eve",
        "bea", "dee", "cath", "ivy", "hope"},
}

type recipients map[string]map[string]int

var wPref = recipients{
    "abi": map[string]int{
        "bob": 1, "fred": 2, "jon": 3, "gav": 4, "ian": 5,
        "abe": 6, "dan": 7, "ed": 8, "col": 9, "hal": 10},
    "bea": map[string]int{
        "bob": 1, "abe": 2, "col": 3, "fred": 4, "gav": 5,
        "dan": 6, "ian": 7, "ed": 8, "jon": 9, "hal": 10},
    "cath": map[string]int{
        "fred": 1, "bob": 2, "ed": 3, "gav": 4, "hal": 5,
        "col": 6, "ian": 7, "abe": 8, "dan": 9, "jon": 10},
    "dee": map[string]int{
        "fred": 1, "jon": 2, "col": 3, "abe": 4, "ian": 5,
        "hal": 6, "gav": 7, "dan": 8, "bob": 9, "ed": 10},
    "eve": map[string]int{
        "jon": 1, "hal": 2, "fred": 3, "dan": 4, "abe": 5,
        "gav": 6, "col": 7, "ed": 8, "ian": 9, "bob": 10},
    "fay": map[string]int{
        "bob": 1, "abe": 2, "ed": 3, "ian": 4, "jon": 5,
        "dan": 6, "fred": 7, "gav": 8, "col": 9, "hal": 10},
    "gay": map[string]int{
        "jon": 1, "gav": 2, "hal": 3, "fred": 4, "bob": 5,
        "abe": 6, "col": 7, "ed": 8, "dan": 9, "ian": 10},
    "hope": map[string]int{
        "gav": 1, "jon": 2, "bob": 3, "abe": 4, "ian": 5,
        "dan": 6, "hal": 7, "ed": 8, "col": 9, "fred": 10},
    "ivy": map[string]int{
        "ian": 1, "col": 2, "hal": 3, "gav": 4, "fred": 5,
        "bob": 6, "abe": 7, "ed": 8, "jon": 9, "dan": 10},
    "jan": map[string]int{
        "ed": 1, "hal": 2, "gav": 3, "abe": 4, "bob": 5,
        "jon": 6, "col": 7, "ian": 8, "fred": 9, "dan": 10},
}

func main() {
    // get parings by Gale/Shapley algorithm
    ps := pair(mPref, wPref)
    // show results
    fmt.Println("\nresult:")
    if !validateStable(ps, mPref, wPref) {
        return
    }
    // perturb
    for {
        i := 0
        var w2, m2 [2]string
        for w, m := range ps {
            w2[i] = w
            m2[i] = m
            if i == 1 {
                break
            }
            i++
        }
        fmt.Println("\nexchanging partners of", m2[0], "and", m2[1])
        ps[w2[0]] = m2[1]
        ps[w2[1]] = m2[0]
        // validate perturbed parings
        if !validateStable(ps, mPref, wPref) {
            return
        }
        // if those happened to be stable as well, perturb more
    }
}

type parings map[string]string // map[recipient]proposer (or map[w]m)

// Pair implements the Gale/Shapley algorithm.
func pair(pPref proposers, rPref recipients) parings {
    // code is destructive on the maps, so work with copies
    pFree := proposers{}
    for k, v := range pPref {
        pFree[k] = append([]string{}, v...)
    }
    rFree := recipients{}
    for k, v := range rPref {
        rFree[k] = v
    }
    // struct only used in this function.
    // preferences must be saved in case engagement is broken.
    type save struct {
        proposer string
        pPref    []string
        rPref    map[string]int
    }
    proposals := map[string]save{} // key is recipient (w)

    // WP pseudocode comments prefaced with WP: m is proposer, w is recipient.
    // WP: while ∃ free man m who still has a woman w to propose to
    for len(pFree) > 0 { // while there is a free proposer,
        var proposer string
        var ppref []string
        for proposer, ppref = range pFree {
            break // pick a proposer at random, whatever range delivers first.
        }
        if len(ppref) == 0 {
            continue // if proposer has no possible recipients, skip
        }
        // WP: w = m's highest ranked such woman to whom he has not yet proposed
        recipient := ppref[0] // highest ranged is first in list.
        ppref = ppref[1:]     // pop from list
        var rpref map[string]int
        var ok bool
        // WP: if w is free
        if rpref, ok = rFree[recipient]; ok {
            // WP: (m, w) become engaged
            // (common code follows if statement)
        } else {
            // WP: else some pair (m', w) already exists
            s := proposals[recipient] // get proposal saved preferences
            // WP: if w prefers m to m'
            if s.rPref[proposer] < s.rPref[s.proposer] {
                fmt.Println("engagement broken:", recipient, s.proposer)
                // WP: m' becomes free
                pFree[s.proposer] = s.pPref // return proposer to the map
                // WP: (m, w) become engaged
                rpref = s.rPref
                // (common code follows if statement)
            } else {
                // WP: else (m', w) remain engaged
                pFree[proposer] = ppref // update preferences in map
                continue
            }
        }
        fmt.Println("engagement:", recipient, proposer)
        proposals[recipient] = save{proposer, ppref, rpref}
        delete(pFree, proposer)
        delete(rFree, recipient)
    }
    // construct return value
    ps := parings{}
    for recipient, s := range proposals {
        ps[recipient] = s.proposer
    }
    return ps
}

func validateStable(ps parings, pPref proposers, rPref recipients) bool {
    for r, p := range ps {
        fmt.Println(r, p)
    }
    for r, p := range ps {
        for _, rp := range pPref[p] {
            if rp == r {
                break
            }
            rprefs := rPref[rp]
            if rprefs[p] < rprefs[ps[rp]] {
                fmt.Println("unstable.")
                fmt.Printf("%s and %s would prefer each other over"+
                    " their current pairings.\n", p, rp)
                return false
            }
        }
    }
    fmt.Println("stable.")
    return true
}

"Implement the Gale-Shapley algorithm to solve the Stable Marriage problem. The program takes as input the preferences of ten men and ten women, and outputs a stable set of engagements. It then perturbs this set to form an unstable set of engagements and checks this new set for stability."


package main

import "fmt"

func a(v bool) bool {
    fmt.Print("a")
    return v
}

func b(v bool) bool {
    fmt.Print("b")
    return v
}

func test(i, j bool) {
    fmt.Printf("Testing a(%t) && b(%t)\n", i, j)
    fmt.Print("Trace:  ")
    fmt.Println("\nResult:", a(i) && b(j))

    fmt.Printf("Testing a(%t) || b(%t)\n", i, j)
    fmt.Print("Trace:  ")
    fmt.Println("\nResult:", a(i) || b(j))

    fmt.Println("")
}

func main() {
    test(false, false)
    test(false, true)
    test(true, false)
    test(true, true)
}

The code defines two functions, 'a' and 'b', which accept and return the same boolean value and print their name when called. It then calculates and assigns the values of two equations to variables 'x' and 'y', ensuring that function 'b' is only called when necessary, utilizing the short-circuit evaluation feature of boolean expressions. If the language does not support short-circuit evaluation, this is achieved using nested 'if' statements. The short-circuit operators used are '&&' and '||'.


// Command morse translates an input string into morse code,
// showing the output on the console, and playing it as sound.
// Only works on ubuntu.
package main

import (
	"flag"
	"fmt"
	"log"
	"regexp"
	"strings"
	"syscall"
	"time"
	"unicode"
)

// A key represents an action on the morse key.
// It's either on or off, for the given duration.
type key struct {
	duration int
	on       bool
	sym      string // for debug output
}

var (
	runeToKeys   = map[rune][]key{}
	interCharGap = []key{{1, false, ""}}
	punctGap     = []key{{7, false, " / "}}
	charGap      = []key{{3, false, " "}}
	wordGap      = []key{{7, false, " / "}}
)

const rawMorse = `
A:.-    J:.---  S:...    1:.----  .:.-.-.-  ::---...
B:-...  K:-.-   T:-      2:..---  ,:--..--  ;:-.-.-.
C:-.-.  L:.-..  U:..-    3:...--  ?:..--..  =:-...-
D:-..   M:--    V:...-   4:....-  ':.----.  +:.-.-.
E:.     N:-.    W:.--    5:.....  !:-.-.--  -:-....-
F:..-.  O:---   X:-..-   6:-....  /:-..-.   _:..--.-
G:--.   P:.--.  Y:-.--   7:--...  (:-.--.   ":.-..-.
H:....  Q:--.-  Z:--..   8:---..  ):-.--.-  $:...-..-
I:..    R:.-.   0:-----  9:----.  &:.-...   @:.--.-.
`

func init() {
	// Convert the rawMorse table into a map of morse key actions.
	r := regexp.MustCompile("([^ ]):([.-]+)")
	for _, m := range r.FindAllStringSubmatch(rawMorse, -1) {
		c := m[1][0]
		keys := []key{}
		for i, dd := range m[2] {
			if i > 0 {
				keys = append(keys, interCharGap...)
			}
			if dd == '.' {
				keys = append(keys, key{1, true, "."})
			} else if dd == '-' {
				keys = append(keys, key{3, true, "-"})
			} else {
				log.Fatalf("found %c in morse for %c", dd, c)
			}
			runeToKeys[rune(c)] = keys
			runeToKeys[unicode.ToLower(rune(c))] = keys
		}
	}
}

// MorseKeys translates an input string into a series of keys.
func MorseKeys(in string) ([]key, error) {
	afterWord := false
	afterChar := false
	result := []key{}
	for _, c := range in {
		if unicode.IsSpace(c) {
			afterWord = true
			continue
		}
		morse, ok := runeToKeys[c]
		if !ok {
			return nil, fmt.Errorf("can't translate %c to morse", c)
		}
		if unicode.IsPunct(c) && afterChar {
			result = append(result, punctGap...)
		} else if afterWord {
			result = append(result, wordGap...)
		} else if afterChar {
			result = append(result, charGap...)
		}
		result = append(result, morse...)
		afterChar = true
		afterWord = false
	}
	return result, nil
}

func main() {
	var ditDuration time.Duration
	flag.DurationVar(&ditDuration, "d", 40*time.Millisecond, "length of dit")
	flag.Parse()
	in := "hello world."
	if len(flag.Args()) > 1 {
		in = strings.Join(flag.Args(), " ")
	}
	keys, err := MorseKeys(in)
	if err != nil {
		log.Fatalf("failed to translate: %s", err)
	}
	for _, k := range keys {
		if k.on {
			if err := note(true); err != nil {
				log.Fatalf("failed to play note: %s", err)
			}
		}
		fmt.Print(k.sym)
		time.Sleep(ditDuration * time.Duration(k.duration))
		if k.on {
			if err := note(false); err != nil {
				log.Fatalf("failed to stop note: %s", err)
			}
		}
	}
	fmt.Println()
}

// Implement sound on ubuntu. Needs permission to access /dev/console.

var consoleFD uintptr

func init() {
	fd, err := syscall.Open("/dev/console", syscall.O_WRONLY, 0)
	if err != nil {
		log.Fatalf("failed to get console device: %s", err)
	}
	consoleFD = uintptr(fd)
}

const KIOCSOUND = 0x4B2F
const clockTickRate = 1193180
const freqHz = 600

// note either starts or stops a note.
func note(on bool) error {
	arg := uintptr(0)
	if on {
		arg = clockTickRate / freqHz
	}
	_, _, errno := syscall.Syscall(syscall.SYS_IOCTL, consoleFD, KIOCSOUND, arg)
	if errno != 0 {
		return errno
	}
	return nil

}

<output> convert a given string into audible Morse code and send it to an audio device such as a PC speaker. It either ignores unknown characters or indicates them with a different pitch. </output>


package main

import (
	"fmt"
	"strings"
)

func newSpeller(blocks string) func(string) bool {
	bl := strings.Fields(blocks)
	return func(word string) bool {
		return r(word, bl)
	}
}

func r(word string, bl []string) bool {
	if word == "" {
		return true
	}
	c := word[0] | 32
	for i, b := range bl {
		if c == b[0]|32 || c == b[1]|32 {
			bl[i], bl[0] = bl[0], b
			if r(word[1:], bl[1:]) == true {
				return true
			}
			bl[i], bl[0] = bl[0], bl[i]
		}
	}
	return false
}

func main() {
	sp := newSpeller(
		"BO XK DQ CP NA GT RE TG QD FS JW HU VI AN OB ER FS LY PC ZM")
	for _, word := range []string{
		"A", "BARK", "BOOK", "TREAT", "COMMON", "SQUAD", "CONFUSE"} {
		fmt.Println(word, sp(word))
	}
}

"Output: The code defines a function that checks if a given word can be spelled using a specific collection of ABC blocks. Each block contains two letters and can only be used once. The function is case-insensitive and returns a boolean value based on whether or not the word can be formed."


package main

import (
    "crypto/md5"
    "fmt"
)

func main() {
    for _, p := range [][2]string{
        // RFC 1321 test cases
        {"d41d8cd98f00b204e9800998ecf8427e", ""},
        {"0cc175b9c0f1b6a831c399e269772661", "a"},
        {"900150983cd24fb0d6963f7d28e17f72", "abc"},
        {"f96b697d7cb7938d525a2f31aaf161d0", "message digest"},
        {"c3fcd3d76192e4007dfb496cca67e13b", "abcdefghijklmnopqrstuvwxyz"},
        {"d174ab98d277d9f5a5611c2c9f419d9f",
            "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789"},
        {"57edf4a22be3c955ac49da2e2107b67a", "12345678901234567890" +
            "123456789012345678901234567890123456789012345678901234567890"},
        // test case popular with other RC solutions
        {"e38ca1d920c4b8b8d3946b2c72f01680",
            "The quick brown fox jumped over the lazy dog's back"},
    } {
        validate(p[0], p[1])
    }
}

var h = md5.New()

func validate(check, s string) {
    h.Reset()
    h.Write([]byte(s))
    sum := fmt.Sprintf("%x", h.Sum(nil))
    if sum != check {
        fmt.Println("MD5 fail")
        fmt.Println("  for string,", s)
        fmt.Println("  expected:  ", check)
        fmt.Println("  got:       ", sum)
    }
}

implement an MD5 encoding for a given string. The codes also include an optional validation using test values from IETF RFC (1321) for MD5. However, due to known weaknesses of MD5, alternatives like SHA-256 or SHA-3 are recommended for production-grade cryptography. If the solution is a library, refer to MD5/Implementation for a scratch implementation.


package main

import (
    "fmt"
    "log"
    "math/big"
    "sort"
    "strings"
)

var testCases = []string{
    "1.3.6.1.4.1.11.2.17.19.3.4.0.10",
    "1.3.6.1.4.1.11.2.17.5.2.0.79",
    "1.3.6.1.4.1.11.2.17.19.3.4.0.4",
    "1.3.6.1.4.1.11150.3.4.0.1",
    "1.3.6.1.4.1.11.2.17.19.3.4.0.1",
    "1.3.6.1.4.1.11150.3.4.0",
}

// a parsed representation
type oid []big.Int

// "constructor" parses string representation
func newOid(s string) oid {
    ns := strings.Split(s, ".")
    os := make(oid, len(ns))
    for i, n := range ns {
        if _, ok := os[i].SetString(n, 10); !ok || os[i].Sign() < 0 {
            return nil
        }
    }
    return os
}

// "stringer" formats into string representation
func (o oid) String() string {
    s := make([]string, len(o))
    for i, n := range o {
        s[i] = n.String()
    }
    return strings.Join(s, ".")
}

func main() {
    // parse test cases
    os := make([]oid, len(testCases))
    for i, s := range testCases {
        os[i] = newOid(s)
        if os[i] == nil {
            log.Fatal("invalid OID")
        }
    }
    // sort
    sort.Slice(os, func(i, j int) bool {
        // "less" function must return true if os[i] < os[j]
        oi := os[i]
        for x, v := range os[j] {
            // lexicographic defintion: less if prefix or if element is <
            if x == len(oi) || oi[x].Cmp(&v) < 0 {
                return true
            }
            if oi[x].Cmp(&v) > 0 {
                break
            }
        }
        return false
    })
    // output sorted list
    for _, o := range os {
        fmt.Println(o)
    }
}

sort a list of Object Identifiers (OIDs) in their natural lexicographical order. The OIDs are strings of non-negative integers separated by dots.


package main

import (
    "fmt"
    "net"
)

func main() {
    conn, err := net.Dial("tcp", "localhost:256")
    if err != nil {
        fmt.Println(err)
        return
    }
    defer conn.Close()
    _, err = conn.Write([]byte("hello socket world"))
    if err != nil {
        fmt.Println(err)
    }
}

Test with nc:
$ sudo nc -l 256 & go run sock.go
[2] 19754
hello socket world[2]+  Done                    sudo nc -l 256
$

opens a socket to localhost on port 256, sends the message "hello socket world", and then closes the socket.


package main

import (
	"bufio"
	"bytes"
	"errors"
	"flag"
	"fmt"
	"io/ioutil"
	"net/smtp"
	"os"
	"strings"
)

type Message struct {
	From    string
	To      []string
	Cc      []string
	Subject string
	Content string
}

func (m Message) Bytes() (r []byte) {
	to := strings.Join(m.To, ",")
	cc := strings.Join(m.Cc, ",")

	r = append(r, []byte("From: "+m.From+"\n")...)
	r = append(r, []byte("To: "+to+"\n")...)
	r = append(r, []byte("Cc: "+cc+"\n")...)
	r = append(r, []byte("Subject: "+m.Subject+"\n\n")...)
	r = append(r, []byte(m.Content)...)

	return
}

func (m Message) Send(host string, port int, user, pass string) (err error) {
	err = check(host, user, pass)
	if err != nil {
		return
	}

	err = smtp.SendMail(fmt.Sprintf("%v:%v", host, port),
		smtp.PlainAuth("", user, pass, host),
		m.From,
		m.To,
		m.Bytes(),
	)

	return
}

func check(host, user, pass string) error {
	if host == "" {
		return errors.New("Bad host")
	}
	if user == "" {
		return errors.New("Bad username")
	}
	if pass == "" {
		return errors.New("Bad password")
	}

	return nil
}

func main() {
	var flags struct {
		host string
		port int
		user string
		pass string
	}
	flag.StringVar(&flags.host, "host", "", "SMTP server to connect to")
	flag.IntVar(&flags.port, "port", 587, "Port to connect to SMTP server on")
	flag.StringVar(&flags.user, "user", "", "Username to authenticate with")
	flag.StringVar(&flags.pass, "pass", "", "Password to authenticate with")
	flag.Parse()

	err := check(flags.host, flags.user, flags.pass)
	if err != nil {
		flag.Usage()
		os.Exit(1)
	}

	bufin := bufio.NewReader(os.Stdin)

	fmt.Printf("From: ")
	from, err := bufin.ReadString('\n')
	if err != nil {
		fmt.Printf("Error: %v\n", err)
		os.Exit(1)
	}
	from = strings.Trim(from, " \t\n\r")

	var to []string
	for {
		fmt.Printf("To (Blank to finish): ")
		tmp, err := bufin.ReadString('\n')
		if err != nil {
			fmt.Printf("Error: %v\n", err)
			os.Exit(1)
		}
		tmp = strings.Trim(tmp, " \t\n\r")

		if tmp == "" {
			break
		}

		to = append(to, tmp)
	}

	var cc []string
	for {
		fmt.Printf("Cc (Blank to finish): ")
		tmp, err := bufin.ReadString('\n')
		if err != nil {
			fmt.Printf("Error: %v\n", err)
			os.Exit(1)
		}
		tmp = strings.Trim(tmp, " \t\n\r")

		if tmp == "" {
			break
		}

		cc = append(cc, tmp)
	}

	fmt.Printf("Subject: ")
	subject, err := bufin.ReadString('\n')
	if err != nil {
		fmt.Printf("Error: %v\n", err)
		os.Exit(1)
	}
	subject = strings.Trim(subject, " \t\n\r")

	fmt.Printf("Content (Until EOF):\n")
	content, err := ioutil.ReadAll(os.Stdin)
	if err != nil {
		fmt.Printf("Error: %v\n", err)
		os.Exit(1)
	}
	content = bytes.Trim(content, " \t\n\r")

	m := Message{
		From:    from,
		To:      to,
		Cc:      cc,
		Subject: subject,
		Content: string(content),
	}

	fmt.Printf("\nSending message...\n")
	err = m.Send(flags.host, flags.port, flags.user, flags.pass)
	if err != nil {
		fmt.Printf("Error: %v\n", err)
		os.Exit(1)
	}

	fmt.Printf("Message sent.\n")
}

"Implement a function to send an email using SMTP package with TLS connections. The function accepts parameters for From, To, Cc addresses, Subject, message text, server name and login details. The code also handles notifications for success or failure. It is designed to be portable across multiple operating systems."


package main

import (
    "fmt"
    "math"
)

func main() {
    for i := int8(0); ; i++ {
        fmt.Printf("%o\n", i)
        if i == math.MaxInt8 {
            break
        }
    }
}

0
1
2
3
4
5
6
7
10
11
12
...
175
176
177

func main() {
    for i := uint16(0); ; i++ {  // type specified here
        fmt.Printf("%o\n", i)
        if i == math.MaxUint16 { // maximum value for type specified here
            break
        }
    }
}

...
177775
177776
177777

import "fmt"

func main() {
    for i := 0.; ; {
        fmt.Printf("%o\n", int64(i))
        /* uncomment to produce example output
        if i == 3 {
            i = float64(1<<53 - 4) // skip to near the end
            fmt.Println("...")
        } */
        next := i + 1
        if next == i {
            break
        }
        i = next
    }
}

0
1
2
3
...
377777777777777775
377777777777777776
377777777777777777
400000000000000000

import (
    "big"
    "fmt"
)

func main() {
    defer func() {
        recover()
    }()
    one := big.NewInt(1)
    for i := big.NewInt(0); ; i.Add(i, one) {
        fmt.Printf("%o\n", i)
    }
}

0
1
2
3
4
5
6
7
10
11
12
13
14
...

generate a sequential count in octal, starting from zero and incrementing by one for each consecutive number. The count continues until the program is terminated or the maximum value of the numeric type in use is reached. The program also handles scenarios where different integer types are used, where floating point types might cause loss of precision, and where memory allocation might fail for big integers.


Built in[edit]

a, b = b, a

Pass interfaces[edit]

package main

import "fmt"

func swap(a, b *interface{}) {
    *a, *b = *b, *a
}

func main() {
    var a, b interface{} = 3, "four"
    fmt.Println(a, b)
    swap(&a, &b)
    fmt.Println(a, b)
}

implement a generic swap function or operator that can interchange the values of two variables or storage places, regardless of their types. This function is applicable in both statically and dynamically typed languages, with certain constraints in case of typed variables. The function does not necessarily support swapping between incompatible types like string and integer. The code also mentions Go's built-in assignment operator that performs a generic swap for variables of identical types. The code also provides a version that allows pointers of any type to be passed, as long as they are of the same type.


package pal

func IsPal(s string) bool {
    mid := len(s) / 2
    last := len(s) - 1
    for i := 0; i < mid; i++ {
        if s[i] != s[last-i] {
            return false
        }
    }
    return true
}

func isPalindrome(s string) bool {
	runes := []rune(s)
	numRunes := len(runes) - 1
	for i := 0; i < len(runes)/2; i++ {
		if runes[i] != runes[numRunes-i] {
			return false
		}
	}
	return true
}

func isPalindrome(s string) bool {
	runes := []rune(s)
	for len(runes) > 1 {
		if runes[0] != runes[len(runes)-1] {
			return false
		}
		runes = runes[1 : len(runes)-1]
	}
	return true
}

The code is a function that checks if a given sequence of characters or bytes is a palindrome. It supports Unicode characters and also detects inexact palindromes by ignoring white-space, punctuation, and case. It uses string reversal and might be useful for testing a function.


Simply

package main

import (
    "fmt"
    "os"
)

func main() {
    fmt.Println(os.Getenv("SHELL"))
}

demonstrate how to retrieve a specific environment variable from the process's environment using the os.Environ library function in a Unix system. The variables that can be accessed include PATH, HOME, and USER.


Translation of: Wren
package main

import "fmt"

func F(n, x, y int) int {
    if n == 0 {
        return x + y
    }
    if y == 0 {
        return x
    }
    return F(n-1, F(n, x, y-1), F(n, x, y-1)+y)
}

func main() {
    for n := 0; n < 2; n++ {
        fmt.Printf("Values of F(%d, x, y):\n", n)
        fmt.Println("y/x    0   1   2   3   4   5")
        fmt.Println("----------------------------")
        for y := 0; y < 7; y++ {
            fmt.Printf("%d  |", y)
            for x := 0; x < 6; x++ {
                fmt.Printf("%4d", F(n, x, y))
            }
            fmt.Println()
        }
        fmt.Println()
    }
    fmt.Printf("F(2, 1, 1) = %d\n", F(2, 1, 1))
    fmt.Printf("F(3, 1, 1) = %d\n", F(3, 1, 1))
    fmt.Printf("F(2, 2, 1) = %d\n", F(2, 2, 1))
}

Implement the Sudan function, a non-primitive recursive function. The function takes two arguments, x and y, and returns a value based on the defined recursive rules.


Iterative[edit]

data fib;
    a=0;
    b=1;
    do n=0 to 20;
       f=a;
       output;
       a=b;
       b=f+a;
    end;
    keep n f;
run;
Naive recursive[edit]

options cmplib=work.f;

proc fcmp outlib=work.f.p;
    function fib(n);
    if n = 0 or n = 1
        then return(1);
        else return(fib(n - 2) + fib(n - 1));
    endsub;
run;

data _null_;
    x = fib(5);
    put 'fib(5) = ' x;
run;

The code defines a function to generate the nth Fibonacci number, either iteratively or recursively. It optionally supports negative n values by inversely applying the Fibonacci sequence's definition. The function also builds a table holding the initial values of the Fibonacci sequence and logs one of the sequence members.


data _null_;
   a="abracadabra";
   b=substr(a,2,3); /* first number is position, starting at 1,
                       second number is length */
   put _all_;
run;

- Extracts a substring starting from the nth character of a specific length m.
- Extracts a substring starting from the nth character up to the end of the string.
- Returns the entire string excluding the last character.
- Extracts a substring starting from a known character within the string of length m.
- Extracts a substring starting from a known substring within the string of length m.
- Supports any valid Unicode code point, including those in the Basic Multilingual Plane or above it.
- References logical characters (code points), not 8-bit code units for UTF-8 or 16-bit code units for UTF-16.
- Does not necessarily support all Unicode characters for other encodings like 8-bit ASCII, or EUC-JP.


data _null_;
length a b $11;
a="I am Legend";
b=reverse(a);
put a;
put b;
run;

Reverses a given string while preserving Unicode combining characters. For instance, it transforms "asdf" to "fdsa" and "as⃝df̅" to "f̅ds⃝a".


/* create SAS data set */
data Edges;
   input Start $ End $ Cost;
   datalines;
a  b  7
a  c  9
a  f  14
b  c  10
b  d  15
c  d  11
c  f  2
d  e  6
e  f  9
;

/* call OPTMODEL procedure in SAS/OR */
proc optmodel;
   /* declare sets and parameters, and read input data */
   set <str,str> LINKS;
   num cost {LINKS};
   read data Edges into LINKS=[start end] cost;
   set NODES = union {<i,j> in LINKS} {i,j};
   set SOURCES = {'a'};
   set SINKS = {'e'};
   /* <source,sink,order,from,to> */
   set <str,str,num,str,str> PATHS;

   /* call network solver */
   solve with network /
      shortpath=(source=SOURCES sink=SINKS) links=(weight=cost) out=(sppaths=PATHS);

   /* write shortest path to SAS data set */
   create data path from [source sink order from to]=PATHS cost[from,to];
quit;

/* print shortest path */
proc print data=path;
run;

Obs source sink order from to cost
1 a e 1 a c 9
2 a e 2 c f 2
3 a e 3 e f 9

implement Dijkstra's algorithm to find the shortest path from a given source node to all other nodes in a graph. The algorithm takes a directed and weighted graph, represented by an adjacency matrix or list, and a start node as inputs. It outputs a set of edges depicting the shortest path to each reachable node. The code also includes functionality to interpret the output and display the shortest path from the source node to specific nodes.


data _null_;
do while(1);
   n=floor(uniform(0)*20);
   put n;
   if n=10 then leave;    /* 'leave' to break a loop */
end;
run;

generate and print random numbers from 0 to 19. If the generated number is 10, the loop stops. If the number is not 10, a second random number is generated and printed before the loop restarts. If 10 is never generated, the loop runs indefinitely.


The code determines the years between 2008 and 2121 where Christmas (25th December) falls on a Sunday, using standard date handling libraries. It also compares the results with other languages to identify any anomalies in date/time representation, such as overflow issues similar to y2k problems.


The code performs QR decomposition of a given matrix using the Householder reflections method. It demonstrates this decomposition on a specific example matrix and uses it to solve linear least squares problems. The code also handles cases where the matrix is not square by cutting off zero padded bottom rows. Finally, it solves the square upper triangular system by back substitution.


options mprint mlogic symbolgen source source2;

%macro SubSets (FieldCount = );
data _NULL_;
	Fields = &FieldCount;
	SubSets = 2**Fields;
	call symput ("NumSubSets", SubSets);
run;

%put &NumSubSets;

data inital;
	%do j = 1 %to &FieldCount;
		F&j. = 1;
	%end;
run;

data SubSets;
	set inital;
	RowCount =_n_;
	call symput("SetCount",RowCount);
run;

%put SetCount ;

%do %while (&SetCount < &NumSubSets);

data loop;
	%do j=1 %to &FieldCount;
		if rand('GAUSSIAN') > rand('GAUSSIAN') then F&j. = 1;
	%end;

data SubSets_  ;
set SubSets loop;
run;

proc sort data=SubSets_  nodupkey;
	by F1 - F&FieldCount.;
run;

data Subsets;
	set SubSets_;
	RowCount =_n_;
run;

proc sql noprint;
	select max(RowCount) into :SetCount
	from SubSets;
quit;
run;

%end;
%Mend SubSets;

%SubSets(FieldCount = 5);

The code takes a set S as input and generates its power set. The power set includes all possible subsets of S, including the empty set and the set itself. For a set with n elements, the power set will have 2^n elements. The code also demonstrates the ability to handle edge cases such as the power set of an empty set and a set containing only the empty set. The output is a dataset named SUBSETS with 5 columns (F1, F2, F3, F4, F5) and 32 rows, each representing a different combination of 1 and missing values.


data one;
   wtpanacea=0.3;    wtichor=0.2;    wtgold=2.0;
   volpanacea=0.025; volichor=0.015; volgold=0.002;
   valpanacea=3000;  valichor=1800;  valgold=2500;
   maxwt=25; maxvol=0.25;

   /* we can prune the possible selections */
   maxpanacea = floor(min(maxwt/wtpanacea, maxvol/volpanacea));
   maxichor = floor(min(maxwt/wtichor, maxvol/volichor));
   maxgold = floor(min(maxwt/wtgold, maxvol/volgold));
   do i1 = 0 to maxpanacea;
      do i2 = 0 to maxichor;
         do i3 = 0 to maxgold;
            panacea = i1; ichor=i2; gold=i3; output;
         end;
      end;
   end;
run;
data one; set one;
   vals = valpanacea*panacea + valichor*ichor + valgold*gold;
   totalweight = wtpanacea*panacea + wtichor*ichor + wtgold*gold;
   totalvolume = volpanacea*panacea + volichor*ichor + volgold*gold;
   if (totalweight le maxwt) and (totalvolume le maxvol);
run;
proc sort data=one;
   by descending vals;
run;
proc print data=one (obs=4);
   var panacea ichor gold vals;
run;

 Obs    panacea    ichor    gold     vals

   1       0         15      11     54500
   2       3         10      11     54500
   3       6          5      11     54500
   4       9          0      11     54500

/* create SAS data set */
data mydata;
   input Item $1-19 Value weight Volume;
   datalines;
panacea (vials of) 3000 0.3 0.025
ichor (ampules of) 1800 0.2 0.015
gold (bars)        2500 2.0 0.002
;

/* call OPTMODEL procedure in SAS/OR */
proc optmodel;
   /* declare sets and parameters, and read input data */
   set <str> ITEMS;
   num value {ITEMS};
   num weight {ITEMS};
   num volume {ITEMS};
   read data mydata into ITEMS=[item] value weight volume;

   /* declare variables, objective, and constraints */
   var NumSelected {ITEMS} >= 0 integer;
   max TotalValue = sum {i in ITEMS} value[i] * NumSelected[i];
   con WeightCon:
      sum {i in ITEMS} weight[i] * NumSelected[i] <= 25;
   con VolumeCon:
      sum {i in ITEMS} volume[i] * NumSelected[i] <= 0.25;

   /* call mixed integer linear programming (MILP) solver */
   solve;

   /* print optimal solution */
   print TotalValue;
   print NumSelected;

   /* to get all optimal solutions, call CLP solver instead */
   solve with CLP / findallsolns;

   /* print all optimal solutions */
   print TotalValue;
   for {s in 1.._NSOL_} print {i in ITEMS} NumSelected[i].sol[s];
quit;

TotalValue
54500

[1] NumSelected
gold (bars) 11
ichor (ampules of) 0
panacea (vials of) 9

TotalValue
54500

[1]
gold (bars) 11
ichor (ampules of) 15
panacea (vials of) 0

[1]
gold (bars) 11
ichor (ampules of) 10
panacea (vials of) 3

[1]
gold (bars) 11
ichor (ampules of) 5
panacea (vials of) 6

[1]
gold (bars) 11
ichor (ampules of) 0
panacea (vials of) 9

determine the maximum value of items a traveler can carry away from Shangri La, given the weight and volume constraints of his knapsack and the value, weight, and volume of each item. The code provides one of the four possible solutions to maximize the value taken. It uses a brute force approach and employs SAS/OR, MILP and CLP solvers.


data _null_;
length a $5;
do n=1 to 5;
  a="*";
  do i=2 to n;
    a=trim(a) !! "*";
  end;
  put a;
end;
run;

/* Possible without the inner loop. Notice TRIM is replaced with STRIP,
otherwise there is a blank space on the left */

data _null_;
length a $5;
do n=1 to 5;
  a=strip(a) !! "*";
  put a;
end;
run;

demonstrate how to use nested for loops to print a specific pattern. The number of iterations in the inner loop is controlled by the outer loop, resulting in a pattern of increasing asterisks.


/* Generate 1000 random numbers with mean 1 and standard deviation 0.5.
  SAS version 9.2 was used to create this code.*/

data norm1000;
  call streaminit(123456);
/* Set the starting point, so we can replicate results.
   If you want different results each time, comment the above line. */
  do i=1 to 1000;
    r=rand('normal',1,0.5);
    output;
  end;
run;

 The MEANS Procedure

                     Analysis Variable : r

                          Mean         Std Dev
                  ----------------------------
                     0.9907408       0.4844051
                  ----------------------------

generate a collection of 1000 normally distributed pseudo-random numbers with a mean of 1.0 and a standard deviation of 0.5, using libraries that generate uniformly distributed random numbers. It also includes a related task for calculating the standard deviation.


%let string=She was a soul stripper. She took my heart!;
%let chars=aei;
%let stripped=%sysfunc(compress("&string","&chars"));
%put &stripped;

Sh ws  soul strppr. Sh took my hrt!

"Function to strip a given set of characters from a specified string."


  %let datefmt=E8601DA10.;
  data patient;
      infile "patient.csv" dsd dlm=',';
      attrib
          id length=4
          lastname length=$10;
      input id lastname;
  data visit;
      infile "visit.csv" dsd dlm=',';
      attrib
          id length=4
          date informat=&datefmt format=&datefmt
          score length=8;
      input id date score;
  proc sql;
      select * from
          (select id, max(date) format=&datefmt as max_date, sum(score) as sum_score,
          	avg(score) as avg_score from visit group by id)
          natural right join patient
          order by id;

"Merge and aggregate two provided .csv datasets into a new dataset, grouping by patient id and last name, calculating the maximum visit date, and the sum and average of the scores per patient. The resulting dataset can be displayed on screen, stored in memory, or written to a file."


options minoperator;

%macro haver(lat1, long1, lat2, long2, type=D, dist=K);

	%if %upcase(&type) in (D DEG DEGREE DEGREES) %then %do;
		%let convert = constant('PI')/180;
		%end;
	%else %if %upcase(&type) in (R RAD RADIAN RADIANS) %then %do;
		%let convert = 1;
		%end;
	%else %do;
		%put ERROR - Enter RADIANS or DEGREES for type.;
		%goto exit;
		%end;

	%if %upcase(&dist) in (M MILE MILES) %then %do;
		%let distrat = 1.609344;
		%end;
	%else %if %upcase(&dist) in (K KM KILOMETER KILOMETERS) %then %do;
		%let distrat = 1;
		%end;
	%else %do;
		%put ERROR - Enter M on KM for dist;
		%goto exit;
		%end;

		data _null_;
			convert = &convert;
			lat1 = &lat1 * convert;
			lat2 = &lat2 * convert;
			long1 = &long1 * convert;
			long2 = &long2 * convert;

			diff1 = lat2 - lat1;
			diff2 = long2 - long1;

			part1 = sin(diff1/2)**2;
			part2 = cos(lat1)*cos(lat2);
			part3 = sin(diff2/2)**2;

			root = sqrt(part1 + part2*part3);

			dist = 2 * 6372.8 / &distrat * arsin(root);

			put "Distance is " dist "%upcase(&dist)";
		run;

	%exit:
%mend;

%haver(36.12, -86.67, 33.94, -118.40);

Implement a function to calculate the great-circle distance between two points on a sphere using the Haversine formula. The function takes the coordinates of Nashville International Airport (BNA) and Los Angeles International Airport (LAX) as input and returns the distance between them. The calculation uses the recommended earth radius of 6372.8 km or 6371 km, depending on the level of precision required.


/* using DO UNTIL so that the loop executes at least once */
data _null_;
n=0;
do until(mod(n,6)=0);
    n+1;
    put n;
end;
run;

The code initializes a value to 0, then enters a do-while loop where it increments the value by 1 and prints it, continuing as long as the value modulo 6 is not 0. The loop is guaranteed to execute at least once.


data _null_;
   a="Hello, World!";
   b=length(c);
   put _all_;
run;

calculate the character and byte length of a string, considering UTF-8 and UTF-16 encodings. They handle non-BMP code points correctly, providing actual character counts in code points, not in code unit counts. The codes also have the ability to provide the string length in graphemes if the language supports it.


/* define SAS data set */
data Indata;
   input C1-C9;
   datalines;
. . 5 . . 7 . . 1
. 7 . . 9 . . 3 .
. . . 6 . . . . .
. . 3 . . 1 . . 5
. 9 . . 8 . . 2 .
1 . . 2 . . 4 . .
. . 2 . . 6 . . 9
. . . . 4 . . 8 .
8 . . 1 . . 5 . .
;

/* call OPTMODEL procedure in SAS/OR */
proc optmodel;
   /* declare variables */
   set ROWS = 1..9;
   set COLS = ROWS;
   var X {ROWS, COLS} >= 1 <= 9 integer;

   /* declare nine row constraints */
   con RowCon {i in ROWS}:
      alldiff({j in COLS} X[i,j]);

   /* declare nine column constraints */
   con ColCon {j in COLS}:
      alldiff({i in ROWS} X[i,j]);

   /* declare nine 3x3 block constraints */
   con BlockCon {s in 0..2, t in 0..2}:
      alldiff({i in 3*s+1..3*s+3, j in 3*t+1..3*t+3} X[i,j]);

   /* fix variables to cell values */
   /* X[i,j] = c[i,j] if c[i,j] is not missing */
   num c {ROWS, COLS};
   read data indata into [_N_] {j in COLS} <c[_N_,j]=col('C'||j)>;
   for {i in ROWS, j in COLS: c[i,j] ne .}
      fix X[i,j] = c[i,j];

   /* call CLP solver */
   solve;

   /* print solution */
   print X;
quit;

X
  1 2 3 4 5 6 7 8 9
1 9 8 5 3 2 7 6 4 1
2 6 7 1 5 9 4 2 3 8
3 3 2 4 6 1 8 9 5 7
4 2 4 3 7 6 1 8 9 5
5 5 9 7 4 8 3 1 2 6
6 1 6 8 2 5 9 4 7 3
7 4 5 2 8 3 6 7 1 9
8 7 1 6 9 4 5 3 8 2
9 8 3 9 1 7 2 5 6 4

"Code implements a Sudoku solver for a partially filled 9x9 grid, displaying the results in a human-readable format using a CLP solver in SAS/OR. It references the Algorithmics of Sudoku and a Python Sudoku Solver Computerphile video."


/* Initialize an array with integers 1 to 10, and print their sum */
data _null_;
array a a1-a10;
n=1;
do over a;
  a=n;
  n=n+1;
end;
s=sum(of a{*});
put s;
run;

Iterates through each element in a collection in order and prints it, using a "for each" loop or another loop if "for each" is not available in the language.


data _null_;
pi = 4*atan(1);
deg = 30;
rad = pi/6;
k = pi/180;
x = 0.2;

a = sin(rad);
b = sin(deg*k);
put a b;

a = cos(rad);
b = cos(deg*k);
put a b;

a = tan(rad);
b = tan(deg*k);
put a b;

a=arsin(x);
b=arsin(x)/k;
put a b;

a=arcos(x);
b=arcos(x)/k;
put a b;

a=atan(x);
b=atan(x)/k;
put a b;
run;

demonstrate the usage of trigonometric functions (sine, cosine, tangent, and their inverses) with the same angle in both radians and degrees. It also includes the conversion of the results of inverse functions to radians and degrees. If the language lacks these functions, the code calculates them using known approximations or identities.


/* create SAS data set */
data mydata;
   input item $1-23 weight value pieces;
   datalines;
map                      9  150  1
compass                 13   35  1
water                  153  200  2
sandwich                50   60  2
glucose                 15   60  2
tin                     68   45  3
banana                  27   60  3
apple                   39   40  3
cheese                  23   30  1
beer                    52   10  3
suntan cream            11   70  1
camera                  32   30  1
T-shirt                 24   15  2
trousers                48   10  2
umbrella                73   40  1
waterproof trousers     42   70  1
waterproof overclothes  43   75  1
note-case               22   80  1
sunglasses               7   20  1
towel                   18   12  2
socks                    4   50  1
book                    30   10  2
;

/* call OPTMODEL procedure in SAS/OR */
proc optmodel;
   /* declare sets and parameters, and read input data */
   set <str> ITEMS;
   num weight {ITEMS};
   num value {ITEMS};
   num pieces {ITEMS};
   read data mydata into ITEMS=[item] weight value pieces;

   /* declare variables, objective, and constraints */
   var NumSelected {i in ITEMS} >= 0 <= pieces[i] integer;
   max TotalValue = sum {i in ITEMS} value[i] * NumSelected[i];
   con WeightCon:
      sum {i in ITEMS} weight[i] * NumSelected[i] <= 400;

   /* call mixed integer linear programming (MILP) solver */
   solve;

   /* print optimal solution */
   print TotalValue;
   print {i in ITEMS: NumSelected[i].sol > 0.5} NumSelected;
quit;

TotalValue
1010

[1] NumSelected
banana 3
cheese 1
compass 1
glucose 2
map 1
note-case 1
socks 1
sunglasses 1
suntan cream 1
water 1
waterproof overclothes 1

determine the optimal combination of items a tourist can carry in his knapsack, given a maximum weight limit of 4 kg. The items, their weights, values, and quantities are listed in a table. The goal is to maximize the total value of the items in the knapsack without exceeding the weight limit. The solution is obtained using the MILP solver in SAS/OR.


data _null_;
  do i=1 to 100;
    if mod(i,15)=0 then put "FizzBuzz";
    else if mod(i,5)=0 then put "Buzz";
    else if mod(i,3)=0 then put "Fizz";
    else put i;
  end;
run;

print numbers from 1 to 100, replacing multiples of three with 'Fizz', multiples of five with 'Buzz', and multiples of both three and five with 'FizzBuzz'.


data _null_;
   array a{*} a1-a100;
   do i=1 to 100;
      a{i}=i*i;
   end;
   b=sum(of a{*});
   put b c;
run;

Calculate the sum and product of all integers in an array.


data _null_;
   a="Hello,";
   b="World!";
   c=a !! " " !! b;
   put c;
   *Alternative using the catx function;
   c=catx (" ", a, b);
   put c;
run;

Initializes two string variables, one with a text value and the other as a concatenation of the first variable and a string literal, then displays their content.


/* create SAS data set */
data mydata;
   input item $ weight value;
   datalines;
beef    3.8  36
pork    5.4  43
ham     3.6  90
greaves 2.4  45
flitch  4.0  30
brawn   2.5  56
welt    3.7  67
salami  3.0  95
sausage 5.9  98
;

/* call OPTMODEL procedure in SAS/OR */
proc optmodel;
   /* declare sets and parameters, and read input data */
   set <str> ITEMS;
   num weight {ITEMS};
   num value {ITEMS};
   read data mydata into ITEMS=[item] weight value;

   /* declare variables, objective, and constraints */
   var WeightSelected {i in ITEMS} >= 0 <= weight[i];
   max TotalValue = sum {i in ITEMS} (value[i]/weight[i]) * WeightSelected[i];
   con WeightCon:
      sum {i in ITEMS} WeightSelected[i] <= 15;

   /* call linear programming (LP) solver */
   solve;

   /* print optimal solution */
   print TotalValue;
   print {i in ITEMS: WeightSelected[i].sol > 1e-3} WeightSelected;
quit;

TotalValue
349.38

[1] WeightSelected
brawn 2.5
greaves 2.4
ham 3.6
salami 3.0
welt 3.5

determine the optimal combination of items a thief can carry in his knapsack, given a maximum weight capacity of 15 kg. The items can be cut, with their price reducing proportionally to their weight. The goal is to maximize the total value of the items in the knapsack. The solution uses a Linear Programming solver in SAS/OR.


PROC SQL;
CREATE TABLE ADDRESS
(
ADDRID CHAR(8)
,STREET CHAR(50)
,CITY CHAR(25)
,STATE CHAR(2)
,ZIP  CHAR(20)
)
;QUIT;

create a table in a database to store US postal addresses, including fields for a unique identifier, street address, city, state code, and zipcode. The codes also demonstrate how to establish a database connection in non-database languages.


data _null_;
do i=1 to 10 by 2;
put i;
end;
run;

demonstrate a for-loop with a step-value greater than one.


/* Store all 92 permutations in a SAS dataset. Translation of Fortran 77 */
data queens;
array a{8} p1-p8;
array s{8};
array u{30};
n=8;
do i=1 to n;
a(i)=i;
end;
do i=1 to 4*n-2;
u(i)=0;
end;
m=0;
i=1;
r=2*n-1;
goto L40;
L30:
s(i)=j;
u(p)=1;
u(q+r)=1;
i=i+1;
L40:
if i>n then goto L80;
j=i;
L50:
z=a(i);
y=a(j);
p=i-y+n;
q=i+y-1;
a(i)=y;
a(j)=z;
if u(p)=0 and u(q+r)=0 then goto L30;
L60:
j=j+1;
if j<=n then goto L50;
L70:
j=j-1;
if j=i then goto L90;
z=a(i);
a(i)=a(j);
a(j)=z;
goto L70;
L80:
m=m+1;
output;
L90:
i=i-1;
if i=0 then goto L100;
p=i-a(i)+n;
q=i+a(i)-1;
j=s(i);
u(p)=0;
u(q+r)=0;
goto L60;
L100:
put n m;
keep p1-p8;
run;

"Solve the N-queens problem for an NxN board and provide the number of solutions for small values of N."


/* create SAS data set */
data mydata;
   input item $1-23 weight value;
   datalines;
map                      9  150
compass                 13   35
water                  153  200
sandwich                50  160
glucose                 15   60
tin                     68   45
banana                  27   60
apple                   39   40
cheese                  23   30
beer                    52   10
suntan cream            11   70
camera                  32   30
T-shirt                 24   15
trousers                48   10
umbrella                73   40
waterproof trousers     42   70
waterproof overclothes  43   75
note-case               22   80
sunglasses               7   20
towel                   18   12
socks                    4   50
book                    30   10
;

/* call OPTMODEL procedure in SAS/OR */
proc optmodel;
   /* declare sets and parameters, and read input data */
   set <str> ITEMS;
   num weight {ITEMS};
   num value {ITEMS};
   read data mydata into ITEMS=[item] weight value;

   /* declare variables, objective, and constraints */
   var NumSelected {ITEMS} binary;
   max TotalValue = sum {i in ITEMS} value[i] * NumSelected[i];
   con WeightCon:
      sum {i in ITEMS} weight[i] * NumSelected[i] <= 400;

   /* call mixed integer linear programming (MILP) solver */
   solve;

   /* print optimal solution */
   print TotalValue;
   print {i in ITEMS: NumSelected[i].sol > 0.5} NumSelected;
quit;

TotalValue
1030

[1] NumSelected
banana 1
compass 1
glucose 1
map 1
note-case 1
sandwich 1
socks 1
sunglasses 1
suntan cream 1
water 1
waterproof overclothes 1
waterproof trousers 1

determine the optimal combination of items a tourist can carry in his knapsack, given a maximum weight limit of 4kg, to maximize the total value of the items. The solution uses a MILP solver in SAS/OR.


filename msg email
   to="afriend@someserver.com"
   cc="anotherfriend@somecompany.com"
   subject="Important message"
;

data _null_;
   file msg;
   put "Hello, Connected World!";
run;

Implement a function to send an email with parameters for From, To, Cc addresses, Subject, message text, and optional server name and login details. The code also provides notifications for any issues or success, and uses libraries or external programs for execution. It ensures portability across different operating systems. Sensitive data used in examples is obfuscated.


The macro "palindro" has two parameters: string and ignorewhitespace.
  string is the expression to be checked.
  ignorewhitespace, (Y/N), determines whether or not to ignore blanks and punctuation.
This macro was written in SAS 9.2.  If you use a version before SAS 9.1.3,
the compress function options will not work.

%MACRO palindro(string, ignorewhitespace);
  DATA _NULL_;
    %IF %UPCASE(&ignorewhitespace)=Y %THEN %DO;
/* The arguments of COMPRESS (sp) ignore blanks and puncutation */
/* We take the string and record it in reverse order using the REVERSE function. */
      %LET rev=%SYSFUNC(REVERSE(%SYSFUNC(COMPRESS(&string,,sp))));
      %LET string=%SYSFUNC(COMPRESS(&string.,,sp));
    %END;

    %ELSE %DO;
      %LET rev=%SYSFUNC(REVERSE(&string));
    %END;
    /*%PUT rev=&rev.;*/
    /*%PUT string=&string.;*/

/* Here we determine if the string and its reverse are the same. */
    %IF %UPCASE(&string)=%UPCASE(&rev.) %THEN %DO;
      %PUT TRUE;
    %END;
    %ELSE %DO;
      %PUT FALSE;
    %END;
  RUN;
%MEND;

%palindro("a man, a plan, a canal: panama",y);

TRUE

NOTE: DATA statement used (Total process time):
      real time           0.00 seconds
      cpu time            0.00 seconds

%palindro("a man, a plan, a canal: panama",n);

FALSE

NOTE: DATA statement used (Total process time):
      real time           0.00 seconds
      cpu time            0.00 seconds

The code is a program or function that checks if a given sequence of characters or bytes is a palindrome. It supports Unicode characters and also has a feature to detect inexact palindromes by ignoring white-space, punctuation, and case-insensitive comparison. The code may also include a function to reverse a string.


Library: proto

library(proto)

stack <- proto(expr = {
   l <- list()
   empty <- function(.) length(.$l) == 0
   push <- function(., x)
   {
      .$l <- c(list(x), .$l)
      print(.$l)
      invisible()
   }
   pop <- function(.)
   {
      if(.$empty()) stop("can't pop from an empty list")
      .$l[[1]] <- NULL
      print(.$l)
      invisible()
   }
})

stack$empty()
# [1] TRUE
stack$push(3)
# [[1]]
# [1] 3
stack$push("abc")
# [[1]]
# [1] "abc"
# [[2]]
# [1] 3
stack$push(matrix(1:6, nrow=2))
# [[1]]
#      [,1] [,2] [,3]
# [1,]    1    3    5
# [2,]    2    4    6
# [[2]]
# [1] "abc"
# [[3]]
# [1] 3
stack$empty()
# [1] FALSE
stack$pop()
# [[1]]
[1] "abc"
# [[2]]
# [1] 3
stack$pop()
# [[1]]
# [1] 3
stack$pop()
# list()
stack$pop()
# Error in get("pop", env = stack, inherits = TRUE)(stack, ...) :
#   can't pop from an empty list

implement a stack data structure with last in, first out (LIFO) access policy. The stack supports basic operations such as push (adding a new element to the top of the stack), pop (removing and returning the last pushed element from the stack), and empty (checking if the stack contains no elements). The topmost element can be accessed without modifying the stack.


"Function to generate the nth Fibonacci number, supporting both positive and negative values of n. The function can be implemented either iteratively or recursively. The function also includes an option to call compiled C code for basic arithmetic operations in R."


a <- 1:100
evennums <- a[ a%%2 == 0 ]
print(evennums)

select certain elements from an array into a new array in a generic way. Specifically, it selects all even numbers from an array. Optionally, it can also filter destructively by modifying the original array instead of creating a new one.


s <- "abcdefgh"
n <- 2; m <- 2; char <- 'd'; chars <- 'cd'
substring(s, n, n + m)
substring(s, n)
substring(s, 1, nchar(s)-1)
indx <- which(strsplit(s, '')[[1]] %in% strsplit(char, '')[[1]])
substring(s, indx, indx + m)
indx <- which(strsplit(s, '')[[1]] %in% strsplit(chars, '')[[1]])[1]
substring(s, indx, indx + m)

- Extracts a substring starting from the nth character of a specific length m.
- Extracts a substring starting from the nth character up to the end of the string.
- Returns the entire string excluding the last character.
- Extracts a substring starting from a known character within the string of length m.
- Extracts a substring starting from a known substring within the string of length m.
- Supports any valid Unicode code point, including those in the Basic Multilingual Plane or above it.
- References logical characters (code points), not 8-bit code units for UTF-8 or 16-bit code units for UTF-16.
- Does not necessarily support all Unicode characters for other encodings like 8-bit ASCII, or EUC-JP.


Works with: R version 2.8.1

revstring <- function(stringtorev) {
   return(
      paste(
           strsplit(stringtorev,"")[[1]][nchar(stringtorev):1]
           ,collapse="")
           )
}

 revstring <- function(s) paste(rev(strsplit(s,"")[[1]]),collapse="")
revstring("asdf")
revstring("m\u00f8\u00f8se")
Encoding("m\u00f8\u00f8se")   # just to check if on your system it's something
                              # different!

"Reverses a given string, preserving Unicode combining characters and working with UTF-8 encoded strings. The code can also handle strings encoded in Latin1 and UTF-8, with the ability to force encoding or translate between encodings when possible."


Works with: R version 2.8.1
sample0to19 <- function() sample(0L:19L, 1,replace=TRUE)
repeat
{
  result1 <- sample0to19()
  if (result1 == 10L)
  {
    print(result1)
    break
  }
  result2 <- sample0to19()
  cat(result1, result2, "\n")
}

generate and print random numbers from 0 to 19. If the generated number is 10, the loop stops. If the number is not 10, a second random number is generated and printed before the loop restarts. If 10 is never generated, the loop runs indefinitely.


Library: XML (R)
library("XML")
doc <- xmlInternalTreeParse("test3.xml")

# Retrieve the first "item" element
getNodeSet(doc, "//item")[[1]]

# Perform an action on each "price" element
sapply(getNodeSet(doc, "//price"), xmlValue)

# Get an array of all the "name" elements
sapply(getNodeSet(doc, "//name"), xmlValue)

1. Retrieves the first "item" element from the XML document.
2. Prints out each "price" element from the XML document.
3. Gets an array of all the "name" elements from the XML document.


years <- 2008:2121
xmas <- as.POSIXlt(paste0(years, '/12/25'))
years[xmas$wday==0]
# 2011 2016 2022 2033 2039 2044 2050 2061 2067 2072 2078 2089 2095 2101 2107 2112 2118

# Also:
xmas=seq(as.Date("2008/12/25"), as.Date("2121/12/25"), by="year")
as.numeric(format(xmas[weekdays(xmas)== 'Sunday'], "%Y"))

# Still another solution, using ISOdate and weekdays
with(list(years=2008:2121), years[weekdays(ISOdate(years, 12, 25)) == "Sunday"])

# Or with "subset"
subset(data.frame(years=2008:2121), weekdays(ISOdate(years, 12, 25)) == "Sunday")$years

# Simply replace "Sunday" with whatever it's named in your country,
# or set locale first, with
Sys.setlocale(cat="LC_ALL", "en")

# Under MS Windows, write instead
Sys.setlocale("LC_ALL", "English")

The code determines the years between 2008 and 2121 where Christmas (25th December) falls on a Sunday, using standard date handling libraries. It also compares the results with other languages to identify any anomalies in date/time representation, such as overflow issues similar to y2k problems.


# R has QR decomposition built-in (using LAPACK or LINPACK)

a <- matrix(c(12, -51, 4, 6, 167, -68, -4, 24, -41), nrow=3, ncol=3, byrow=T)
d <- qr(a)
qr.Q(d)
qr.R(d)

# now fitting a polynomial
x <- 0:10
y <- 3*x^2 + 2*x + 1

# using QR decomposition directly
a <- cbind(1, x, x^2)
qr.coef(qr(a), y)

# using least squares
a <- cbind(x, x^2)
lsfit(a, y)$coefficients

# using a linear model
xx <- x*x
m <- lm(y ~ x + xx)
coef(m)

The code performs QR decomposition of a given matrix using the Householder reflections method. It demonstrates this decomposition on a specific example matrix and uses it to solve linear least squares problems. The code also handles cases where the matrix is not square by cutting off zero padded bottom rows. Finally, it solves the square upper triangular system by back substitution.


implement three methods to remove duplicate elements from an array: 1) Using a hash table, 2) Sorting the array and removing consecutive duplicates, and 3) Iterating through the list and discarding any repeated elements.


Translation of: Octave
qsort <- function(v) {
  if ( length(v) > 1 )
  {
    pivot <- (min(v) + max(v))/2.0                            # Could also use pivot <- median(v)
    c(qsort(v[v < pivot]), v[v == pivot], qsort(v[v > pivot]))
  } else v
}

N <- 100
vs <- runif(N)
system.time(u <- qsort(vs))
print(u)

implement the Quicksort algorithm to sort an array or list of elements. The algorithm works by choosing a pivot element and dividing the rest of the elements into two partitions - one with elements less than the pivot and the other with elements greater than the pivot. It then recursively sorts these partitions and joins them with the pivot to get the sorted array. The codes also include an optimized version of Quicksort that works in place by swapping elements within the array to avoid memory allocation of more arrays. The pivot selection method is not specified.


now <- Sys.time()
strftime(now, "%Y-%m-%d")
strftime(now, "%A, %B %d, %Y")

display the current date in two formats: "2007-11-23" and "Friday, November 23, 2007" using strftime function.


Non-recursive version[edit]

for each element in the set:
	for each subset constructed so far:
		new subset = (subset + element)

powerset <- function(set){
	ps <- list()
	ps[[1]] <- numeric()						#Start with the empty set.
	for(element in set){						#For each element in the set, take all subsets
		temp <- vector(mode="list",length=length(ps))		#currently in "ps" and create new subsets (in "temp")
		for(subset in 1:length(ps)){				#by adding "element" to each of them.
			temp[[subset]] = c(ps[[subset]],element)
		}
		ps <- c(ps,temp)						#Add the additional subsets ("temp") to "ps".
	}
	ps
}

powerset(1:4)

Recursive version[edit]
Library: sets

library(sets)

v <- (1:3)^2
sv <- as.set(v)
2^sv
{{}, {1}, {4}, {9}, {1, 4}, {1, 9}, {4, 9}, {1, 4, 9}}

l <- list(a=1, b="qwerty", c=list(d=TRUE, e=1:3))
sl <- as.set(l)
2^sl
{{}, {1}, {"qwerty"}, {<<list(2)>>}, {1, <<list(2)>>}, {"qwerty",
 1}, {"qwerty", <<list(2)>>}, {"qwerty", 1, <<list(2)>>}}

The code defines a function that takes a set as input and returns the power set of the input set. The power set is the set of all subsets of the input set, including the empty set and the set itself. The function uses an associative array for set implementation and employs a non-recursive method for speed optimization. The function also handles edge cases like power set of an empty set and a set containing only the empty set.


as.roman(1666)   # MDCLXVI

as.roman(1666) + 334   # MM

The function takes a positive integer as input and returns its Roman numeral representation as a string. It breaks down the integer into its constituent digits and converts each digit into its corresponding Roman numeral, starting from the leftmost digit and skipping any zeros. The function also allows for arithmetic operations with Roman numerals.


arr <- array(1)

arr <- append(arr,3)

arr[1] <- 2

print(arr[1])

demonstrate the basic syntax of arrays in the given language, including creating an array, assigning a value to it, and retrieving an element. It also showcases the use of both fixed-length and dynamic arrays, as well as the process of pushing a value into the array.


src <- file("input.txt", "r")
dest <- file("output.txt", "w")

fc <- readLines(src, -1)
writeLines(fc, dest)
close(src); close(dest)

src <- file("input.txt", "rb")
dest <- file("output.txt", "wb")

while( length(v <- readBin(src, "raw")) > 0 ) {
  writeBin(v, dest)
}
close(src); close(dest)

file.copy("input.txt", "output.txt", overwrite = FALSE)

demonstrate how to read the contents of an "input.txt" file into an intermediate variable and then write this variable's contents into a new file called "output.txt". It also shows alternative methods for copying file contents, such as using readLines for textual files or file.copy for non-textual files.


 str <- "alphaBETA"
 toupper(str)
 tolower(str)

demonstrate the conversion of the string "alphaBETA" to upper-case and lower-case using the default string literal or ASCII encoding. The code also showcases additional case conversion functions such as swapping case or capitalizing the first letter if available in the language's library. Note that in some languages, the toLower and toUpper functions may not be reversible.


Works with: R version 2.8.1+

closest_pair_brute <-function(x,y,plotxy=F) {
    xy = cbind(x,y)
    cp = bruteforce(xy)
    cat("\n\nShortest path found = \n From:\t\t(",cp[1],',',cp[2],")\n To:\t\t(",cp[3],',',cp[4],")\n Distance:\t",cp[5],"\n\n",sep="")
    if(plotxy) {
        plot(x,y,pch=19,col='black',main="Closest Pair", asp=1)
        points(cp[1],cp[2],pch=19,col='red')
        points(cp[3],cp[4],pch=19,col='red')
    }
    distance <- function(p1,p2) {
        x1 = (p1[1])
        y1 = (p1[2])
        x2 = (p2[1])
        y2 = (p2[2])
        sqrt((x2-x1)^2 + (y2-y1)^2)
    }
    bf_iter <- function(m,p,idx=NA,d=NA,n=1) {
        dd = distance(p,m[n,])
        if((is.na(d) || dd<=d) && p!=m[n,]){d = dd; idx=n;}
        if(n == length(m[,1])) { c(m[idx,],d) }
        else bf_iter(m,p,idx,d,n+1)
    }
    bruteforce <- function(pmatrix,n=1,pd=c(NA,NA,NA,NA,NA)) {
        p = pmatrix[n,]
        ppd = c(p,bf_iter(pmatrix,p))
        if(ppd[5]<pd[5] || is.na(pd[5])) pd = ppd
        if(n==length(pmatrix[,1]))  pd
        else bruteforce(pmatrix,n+1,pd)
    }
}

closestPair<-function(x,y)
  {
  distancev <- function(pointsv)
    {
    x1 <- pointsv[1]
    y1 <- pointsv[2]
    x2 <- pointsv[3]
    y2 <- pointsv[4]
    sqrt((x1 - x2)^2 + (y1 - y2)^2)
    }
  pairstocompare <- t(combn(length(x),2))
  pointsv <- cbind(x[pairstocompare[,1]],y[pairstocompare[,1]],x[pairstocompare[,2]],y[pairstocompare[,2]])
  pairstocompare <- cbind(pairstocompare,apply(pointsv,1,distancev))
  minrow <- pairstocompare[pairstocompare[,3] == min(pairstocompare[,3])]
  if (!is.null(nrow(minrow))) {print("More than one point at this distance!"); minrow <- minrow[1,]}
  cat("The closest pair is:\n\tPoint 1: ",x[minrow[1]],", ",y[minrow[1]],
                          "\n\tPoint 2: ",x[minrow[2]],", ",y[minrow[2]],
                          "\n\tDistance: ",minrow[3],"\n",sep="")
  c(distance=minrow[3],x1.x=x[minrow[1]],y1.y=y[minrow[1]],x2.x=x[minrow[2]],y2.y=y[minrow[2]])
  }

closest.pairs <- function(x, y=NULL, ...){
      # takes two-column object(x,y-values), or creates such an object from x and y values
       if(!is.null(y))  x <- cbind(x, y)

       distances <- dist(x)
        min.dist <- min(distances)
          point.pair <- combn(1:nrow(x), 2)[, which.min(distances)]

     cat("The closest pair is:\n\t",
      sprintf("Point 1: %.3f, %.3f \n\tPoint 2: %.3f, %.3f \n\tDistance: %.3f.\n",
        x[point.pair[1],1], x[point.pair[1],2],
          x[point.pair[2],1], x[point.pair[2],2],
            min.dist),
            sep=""   )
     c( x1=x[point.pair[1],1],y1=x[point.pair[1],2],
        x2=x[point.pair[2],1],y2=x[point.pair[2],2],
        distance=min.dist)
     }

Examplex = (sample(-1000.00:1000.00,100))
y = (sample(-1000.00:1000.00,length(x)))
cp = closest.pairs(x,y)
#cp = closestPair(x,y)
plot(x,y,pch=19,col='black',main="Closest Pair", asp=1)
points(cp["x1.x"],cp["y1.y"],pch=19,col='red')
points(cp["x2.x"],cp["y2.y"],pch=19,col='red')
#closest_pair_brute(x,y,T)

Performance
system.time(closest_pair_brute(x,y), gcFirst = TRUE)
Shortest path found =
 From:          (32,-987)
 To:            (25,-993)
 Distance:      9.219544

   user  system elapsed
   0.35    0.02    0.37

system.time(closest.pairs(x,y), gcFirst = TRUE)
The closest pair is:
        Point 1: 32.000, -987.000
        Point 2: 25.000, -993.000
        Distance: 9.220.

   user  system elapsed
   0.08    0.00    0.10

system.time(closestPair(x,y), gcFirst = TRUE)
The closest pair is:
        Point 1: 32, -987
        Point 2: 25, -993
        Distance: 9.219544

   user  system elapsed
   0.17    0.00    0.19

closest.pairs.bruteforce <- function(x, y=NULL)
{
	if (!is.null(y))
	{
		x <- cbind(x,y)
	}
	d <- dist(x)
	cp <- x[combn(1:nrow(x), 2)[, which.min(d)],]
	list(p1=cp[1,], p2=cp[2,], d=min(d))
}

closest.pairs.dandc <- function(x, y=NULL)
{
	if (!is.null(y))
	{
		x <- cbind(x,y)
	}
	if (sd(x[,"x"]) < sd(x[,"y"]))
	{
		x <- cbind(x=x[,"y"],y=x[,"x"])
		swap <- TRUE
	}
	else
	{
		swap <- FALSE
	}
	xp <- x[order(x[,"x"]),]
	.cpdandc.rec <- function(xp,yp)
	{
		n <- dim(xp)[1]
		if (n <= 4)
		{
			closest.pairs.bruteforce(xp)
		}
		else
		{
			xl <- xp[1:floor(n/2),]
			xr <- xp[(floor(n/2)+1):n,]
			cpl <- .cpdandc.rec(xl)
			cpr <- .cpdandc.rec(xr)
			if (cpl$d<cpr$d) cp <- cpl else cp <- cpr
			cp
		}
	}
	cp <- .cpdandc.rec(xp)

	yp <- x[order(x[,"y"]),]
	xm <- xp[floor(dim(xp)[1]/2),"x"]
	ys <- yp[which(abs(xm - yp[,"x"]) <= cp$d),]
	nys <- dim(ys)[1]
	if (!is.null(nys) && nys > 1)
	{
		for (i in 1:(nys-1))
		{
			k <- i + 1
			while (k <= nys && ys[i,"y"] - ys[k,"y"] < cp$d)
			{
				d <- sqrt((ys[k,"x"]-ys[i,"x"])^2 + (ys[k,"y"]-ys[i,"y"])^2)
				if (d < cp$d) cp <- list(p1=ys[i,],p2=ys[k,],d=d)
				k <- k + 1
			}
		}
	}
	if (swap)
	{
		list(p1=cbind(x=cp$p1["y"],y=cp$p1["x"]),p2=cbind(x=cp$p2["y"],y=cp$p2["x"]),d=cp$d)
	}
	else
	{
		cp
	}
}

# Test functions
cat("How many points?\n")
n <- scan(what=integer(),n=1)
x <- rnorm(n)
y <- rnorm(n)
tstart <- proc.time()[3]
cat("Closest pairs divide and conquer:\n")
print(cp <- closest.pairs.dandc(x,y))
cat(sprintf("That took %.2f seconds.\n",proc.time()[3] - tstart))
plot(x,y)
points(c(cp$p1["x"],cp$p2["x"]),c(cp$p1["y"],cp$p2["y"]),col="red")
tstart <- proc.time()[3]
cat("\nClosest pairs brute force:\n")
print(closest.pairs.bruteforce(x,y))
cat(sprintf("That took %.2f seconds.\n",proc.time()[3] - tstart))

The code provides a function to solve the Closest Pair of Points problem in a planar case. It includes two algorithms: a brute-force O(n^2) algorithm that finds the closest two points in a given set by comparing all pairs, and a more efficient O(n log n) divide-and-conquer algorithm that sorts the points by x and y coordinates, divides them into two halves, and recursively finds the closest pairs in each half. The function returns the minimum distance and the pair of points with the minimum distance.


The code creates a collection and adds several values to it. It utilizes various types of collections available in R, such as numeric, integer, logical, and character types. These collections can be seen as vectors with a dimension attribute, with matrices being a special case of arrays with two dimensions. The code also uses lists, which are collections of other variables, and data frames, which are similar to a combination of a list and a matrix, where each row represents a collection of variables or a "record".


# Define consts
weights <- c(panacea=0.3, ichor=0.2, gold=2.0)
volumes <- c(panacea=0.025, ichor=0.015, gold=0.002)
values <- c(panacea=3000, ichor=1800, gold=2500)
sack.weight <- 25
sack.volume <- 0.25
max.items <- floor(pmin(sack.weight/weights, sack.volume/volumes))

# Some utility functions
getTotalValue <- function(n) sum(n*values)
getTotalWeight <- function(n) sum(n*weights)
getTotalVolume <- function(n) sum(n*volumes)
willFitInSack <- function(n) getTotalWeight(n) <= sack.weight && getTotalVolume(n) <= sack.volume

# Find all possible combination, then eliminate those that won't fit in the sack
knapsack <- expand.grid(lapply(max.items, function(n) seq.int(0, n)))
ok <- apply(knapsack, 1, willFitInSack)
knapok <- knapsack[ok,]

# Find the solutions with the highest value
vals <- apply(knapok, 1, getTotalValue)
knapok[vals == max(vals),]

     panacea ichor gold
2067       9     0   11
2119       6     5   11
2171       3    10   11
2223       0    15   11

Data_<-structure(list(item = c("Panacea", "Ichor", "Gold"), value = c(3000,
1800, 2500), weight = c(3, 2, 20), volume = c(25, 15, 2)), .Names = c("item",
"value", "weight", "volume"), row.names = c(NA, 3L), class = "data.frame")

knapsack_volume<-function(Data, W, Volume, full_K)
{

	# Data must have the colums with names: item, value, weight and volume.
	K<-list() # hightest values
	K_item<-list() # itens that reach the hightest value
	K<-rep(0,W+1) # The position '0'
	K_item<-rep('',W+1) # The position '0'
	for(w in 1:W)
	{
		temp_w<-0
		temp_item<-''
		temp_value<-0
		for(i in 1:dim(Data)[1]) # each row
		{
			wi<-Data$weight[i] # item i
			vi<- Data$value[i]
			item<-Data$item[i]
			volume_i<-Data$volume[i]
			if(wi<=w & volume_i <= Volume)
			{
				back<- full_K[[Volume-volume_i+1]][w-wi+1]
				temp_wi<-vi + back

				if(temp_w < temp_wi)
				{
					temp_value<-temp_wi
					temp_w<-temp_wi
					temp_item <- item
				}
			}
		}
	K[[w+1]]<-temp_value
	K_item[[w+1]]<-temp_item
	}
return(list(K=K,Item=K_item))
}

Un_knapsack<-function(Data,W,V)
{
	K<-list();K_item<-list()
	K[[1]]<-rep(0,W+1) #the line 0
	K_item[[1]]<-rep('', W+1) #the line 0
	for(v in 1:V)
	{
		best_volum_v<-knapsack_volume(Data, W, v, K)
		K[[v+1]]<-best_volum_v$K
		K_item[[v+1]]<-best_volum_v$Item
	}

return(list(K=data.frame(K),Item=data.frame(K_item,stringsAsFactors=F)))
}

retrieve_info<-function(knapsack, Data)
{
	W<-dim(knapsack$K)[1]
	itens<-c()
	col<-dim(knapsack$K)[2]
	selected_item<-knapsack$Item[W,col]
	while(selected_item!='')
	{
		selected_item<-knapsack$Item[W,col]
		if(selected_item!='')
		{
			selected_item_value<-Data[Data$item == selected_item,]
			W <- W - selected_item_value$weight
			itens<-c(itens,selected_item)
			col <- col - selected_item_value$volume
		}
	}
return(itens)
}

main_knapsack<-function(Data, W, Volume)
{
	knapsack_result<-Un_knapsack(Data,W,Volume)
	items<-table(retrieve_info(knapsack_result, Data))
	K<-knapsack_result$K[W+1, Volume+1]
	cat(paste('The Total profit is: ', K, '\n'))
	cat(paste('You must carry:', names(items), '(x',items, ') \n'))
}

main_knapsack(Data_, 250, 250)

"Determine the maximum value of items a traveler can carry in his knapsack given the weight and volume constraints, using dynamic programming. The solution shows the quantity of each item to be taken to achieve this maximum value. Only one of the four possible solutions needs to be provided."


generate a comma-separated list of numbers from 1 to 10, using a loop with separate output statements for the number and the comma. The last iteration only outputs the number, not the comma.


deps <- list(
"des_system_lib" = c("std", "synopsys", "std_cell_lib", "des_system_lib", "dw02", "dw01", "ramlib", "ieee"),
"dw01" = c("ieee", "dw01", "dware", "gtech", "dw04"),
"dw02" = c("ieee", "dw02", "dware"),
"dw03" = c("std", "synopsys", "dware", "dw03", "dw02", "dw01", "ieee", "gtech"),
"dw04" = c("dw04", "ieee", "dw01", "dware", "gtech"),
"dw05" = c("dw05", "ieee", "dware"),
"dw06" = c("dw06", "ieee", "dware"),
"dw07" = c("ieee", "dware"),
"dware" = c("ieee", "dware"),
"gtech" = c("ieee", "gtech"),
"ramlib" = c("std", "ieee"),
"std_cell_lib" = c("ieee", "std_cell_lib"),
"synopsys" = c())

tsort <- function(deps) {
	nm <- names(deps)
	libs <- union(as.vector(unlist(deps)), nm)

	s <- c()
	# first libs that depend on nothing
	for(x in libs) {
		if(!(x %in% nm)) {
			s <- c(s, x)
		}
	}

	k <- 1
	while(k > 0) {
		k <- 0
		for(x in setdiff(nm, s)) {
			r <- c(s, x)
			if(length(setdiff(deps[[x]], r)) == 0) {
				s <- r
				k <- 1
			}
		}
	}

	if(length(s) < length(libs)) {
		v <- setdiff(libs, s)
		stop(sprintf("Unorderable items :\n%s", paste("", v, sep="", collapse="\n")))
	}

	s
}

tsort(deps)
# [1] "std"            "ieee"           "dware"          "gtech"          "ramlib"
# [6] "std_cell_lib"   "synopsys"       "dw01"           "dw02"           "dw03"
#[11] "dw04"           "dw05"           "dw06"           "dw07"           "des_system_lib"

Unorderable items :
des_system_lib
dw01
dw04
dw03

The code implements a function for topological sorting of VHDL libraries based on their dependencies. It takes into account self-dependencies and un-orderable dependencies. The function returns a valid compile order of the libraries or throws an error if the order cannot be determined. The function uses either Kahn's 1962 topological sort or depth-first search algorithm for sorting.


# 4 rings or 4 squares puzzle

perms <- function (n, r, v = 1:n, repeats.allowed = FALSE) {
  if (repeats.allowed)
    sub <- function(n, r, v) {
      if (r == 1)
        matrix(v, n, 1)
      else if (n == 1)
        matrix(v, 1, r)
      else {
        inner <- Recall(n, r - 1, v)
        cbind(rep(v, rep(nrow(inner), n)), matrix(t(inner),
                                                  ncol = ncol(inner), nrow = nrow(inner) * n,
                                                  byrow = TRUE))
      }
    }
  else sub <- function(n, r, v) {
    if (r == 1)
      matrix(v, n, 1)
    else if (n == 1)
      matrix(v, 1, r)
    else {
      X <- NULL
      for (i in 1:n) X <- rbind(X, cbind(v[i], Recall(n - 1, r - 1, v[-i])))
      X
    }
  }
  X <- sub(n, r, v[1:n])

  result <- vector(mode = "numeric")

  for(i in 1:nrow(X)){
    y <- X[i, ]
    x1 <- y[1] + y[2]
    x2 <- y[2] + y[3] + y[4]
    x3 <- y[4] + y[5] + y[6]
    x4 <- y[6] + y[7]
    if(x1 == x2 & x2 == x3 & x3 == x4) result <- rbind(result, y)
  }
  return(result)
}

print_perms <- function(n, r, v = 1:n, repeats.allowed = FALSE, table.out = FALSE) {
  a <- perms(n, r, v, repeats.allowed)
  colnames(a) <- rep("", ncol(a))
  rownames(a) <- rep("", nrow(a))
  if(!repeats.allowed){
    print(a)
    cat(paste('\n', nrow(a), 'unique solutions from', min(v), 'to', max(v)))
  } else {
    cat(paste('\n', nrow(a), 'non-unique solutions from', min(v), 'to', max(v)))
  }
}

registerS3method("print_perms", "data.frame", print_perms)

print_perms(7, 7, repeats.allowed = FALSE, table.out = TRUE)
print_perms(7, 7, v = 3:9, repeats.allowed = FALSE, table.out = TRUE)
print_perms(10, 7, v = 0:9, repeats.allowed = TRUE, table.out = FALSE)

The code replaces the variables a, b, c, d, e, f, and g with decimal digits ranging from a low to a high value. It then calculates the sum of the variables in each of the four squares, ensuring they all add up to the same total. The code provides all unique solutions for the ranges 1-7 and 3-9, and the total number of solutions for the range 0-9, allowing for non-unique values. Additionally, it includes a function "perms" which is a modified version of the "permutations" function from the "gtools" R package.


win <- tktoplevel()

Library: gWidgets

library(gWidgetstcltk) #or e.g. gWidgetsRGtk2
win <- gwindow()

create a GUI window using R's wrappers for GUI toolkits, specifically tcl/tk and gWidgets packages. The window does not contain any elements but can be closed upon request.


Using summary[edit]
letter.frequency <- function(filename)
{
    file <- paste(readLines(filename), collapse = '')
    chars <- strsplit(file, NULL)[[1]]
    summary(factor(chars))
}

> source('letter.frequency.r')
> letter.frequency('letter.frequency.r')
    -  ,  .  '  (  )  [  ]  {  }  <  =  1  a  c  d  e  f  h  i  l  L  m  n  N  o  p  q  r  s  t  u  U  y
22  3  2  1  2  6  6  2  2  1  1  3  1  1  9  6  1 14  7  2  7  8  3  4  6  1  3  3  1  8  8  7  3  1  2

Using table[edit]

letterFreq <- function(filename, lettersOnly)
{
  txt <- read.delim(filename, header = FALSE, stringsAsFactors = FALSE, allowEscapes = FALSE, quote = "")
  count <- table(strsplit(paste0(txt[,], collapse = ""), ""))
  if(lettersOnly) count[names(count) %in% c(LETTERS, letters)] else count
}

The code opens a text file and counts the frequency of each letter, ignoring punctuation and empty lines. It uses R's read.delim function for reading the file and table function for counting letters. The input is an HTML page, though this may result in inaccurate output due to parsing issues.


Translation of: PARI/GP
Works with: R version 3.3.3 and above
File:FRTR9.pngOutput FRTR9.png
File:FRTR12.pngOutput FRTR12.png
File:FRTR15.pngOutput FRTR15.png
## Recursive FT plotting
plotftree <- function(x, y, a, d, c) {
x2=y2=0; d2r=pi/180.0; a1 <- a*d2r; d1=0;
if(d<=0) {return()}
if(d>0)
  { d1=d*10.0;
    x2=x+cos(a1)*d1;
    y2=y+sin(a1)*d1;
    segments(x*c, y*c, x2*c, y2*c, col='darkgreen');
    plotftree(x2,y2,a-20,d-1,c);
    plotftree(x2,y2,a+20,d-1,c);
    #return(2);
  }
}
## Plotting Fractal Tree. aev 3/27/17
## ord - order/depth, c - scale, xsh - x-shift, fn - file name,
##  ttl - plot title.
pFractalTree <- function(ord, c=1, xsh=0, fn="", ttl="") {
  cat(" *** START FRT:", date(), "\n");
  m=640;
  if(fn=="") {pf=paste0("FRTR", ord, ".png")} else {pf=paste0(fn, ".png")};
  if(ttl=="") {ttl=paste0("Fractal tree, order - ", ord)};
  cat(" *** Plot file -", pf, "title:", ttl, "\n");
  ##plot(NA, xlim=c(0,m), ylim=c(-m,0), xlab="", ylab="", main=ttl);
  plot(NA, xlim=c(0,m), ylim=c(0,m), xlab="", ylab="", main=ttl);
  plotftree(m/2+xsh,100,90,ord,c);
  dev.copy(png, filename=pf, width=m, height=m);
  dev.off(); graphics.off();
  cat(" *** END FRT:",date(),"\n");
}
## Executing:
pFractalTree(9);
pFractalTree(12,0.6,210);
pFractalTree(15,0.35,600);

generate and draw a fractal tree by first drawing the trunk, then splitting the trunk at the end by a certain angle to form two branches, and repeating this process until a desired level of branching is reached.


Array solution[edit]
factors <- function(n)
{
   if(length(n) > 1)
   {
      lapply(as.list(n), factors)
   } else
   {
      one.to.n <- seq_len(n)
      one.to.n[(n %% one.to.n) == 0]
   }
}

calculate the factors of a given positive integer, excluding zero and negative integers. It also notes that every prime number has two factors: 1 and itself. An idiomatic way to achieve this is by using R's Filter function.


# Read in text
lines <- readLines(tc <- textConnection("Given$a$text$file$of$many$lines,$where$fields$within$a$line$
are$delineated$by$a$single$'dollar'$character,$write$a$program
that$aligns$each$column$of$fields$by$ensuring$that$words$in$each$
column$are$separated$by$at$least$one$space.
Further,$allow$for$each$word$in$a$column$to$be$either$left$
justified,$right$justified,$or$center$justified$within$its$column.")); close(tc)

#Split words by the dollar
words <- strsplit(lines, "\\$")

#Reformat
maxlen <- max(sapply(words, length))
words <- lapply(words, function(x) {length(x) <- maxlen; x})
block <- matrix(unlist(words), byrow=TRUE, ncol=maxlen)
block[is.na(block)] <- ""
leftjust <- format(block)
rightjust <- format(block, justify="right")
centrejust <- format(block, justify="centre")

# Print
print0 <- function(x) invisible(apply(x, 1, function(x) cat(x, "\n")))
print0(leftjust)
print0(rightjust)
print0(centrejust)

     Given          a       text       file         of       many     lines,      where     fields     within          a       line
       are delineated         by          a     single   'dollar' character,      write          a    program
      that     aligns       each     column         of     fields         by   ensuring       that      words         in       each
    column        are  separated         by         at      least        one     space.
  Further,      allow        for       each       word         in          a     column         to         be     either       left
justified,      right justified,         or     center  justified     within        its    column.

The code reads a text file where fields within a line are separated by a dollar character. It aligns each column of fields by ensuring at least one space between words in each column. It allows for each word in a column to be either left justified, right justified, or center justified. The minimum space between columns is computed from the text. It handles trailing dollar characters and consecutive space characters at the end of lines. The output is displayed in a mono-spaced font on a plain text editor or basic terminal.


rot13 <- function(x)
{
  old <- paste(letters, LETTERS, collapse="", sep="")
  new <- paste(substr(old, 27, 52), substr(old, 1, 26), sep="")
  chartr(old, new, x)
}
x <- "The Quick Brown Fox Jumps Over The Lazy Dog!.,:;'#~[]{}"
rot13(x)   # "Gur Dhvpx Oebja Sbk Whzcf Bire Gur Ynml Qbt!.,:;'#~[]{}"
x2 <- paste(letters, LETTERS, collapse="", sep="")
rot13(x2)  # "nNoOpPqQrRsStTuUvVwWxXyYzZaAbBcCdDeEfFgGhHiIjJkKlLmM"

The code implements a rot-13 function that replaces every letter of the ASCII alphabet with the letter rotated 13 characters around the 26 letter alphabet. It works on both upper and lower case letters, preserves case, and passes all non-alphabetic characters without alteration. The function can be optionally wrapped in a utility program acting like a common UNIX utility, performing a line-by-line rot-13 encoding of every line of input from each file listed on its command line or acting as a filter on its standard input.


sortbyname <- function(x, ...) x[order(names(x), ...)]
x <- c(texas=68.9, ohio=87.8, california=76.2, "new york"=88.2)
sortbyname(x)

california   new york       ohio      texas
      76.2       88.2       87.8       68.9

sortbyname(x, decreasing=TRUE)

     texas       ohio   new york california
      68.9       87.8       88.2       76.2

sort an array of composite structures, specifically name-value pairs, by the key 'name' using a custom comparator.


demonstrate how to use nested for loops to print a specific pattern. The number of iterations in the inner loop is controlled by the outer loop, resulting in a pattern of increasing asterisks.


environment example[edit]
> env <- new.env()
> env[["x"]] <- 123
> env[["x"]]
[1] 123
> index <- "1"
> env[[index]] <- "rainfed hay"
> env[[index]]
[1] "rainfed hay"
> env[["1"]]
[1] "rainfed hay"
> env
<environment: 0xb7cd560>
> print(env)
<environment: 0xb7cd560>
vector example[edit]
> x <- c(hello=1, world=2, "!"=3)
> print(x)
hello world     !
    1     2     3
> print(names(x))
[1] "hello" "world" "!"
print(unname(x))
[1] 1 2 3
list example[edit]
> a <- list(a=1, b=2, c=3.14, d="xyz")
> print(a)
$a
[1] 1

$b
[1] 2

$c
[1] 3.14

$d
[1] "xyz"
> print(names(a))
[1] "a" "b" "c" "d"
> print(unname(a))
[[1]]
[1] 1

[[2]]
[1] 2

[[3]]
[1] 3.14

[[4]]
[1] "xyz"

create an associative array (dictionary, map, or hash) in R using structures that allow named elements.


The code implements two historic random number generators: the rand() function from BSD libc and the rand() function from the Microsoft C Runtime (MSCVRT.DLL). These generators use the linear congruential generator formula with specific constants. The generators produce a sequence of integers, starting from a seed value, that is not cryptographically secure but can be used for simple tasks. The BSD generator outputs numbers in the range 0 to 2147483647, while the Microsoft generator outputs numbers in the range 0 to 32767.


R: With tutor[edit]
halve <- function(a) floor(a/2)
double <- function(a) a*2
iseven <- function(a) (a%%2)==0

ethiopicmult <- function(plier, plicand, tutor=FALSE) {
  if (tutor) { cat("ethiopic multiplication of", plier, "and", plicand, "\n") }
  result <- 0
  while(plier >= 1) {
    if (!iseven(plier)) { result <- result + plicand }
    if (tutor) {
      cat(plier, ", ", plicand, " ", ifelse(iseven(plier), "struck", "kept"), "\n", sep="")
    }
    plier <- halve(plier)
    plicand <- double(plicand)
  }
  result
}

print(ethiopicmult(17, 34, TRUE))
R: Without tutor[edit]

halve <- function(a) floor(a/2)
double <- function(a) a*2
iseven <- function(a) (a%%2)==0

ethiopicmult<-function(x,y){
	res<-ifelse(iseven(y),0,x)
	while(!y==1){
		x<-double(x)
		y<-halve(y)
		if(!iseven(y)) res<-res+x
	}
	return(res)
}

print(ethiopicmult(17,34))

The code defines three functions for halving an integer, doubling an integer, and checking if an integer is even. These functions are used to implement Ethiopian multiplication, a method that multiplies two integers using only addition, doubling, and halving operations.


library(gtools)

solve24 <- function(vals=c(8, 4, 2, 1),
                    goal=24,
                    ops=c("+", "-", "*", "/")) {

  val.perms <- as.data.frame(t(
                  permutations(length(vals), length(vals))))

  nop <- length(vals)-1
  op.perms <- as.data.frame(t(
                  do.call(expand.grid,
                          replicate(nop, list(ops)))))

  ord.perms <- as.data.frame(t(
                   do.call(expand.grid,
                           replicate(n <- nop, 1:((n <<- n-1)+1)))))

  for (val.perm in val.perms)
    for (op.perm in op.perms)
      for (ord.perm in ord.perms)
        {
          expr <- as.list(vals[val.perm])
          for (i in 1:nop) {
            expr[[ ord.perm[i] ]] <- call(as.character(op.perm[i]),
                                          expr[[ ord.perm[i]   ]],
                                          expr[[ ord.perm[i]+1 ]])
            expr <- expr[ -(ord.perm[i]+1) ]
          }
          if (identical(eval(expr[[1]]), goal)) return(expr[[1]])
        }

  return(NA)
}

The code accepts four digits as input or generates them randomly, then computes arithmetic expressions according to the rules of the 24 game. It also displays examples of the solutions it generates. The code uses exhaustive search and leverages R's ability to handle expressions as data, making it generally applicable for any set of operands and binary operators.


Recursive[edit]
fact <- function(n) {
  if (n <= 1) 1
  else n * Recall(n - 1)
}
Iterative[edit]
factIter <- function(n) {
  f = 1
  if (n > 1) {
    for (i in 2:n) f <- f * i
  }
  f
}
Numerical Approximation[edit]

print(factorial(50)) # 3.041409e+64

The code is a function that calculates and returns the factorial of a given number. The factorial is computed either iteratively or recursively. The function may optionally handle errors for negative input values. It also includes a reference to the native gamma function in R for producing factorials.


Works with: R version 2.8.1
target <- sample(1:9,4)
bulls <- 0
cows <- 0
attempts <- 0
while (bulls != 4)
  {
  input <- readline("Guess a 4-digit number with no duplicate digits or 0s: ")
  if (nchar(input) == 4)
    {
    input <- as.integer(strsplit(input,"")[[1]])
    if ((sum(is.na(input)+sum(input==0))>=1) | (length(table(input)) != 4)) {print("Malformed input!")} else {
      bulls <- sum(input == target)
      cows <- sum(input %in% target)-bulls
      cat("\n",bulls," Bull(s) and ",cows, " Cow(s)\n")
      attempts <- attempts + 1
      }
    } else {print("Malformed input!")}
  }
print(paste("You won in",attempts,"attempt(s)!"))

generate a unique four-digit number, accept and validate user guesses, calculate and print scores based on matching digits and their positions, and end the program when the user guess matches the generated number.


# For reproducibility, set the seed:
set.seed(12345L)

result <- rnorm(1000, mean = 1, sd = 0.5)

generate a collection of 1000 normally distributed pseudo-random numbers with a mean of 1.0 and a standard deviation of 0.5.


x <- c(1, 3, -5)
y <- c(4, -2, -1)

sum(x*y)  # compute products, then do the sum
x %*% y   # inner product

# loop implementation
dotp <- function(x, y) {
	n <- length(x)
	if(length(y) != n) stop("invalid argument")
	s <- 0
	for(i in 1:n) s <- s + x[i]*y[i]
	s
}

dotp(x, y)

Implement a function to calculate the dot product of two vectors of arbitrary length. The vectors should be of the same length, and the function works by multiplying corresponding terms from each vector and summing the products.


"Reads data from a text stream either word-by-word or line-by-line until the data is exhausted. It handles streams with an unknown amount of data. For 'dataset' style contents, read.csv and read.table can be used as alternatives."


Works with: R version 2.8.1
Note that this is output as a standard style string.Sys.time()

the system time in a specified unit. This can be used for debugging, network information, random number seeds, or program performance. The time is retrieved either by a system command or a built-in language function. It is related to the task of date formatting and retrieving system time.


# Read in data from text connection
datalines <- readLines(tc <- textConnection("710889
B0YBKJ
406566
B0YBLH
228276
B0YBKL
557910
B0YBKR
585284
B0YBKT")); close(tc)

# Check data valid
checkSedol <- function(datalines)
{
   ok <- grep("^[[:digit:][:upper:]]{6}$", datalines)
   if(length(ok) < length(datalines))
   {
      stop("there are invalid lines")
   }
}
checkSedol(datalines)

# Append check digit
appendCheckDigit <- function(x)
{
   if(length(x) > 1) return(sapply(x, appendCheckDigit))
   ascii <- as.integer(charToRaw(x))
   scores <- ifelse(ascii < 65, ascii - 48, ascii - 55)
   weights <- c(1, 3, 1, 7, 3, 9)
   chkdig <- (10 - sum(scores * weights) %% 10) %% 10
   paste(x, as.character(chkdig), sep="")
}
withchkdig <- appendCheckDigit(datalines)

#Print in format requested
writeLines(withchkdig)

The code takes a list of 6-digit SEDOLs as input, calculates the checksum digit for each SEDOL, and appends it to the end of the respective SEDOL. It also validates the input to ensure it contains only valid characters for a SEDOL string.