load "guilib.ring"
load "stdlib.ring"

size = 3
flip = newlist(size,size)
board = newlist(size,size)
colflip = list(size)
rowflip = list(size)

new qapp
        {
        win1 = new qwidget() {
                  setwindowtitle("Flipping bits game")
                  setgeometry(465,115,800,600)
                  label1 = new qlabel(win1) {
                              setgeometry(285,60,120,40)
                              settext("Target")
                  }
                  label2 = new qlabel(win1) {
                              setgeometry(285,220,120,40)
                              settext("Board")
                  }
                  for n = 1 to size
                       for m = 1 to size
                            flip[n][m] = new qpushbutton(win1) {
                                             setgeometry(200+n*40,60+m*40,40,40)
                                             settext(string(random(1)))
                                             }
                       next
                  next
                  for n = 1 to size
                       for m = 1 to size
                            board[n][m] = new qpushbutton(win1) {
                                                 setgeometry(200+n*40,260+m*40,40,40)
                                                 setclickevent("draw(" + n + "," + m +")")
                                                 }
                       next
                  next
                  for n = 1 to size
                       colflip[n]= new qpushbutton(win1) {
                                              setgeometry(200+n*40,260,40,40)
                                              settext("Go")
                                              setclickevent("coldraw(" + n + ")")
                                              }
                  next
                  for n = 1 to size
                       rowflip[n]= new qpushbutton(win1) {
                                               setgeometry(200,260+n*40,40,40)
                                               settext("Go")
                                               setclickevent("rowdraw(" + n + ")")
                                               }
                  next
                  scramblebutton = new qpushbutton(win1) {
                                                   setgeometry(240,460,120,40)
                                                   settext("Scramble Board")
                                                   setclickevent("scramble(flip)")
                                                   }
        scramblebegin(flip)
        show()
        }
        exec()
        }

func coldraw(n)
        for row = 1 to size
             board[n][row] {temp = text()}
             if temp = "0"
                board[n][row].settext("1")
             else
                board[n][row].settext("0")
             ok
         next

func rowdraw(n)
        for col = 1 to size
             board[col][n] {temp = text()}
             if temp = "0"
                board[col][n].settext("1")
             else
                board[col][n].settext("0")
             ok
         next

func scramble(flip)
        for col = 1 to size
             for row = 1 to size
                  flip[col][row]{temp = text()}
                  board[col][row].settext(temp)
             next
        next
        for mix = 1 to size*10
             colorrow = random(1) + 1
             colrow = random(size-1) + 1
             if colorrow = 1
                rc = "coldraw"
             else
                rc = "rowdraw"
             ok
             go = rc + "(" + colrow + ")"
             eval(go)
        next

func scramblebegin(flip)
        for col = 1 to size
             for row = 1 to size
                  flip[col][row]{temp = text()}
                  board[col][row].settext(temp)
             next
        next


class FlipBoard
  def initialize(size)
    raise ArgumentError.new("Invalid board size: #{size}") if size < 2

    @size = size
    @board = Array.new(size**2, 0)

    randomize_board
    loop do
      @target = generate_target
      break unless solved?
    end

    # these are used for validating user input
    @columns = [*'a'...('a'.ord+@size).chr]
    @rows = (1[email protected]).map(&:to_s)
  end

  ############################################################

  def play
    moves = 0
    puts "your target:", target

    until solved?
      puts "", "move #{moves}:", self
      print "Row/column to flip: "
      ans = $stdin.gets.strip

      if @columns.include? ans
        flip_column @columns.index(ans)
        moves += 1
      elsif @rows.include? ans
        flip_row @rows.index(ans)
        moves += 1
      else
        puts "invalid input: " + ans
      end
    end

    puts "", "you solved the game in #{moves} moves", self
  end

  # the target formation as a string
  def target
    format_array @target
  end

  # the current formation as a string
  def to_s
    format_array @board
  end

  ############################################################
  private

  def solved?
    @board == @target
  end

  # flip a random number of bits on the board
  def randomize_board
    (@size + rand(@size)).times do
      flip_bit rand(@size), rand(@size)
    end
  end

  # generate a random number of flip_row/flip_column calls
  def generate_target
    orig_board = @board.clone
    (@size + rand(@size)).times do
      rand(2).zero? ? flip_row( rand(@size) ) : flip_column( rand(@size) )
    end
    target, @board = @board, orig_board
    target
  end

  def flip_row(row)
    @size.times {|col| flip_bit(row, col)}
  end

  def flip_column(col)
    @size.times {|row| flip_bit(row, col)}
  end

  def flip_bit(row, col)
    @board[@size * row + col] ^= 1
  end

  def format_array(ary)
    str = "   " + @columns.join(" ") + "\n"
    @size.times do |row|
      str << "%2s " % @rows[row] + ary[@size*row, @size].join(" ") + "\n"
    end
    str
  end
end

######################################################################
begin
  FlipBoard.new(ARGV.shift.to_i).play
rescue => e
  puts e.message
end


// For random generation
extern crate rand;

// For fmt::Display
use std::fmt;
// For I/O (stdin, stdout, etc)
use std::io::prelude::*;

use rand::Rng;

/// A simple struct for a board
struct Board {
    /// The cells of the board
    cells: Vec<bool>,
    /// The size of the board
    size: usize,
}

// Functions for the Board struct
impl Board {
    /// Generate a new, empty board, of size >= 1
    ///
    /// Returns a Board in the "off" state, where all cells are 0.
    /// If a size of 0 is given, a Board of size 1 will be created instead.
    /// A mutable board is required for using Board::fliprow and Board::flipcol functions.
    ///
    /// ```
    /// let mut board: Board = Board::new(3);
    /// ```
    fn new(size: usize) -> Board {
        // Ensure we make a board with a non-zero size
        if size > 0 {
            Board {
                cells: vec![false; size * size],
                size,
            }
        } else {
            Board::new(1)
        }
    }

    /// Flip the specified row
    ///
    /// Returns true if the row is within the size, false otherwise.
    ///
    /// ```
    /// let mut board: Board = Board::new(3);
    /// board.fliprow(1);
    /// ```
    fn fliprow(&mut self, row: usize) -> bool {
        // Check constraints
        if row > self.size {
            return false;
        }
        // Starting position in the vector
        let start = row * self.size;
        // Loop through the vector row
        for i in start..start + self.size {
            self.cells[i] = !self.cells[i];
        }
        true
    }

    /// Flip the specified column
    ///
    /// Returns true if the column is within the size, false otherwise.
    ///
    /// ```
    /// let mut board: Board = Board::new(3);
    /// board.flipcol(0);
    /// ```
    fn flipcol(&mut self, col: usize) -> bool {
        // Check constraints
        if col > self.size {
            return false;
        }
        // Loop through the vector column
        for i in 0..self.size {
            self.cells[col + i * self.size] = !self.cells[col + i * self.size];
        }
        true
    }

    /// Generate a random board
    ///
    /// Returns a Board in a random state.
    /// If a size of 0 is given, a Board of size 1 will be created instead.
    ///
    /// ```
    /// let target: Board = Board::random(3);
    /// ```
    fn random<R: Rng>(rng: &mut R, size: usize) -> Board {
        // Ensure we make a board with a non-zero size
        if size == 0 {
            return Board::random(rng, 1);
        }

        // Make a vector of the board size with random bits
        let cells = (0..size * size)
            .map(|_| rng.gen::<bool>())
            .collect::<Vec<_>>();
        // Return the random board
        Board { cells, size }
    }
}

impl PartialEq for Board {
    fn eq(&self, rhs: &Board) -> bool {
        self.cells == rhs.cells
    }
}

// Implement the Display format, used with `print!("{}", &board);`
impl fmt::Display for Board {
    // Example output:
    //   0 1 2
    // 0 0 1 0
    // 1 1 0 0
    // 2 0 1 1
    fn fmt(&self, f: &mut fmt::Formatter) -> fmt::Result {
        // Get the string width of the size of the board
        let width = (self.size - 1).to_string().len();
        // Write the initial spaces (upper left)
        write!(f, "{space: >0$}", width, space = " ")?;
        // Write the column numbers
        for i in 0..self.size {
            write!(f, " {offset:>0$}", width, offset = i)?;
        }
        // Newline for rows
        writeln!(f)?;
        // Loop through the rows
        for row in 0..self.size {
            // Write the row number
            write!(f, "{row:>0$}", width, row = row)?;
            // Loop through the columns
            for col in 0..self.size {
                // Get the value of the cell as 1 or 0
                let p = self.cells[row * self.size + col] as usize;
                // Write the column value
                write!(f, " {col:>0$}", width, col = p)?;
            }
            // Newline for next row
            writeln!(f)?;
        }
        // Return Formatter result
        Ok(())
    }
}

fn main() {
    let mut rng = rand::thread_rng();

    // The board size
    let size: usize = 3;
    // The target board
    let target: Board = Board::random(&mut rng, size);
    // The user board
    let mut board: Board = Board::new(size);
    // How many moves taken
    let mut moves: u32 = 0;
    // Loop until win or quit
    'mainloop: loop {
        // User input
        let mut input: String;
        // Write the boards
        println!("Target:\n{}\nBoard:\n{}", &target, &board);
        // User input loop
        'userinput: loop {
            // Prompt
            print!("\nFlip? [q|[r|c]#] ");
            // Flush stdout to write the previous print, if we can't then exit
            match std::io::stdout().flush() {
                Ok(_) => {}
                Err(e) => {
                    println!("Error: cannot flush stdout: {}", e);
                    break 'mainloop;
                }
            };
            // Reset input for each loop
            input = String::new();
            // Read user input
            match std::io::stdin().read_line(&mut input) {
                Ok(_) => {
                    input = input.trim().to_string();
                    // Get the first character
                    let rc: char = match input.chars().next() {
                        Some(c) => c,
                        None => {
                            println!("Error: No input");
                            continue 'userinput;
                        }
                    };
                    // Make sure input is r, c, or q
                    if rc != 'r' && rc != 'c' && rc != 'q' {
                        println!("Error: '{}': Must use 'r'ow or 'c'olumn or 'q'uit", rc);
                        continue 'userinput;
                    }
                    // If input is q, exit game
                    if rc == 'q' {
                        println!("Thanks for playing!");
                        break 'mainloop;
                    }
                    // If input is r or c, get the number after
                    let n: usize = match input[1..].to_string().parse() {
                        Ok(x) => {
                            // If we're within bounds, return the parsed number
                            if x < size {
                                x
                            } else {
                                println!(
                                    "Error: Must specify a row or column within size({})",
                                    size
                                );
                                continue 'userinput;
                            }
                        }
                        Err(_) => {
                            println!(
                                "Error: '{}': Unable to parse row or column number",
                                input[1..].to_string()
                            );
                            continue 'userinput;
                        }
                    };
                    // Flip the row or column specified
                    match rc {
                        'r' => board.fliprow(n),
                        'c' => board.flipcol(n),
                        _ => {
                            // We want to panic here because should NEVER
                            // have anything other than 'r' or 'c' here
                            panic!("How did you end up here?");
                        }
                    };
                    // Increment moves
                    moves += 1;
                    println!("Moves taken: {}", moves);
                    break 'userinput;
                }
                Err(e) => {
                    println!("Error reading input: {}", e);
                    break 'mainloop;
                }
            }
        } // 'userinput
        if board == target {
            println!("You win!");
            break;
        }
    } // 'mainloop
}


import java.awt.{BorderLayout, Color, Dimension, Font, Graphics, Graphics2D, Rectangle, RenderingHints}
import java.awt.event.{MouseAdapter, MouseEvent}

import javax.swing.{JFrame, JPanel}

object FlippingBitsGame extends App {

  class FlippingBitsGame extends JPanel {
    private val maxLevel: Int = 7
    private val box: Rectangle = new Rectangle(120, 90, 400, 400)

    private var n: Int = maxLevel

    private var grid: Array[Array[Boolean]] = _
    private var target: Array[Array[Boolean]] = _

    private var solved: Boolean = true

    override def paintComponent(gg: Graphics): Unit = {
      def drawGrid(g: Graphics2D): Unit = {
        if (solved) g.drawString("Solved! Click here to play again.", 180, 600)
        else g.drawString("Click next to a row or a column to flip.", 170, 600)
        val size: Int = box.width / n
        for {r <- 0 until n
             c <- 0 until n} {
          g.setColor(if (grid(r)(c)) Color.blue else Color.orange)
          g.fillRect(box.x + c * size, box.y + r * size, size, size)
          g.setColor(getBackground)
          g.drawRect(box.x + c * size, box.y + r * size, size, size)
          g.setColor(if (target(r)(c)) Color.blue else Color.orange)
          g.fillRect(7 + box.x + c * size, 7 + box.y + r * size, 10, 10)
        }
      }

      super.paintComponent(gg)
      val g: Graphics2D = gg.asInstanceOf[Graphics2D]
      g.setRenderingHint(RenderingHints.KEY_ANTIALIASING, RenderingHints.VALUE_ANTIALIAS_ON)
      drawGrid(g)
    }

    private def printGrid(msg: String, g: Array[Array[Boolean]]): Unit = {
      println(msg)
      for (row <- g) println(row.mkString(", "))
      println()
    }

    private def startNewGame(): Unit = {
      val rand = scala.util.Random

      if (solved) {
        val minLevel: Int = 3
        n = if (n == maxLevel) minLevel else n + 1
        grid = Array.ofDim[Boolean](n, n)
        target = Array.ofDim[Boolean](n, n)

        do {
          def shuffle(): Unit = for (i <- 0 until n * n)
            if (rand.nextBoolean()) flipRow(rand.nextInt(n)) else flipCol(rand.nextInt(n))

          shuffle()
          for (i <- grid.indices) grid(i).copyToArray(target(i)) //, n)
          shuffle()
        } while (solved(grid, target))
        solved = false
        printGrid("The target", target)
        printGrid("The board", grid)
      }
    }

    private def solved(a: Array[Array[Boolean]], b: Array[Array[Boolean]]): Boolean =
      a.indices.forall(i => a(i) sameElements b(i))

    private def flipRow(r: Int): Unit = for (c <- 0 until n) grid(r)(c) ^= true

    private def flipCol(c: Int): Unit = for (row <- grid) row(c) ^= true

    setPreferredSize(new Dimension(640, 640))
    setBackground(Color.white)
    setFont(new Font("SansSerif", Font.PLAIN, 18))
    startNewGame()
    addMouseListener(new MouseAdapter() {
      override def mousePressed(e: MouseEvent): Unit = {
        if (solved) startNewGame()
        else {
          val x: Int = e.getX
          val y: Int = e.getY
          if (box.contains(x, y)) return
          if (x > box.x && x < box.x + box.width) flipCol((x - box.x) / (box.width / n))
          else if (y > box.y && y < box.y + box.height) flipRow((y - box.y) / (box.height / n))
          solved = solved(grid, target)
          printGrid(if (solved) "Solved!" else "The board", grid)
        }
        repaint()
      }
    })

  }

  new JFrame("Flipping Bits Game") {
    add(new FlippingBitsGame(), BorderLayout.CENTER)
    pack()
    setDefaultCloseOperation(javax.swing.WindowConstants.EXIT_ON_CLOSE)
    setLocationRelativeTo(null)
    setResizable(false)
    setVisible(true)
  }

}


import Foundation

struct Board: Equatable, CustomStringConvertible {
    let size: Int
    private var tiles: [Bool]

    init(size: Int) {
        self.size = size
        tiles = Array(count: size * size, repeatedValue: false)
    }

    subscript(x: Int, y: Int) -> Bool {
        get {
            return tiles[y * size + x]
        }
        set {
            tiles[y * size + x] = newValue
        }
    }

    mutating func randomize() {
        for i in 0..<tiles.count {
            tiles[i] = Bool(random() % 2)
        }
    }

    mutating func flipRow(row: Int) {
        for i in 0..<size {
            self[row, i] = !self[row, i]
        }
    }

    mutating func flipColumn(column: Int) {
        for i in 0..<size {
            self[i, column] = !self[i, column]
        }
    }

    var description: String {
        var desc = "\n\ta\tb\tc\n"
        for i in 0..<size {
            desc += "\(i+1):\t"
            for j in 0..<size {
                desc += "\(Int(self[i, j]))\t"
            }
            desc += "\n"
        }

        return desc
    }
}

func ==(lhs: Board, rhs: Board) -> Bool {
    return lhs.tiles == rhs.tiles
}

class FlippingGame: CustomStringConvertible {

    var board: Board
    var target: Board
    var solved: Bool { return board == target }

    init(boardSize: Int) {
        target = Board(size: 3)
        board = Board(size: 3)
        generateTarget()
    }

    func generateTarget() {
        target.randomize()
        board = target
        let size = board.size
        while solved {
            for _ in 0..<size + (random() % size + 1) {
                if random() % 2 == 0 {
                    board.flipColumn(random() % size)
                }
                else {
                    board.flipRow(random() % size)
                }
            }
        }
    }

    func getMove() -> Bool {
        print(self)
        print("Flip what? ", terminator: "")

        guard
            let move = readLine(stripNewline: true)
            where move.characters.count == 1
            else { return false }

        var moveValid = true

        if let row = Int(move) {
            board.flipRow(row - 1)
        }
        else if let column = move.lowercaseString.utf8.first where column < 100 && column > 96  {
            board.flipColumn(numericCast(column) - 97)
        }
        else {
            moveValid = false
        }

        return moveValid
    }

    var description: String {
        var str = ""
        print("Target: \n \(target)", toStream: &str)
        print("Board: \n \(board)", toStream: &str)

        return str
    }
}

func playGame(game: FlippingGame) -> String {
    game.generateTarget()
    var numMoves = 0
    while !game.solved {
        numMoves++
        print("Move #\(numMoves)")
        while !game.getMove() {}
    }
    print("You win!")
    print("Number of moves: \(numMoves)")
    print("\n\nPlay Again? ", terminator: "")

    return readLine(stripNewline: true)!.lowercaseString
}

let game = FlippingGame(boardSize: 3)
repeat { } while playGame(game) == "y"


package require Tcl 8.6

oo::class create Flip {
    variable board target s
    constructor {size} {
	set s $size
	set target [my RandomConfiguration]
	set board $target
	while {$board eq $target} {
	    for {set i 0} {$i < $s} {incr i} {
		if {rand()<.5} {
		    my SwapRow $i
		}
		if {rand()<.5} {
		    my SwapColumn $i
		}
	    }
	}
    }

    method RandomConfiguration {{p 0.5}} {
	for {set row 0} {$row < $s} {incr row} {
	    set r {}
	    for {set col 0} {$col < $s} {incr col} {
		lappend r [expr {rand() < $p}]
	    }
	    lappend result $r
	}
	return $result
    }

    method SwapRow {rowId} {
	for {set i 0} {$i < $s} {incr i} {
	    lset board $rowId $i [expr {![lindex $board $rowId $i]}]
	}
    }
    method SwapColumn {columnId} {
	for {set i 0} {$i < $s} {incr i} {
	    lset board $i $columnId [expr {![lindex $board $i $columnId]}]
	}
    }

    method Render {configuration {prefixes {}}} {
	join [lmap r $configuration p $prefixes {
	    format %s%s $p [join [lmap c $r {string index ".X" $c}] ""]
	}] "\n"
    }
    method GetInput {prompt} {
	puts -nonewline "${prompt}: "
	flush stdout
	gets stdin
    }

    method play {} {
	set p0 {}
	set p {}
	set top [format "%*s " [string length $s] ""]
	for {set i 1;set j 97} {$i<=$s} {incr i;incr j} {
	    append top [format %c $j]
	    lappend p [format "%*d " [string length $s] $i]
	    lappend p0 [format "%*s " [string length $s] ""]
	}

	set moves 0
	puts "You are trying to get to:\n[my Render $target $p0]\n"
	while true {
	    puts "Current configuration (#$moves):\n$top\n[my Render $board $p]"

	    # Test for if we've won
	    if {$board eq $target} break

	    # Ask the user for a move
	    set i [my GetInput "Pick a column (letter) or row (number) to flip"]

	    # Parse the move and apply it
	    if {[string is lower -strict $i] && [set c [expr {[scan $i "%c"] - 97}]]<$s} {
		my SwapColumn $c
		incr moves
	    } elseif {[string is integer -strict $i] && $i>0 && $i<=$s} {
		my SwapRow [expr {$i - 1}]
		incr moves
	    } else {
		puts "Error: bad selection"
	    }
	    puts ""
	}
	puts "\nYou win! (You took $moves moves.)"
    }
}

Flip create flip 3
flip play


import "random" for Random
import "/ioutil" for Input
import "/str" for Str

var rand = Random.new()
var target = List.filled(3, null)
var board  = List.filled(3, null)
for (i in 0..2) {
    target[i] = List.filled(3, 0)
    board[i]  = List.filled(3, 0)
    for (j in 0..2) target[i][j] = rand.int(2)
}

var flipRow = Fn.new { |r|
    for (c in 0..2) board[r][c] = (board[r][c] == 0) ? 1 : 0
}

var flipCol = Fn.new { |c|
    for (r in 0..2) board[r][c] = (board[r][c] == 0) ? 1 : 0
}

/* starting from the target we make 9 random row or column flips */
var initBoard = Fn.new {
    for (i in 0..2) {
        for (j in 0..2) board[i][j] = target[i][j]
    }
    for (i in 1..9) {
        var rc = rand.int(2)
        if (rc == 0) {
            flipRow.call(rand.int(3))
        } else {
            flipCol.call(rand.int(3))
        }
    }
}

var printBoard = Fn.new { |label, isTarget|
    var a = (isTarget) ? target : board
    System.print("%(label):")
    System.print("  | a b c")
    System.print("---------")
    for (r in 0..2) {
        System.write("%(r + 1) |")
        for (c in 0..2) System.write(" %(a[r][c])")
        System.print()
    }
    System.print()
}

var gameOver = Fn.new {
    for (r in 0..2) {
        for (c in 0..2) if (board[r][c] != target[r][c]) return false
    }
    return true
}

// initialize board and ensure it differs from the target i.e. game not already over!
while (true) {
    initBoard.call()
    if (!gameOver.call()) break
}

printBoard.call("TARGET", true)
printBoard.call("OPENING BOARD", false)
var flips = 0

while (true) {
    var isRow = true
    var n = -1
    var prompt = "Enter row number or column letter to be flipped: "
    var ch = Str.lower(Input.option(prompt, "123abcABC"))
    if (ch == "1" || ch == "2" || ch == "3") {
        n = ch.bytes[0] - 49
    } else {
        isRow = false
        n = ch.bytes[0] - 97
    }
    flips = flips + 1
    if (isRow) flipRow.call(n) else flipCol.call(n)
    var plural = (flips == 1) ? "" : "S"
    printBoard.call("\nBOARD AFTER %(flips) FLIP%(plural)", false)
    if (gameOver.call()) break
}

var plural = (flips == 1) ? "" : "s"
System.print("You've succeeded in %(flips) flip%(plural)")


V (x, xi, y, yi) = (2.0, 0.5, 4.0, 0.25)
V z = x + y
V zi = 1.0 / (x + y)
V multiplier = (n1, n2) -> (m -> @=n1 * @=n2 * m)
V numlist = [x, y, z]
V numlisti = [xi, yi, zi]
print(zip(numlist, numlisti).map((n, inversen) -> multiplier(inversen, n)(.5)))


with Ada.Text_IO;
procedure Firstclass is
   generic
      n1, n2 : Float;
   function Multiplier (m : Float) return Float;
   function Multiplier (m : Float) return Float is
   begin
      return n1 * n2 * m;
   end Multiplier;

   num, inv : array (1 .. 3) of Float;
begin
   num := (2.0, 4.0, 6.0);
   inv := (1.0/2.0, 1.0/4.0, 1.0/6.0);
   for i in num'Range loop
      declare
         function new_function is new Multiplier (num (i), inv (i));
      begin
         Ada.Text_IO.Put_Line (Float'Image (new_function (0.5)));
      end;
   end loop;
end Firstclass;


REAL
  x  := 2,
  xi := 0.5,
  y  := 4,
  yi := 0.25,
  z  := x + y,
  zi := 1 / ( x + y );

MODE F = PROC(REAL)REAL;

PROC multiplier = (REAL n1, n2)F: ((REAL m)REAL: n1 * n2 * m);

# Numbers as members of collections #
[]REAL num list = (x, y, z),
       inv num list = (xi, yi, zi);

# Apply numbers from list #
FOR key TO UPB num list DO
  REAL n = num list[key],
       inv n = inv num list[key];
  print ((multiplier(inv n, n)(.5), new line))
OD


(x,xi,y,yi) := (2.0,0.5,4.0,0.25)
(z,zi) := (x+y,1/(x+y))
(numbers,invers) := ([x,y,z],[xi,yi,zi])
multiplier(a:Float,b:Float):(Float->Float) == (m +-> a*b*m)
[multiplier(number,inver) 0.5 for number in numbers for inver in invers]


      REM Create some numeric variables:
      x = 2 : xi = 1/2
      y = 4 : yi = 0.25
      z = x + y : zi = 1 / (x + y)

      REM Create the collections (here structures are used):
      DIM c{x, y, z}
      DIM ci{x, y, z}
      c.x = x : c.y = y : c.z = z
      ci.x = xi : ci.y = yi : ci.z = zi

      REM Create some multiplier functions:
      multx = FNmultiplier(c.x, ci.x)
      multy = FNmultiplier(c.y, ci.y)
      multz = FNmultiplier(c.z, ci.z)

      REM Test applying the compositions:
      x = 1.234567 : PRINT x " ", FN(multx)(x)
      x = 2.345678 : PRINT x " ", FN(multy)(x)
      x = 3.456789 : PRINT x " ", FN(multz)(x)
      END

      DEF FNmultiplier(n1,n2)
      LOCAL f$, p%
      f$ = "(m)=" + STR$n1 + "*" + STR$n2 + "*m"
      DIM p% LEN(f$) + 4
      $(p%+4) = f$ : !p% = p%+4
      = p%


using System;
using System.Linq;

class Program
{
    static void Main(string[] args)
    {
        double x, xi, y, yi, z, zi;
        x = 2.0;
        xi = 0.5;
        y = 4.0;
        yi = 0.25;
        z = x + y;
        zi = 1.0 / (x + y);

        var numlist = new[] { x, y, z };
        var numlisti = new[] { xi, yi, zi };
        var multiplied = numlist.Zip(numlisti, (n1, n2) =>
                       {
                           Func<double, double> multiplier = m => n1 * n2 * m;
                           return multiplier;
                       });

        foreach (var multiplier in multiplied)
            Console.WriteLine(multiplier(0.5));
    }
}


#include <array>
#include <iostream>

int main()
{
  double x  = 2.0;
  double xi = 0.5;
  double y  = 4.0;
  double yi = 0.25;
  double z  = x + y;
  double zi = 1.0 / ( x + y );

  const std::array values{x, y, z};
  const std::array inverses{xi, yi, zi};

  auto multiplier = [](double a, double b)
  {
    return [=](double m){return a * b * m;};
  };

  for(size_t i = 0; i < values.size(); ++i)
  {
    auto new_function = multiplier(values[i], inverses[i]);
    double value = new_function(i + 1.0);
    std::cout << value << "\n";
  }
}


(def x  2.0)
(def xi 0.5)
(def y  4.0)
(def yi 0.25)
(def z  (+ x y))
(def zi (/ 1.0 (+ x y)))

(def numbers [x y z])
(def invers  [xi yi zi])

(defn multiplier [a b]
      (fn [m] (* a b m)))

> (for [[n i] (zipmap numbers invers)]
       ((multiplier n i) 0.5))
(0.5 0.5 0.5)


(defun multiplier (f g)
  #'(lambda (x) (* f g x)))

(let* ((x 2.0)
       (xi 0.5)
       (y 4.0)
       (yi 0.25)
       (z (+ x y))
       (zi (/ 1.0 (+ x y)))
       (numbers (list x y z))
       (inverses (list xi yi zi)))
  (loop with value = 0.5
        for number in numbers
        for inverse in inverses
        for multiplier = (multiplier number inverse)
        do (format t "~&(~A * ~A)(~A) = ~A~%"
                   number
                   inverse
                   value
                   (funcall multiplier value))))


import std.stdio;

auto multiplier(double a, double b)
{
    return (double c) => a * b * c;
}

void main()
{
    double x = 2.0;
    double xi = 0.5;
    double y = 4.0;
    double yi = 0.25;
    double z = x + y;
    double zi = 1.0 / (z);

    double[3] f = [x, y, z];
    double[3] r = [xi, yi, zi];

    foreach (i; 0..3)
    {
        auto mult = multiplier(f[i], r[i]);
        writefln("%f * %f * %f == %f", f[i], r[i], 1.0, mult(1));
    }
}


def x := 2.0
def xi := 0.5
def y := 4.0
def yi := 0.25
def z := x + y
def zi := 1.0 / (x + y)
def forward := [x,  y,  z ]
def reverse := [xi, yi, zi]

def multiplier(a, b) {
    return fn x { a * b * x }
}

def s := 0.5
for i => a in forward {
    def b := reverse[i]
    println(`s = $s, a = $a, b = $b, multiplier($a, $b)($s) = ${multiplier(a, b)(s)}`)
}


import system'routines;
import extensions;

public program()
{
    real x := 2.0r;
    real xi := 0.5r;
    real y := 4.0r;
    real yi := 0.25r;
    real z := x + y;
    real zi := 1.0r / (x + y);

    var numlist := new real[]{  x, y, z };
    var numlisti := new real[]{ xi, yi, zi };

    var multiplied := numlist.zipBy(numlisti, (n1,n2 => (m => n1 * n2 * m) )).toArray();

    multiplied.forEach:(multiplier){ console.printLine(multiplier(0.5r)) }
}


-module( first_class_functions_use_numbers ).

-export( [task/0] ).

task() ->
	X = 2.0, Xi = 0.5, Y = 4.0, Yi = 0.25, Z = X + Y, Zi = 1.0 / (X + Y),
	As = [X, Y, Z],
	Bs = [Xi, Yi, Zi],
	[io:fwrite( "Value: 2.5 Result: ~p~n", [(multiplier(A, B))(2.5)]) || {A, B} <- lists:zip(As, Bs)].

multiplier( N1, N2 ) -> fun(M) -> N1 * N2 * M end.


let x = 2.0
let xi = 0.5
let y = 4.0
let yi = 0.25
let z = x + y
let zi = 1.0 / ( x + y )
let multiplier (n1,n2) = fun (m:float) -> n1 * n2 * m

[x; y; z]
|> List.zip [xi; yi; zi]
|> List.map multiplier
|> List.map ((|>) 0.5)
|> printfn "%A"


USING: arrays kernel literals math prettyprint sequences ;
IN: q

CONSTANT: x  2.0
CONSTANT: xi 0.5
CONSTANT: y  4.0
CONSTANT: yi .25
CONSTANT: z $[ $ x $ y + ]
CONSTANT: zi $[ 1 $ x $ y + / ]

CONSTANT: A ${ x y z }
CONSTANT: B ${ xi yi zi }

: multiplier ( n1 n2 -- q ) [ * * ] 2curry ;
: create-all ( seq1 seq2 -- seq ) [ multiplier ] 2map ;
: example  ( -- )
  0.5 A B create-all
  [ call( x -- y ) ] with map . ;


class Main
{
  static |Float -> Float| combine (Float n1, Float n2)
  {
    return |Float m -> Float| { n1 * n2 * m }
  }

  public static Void main ()
  {
    Float x := 2f
    Float xi := 0.5f
    Float y := 4f
    Float yi := 0.25f
    Float z := x + y
    Float zi := 1 / (x + y)
    echo (combine(x, xi)(0.5f))
    echo (combine(y, yi)(0.5f))
    echo (combine(z, zi)(0.5f))
  }
}


package main

import "fmt"

func main() {
    x := 2.
    xi := .5
    y := 4.
    yi := .25
    z := x + y
    zi := 1 / (x + y)
    // point A

    numbers := []float64{x, y, z}
    inverses := []float64{xi, yi, zi}
    // point B

    mfs := make([]func(float64) float64, len(numbers))
    for i := range mfs {
        mfs[i] = multiplier(numbers[i], inverses[i])
    }
    // point C

    for _, mf := range mfs {
        fmt.Println(mf(1))
    }
}

func multiplier(n1, n2 float64) func(float64) float64 {
    // compute product of n's, store in a new variable
    n1n2 := n1 * n2
    // close on variable containing product
    return func(m float64) float64 {
        return n1n2 * m
    }
}


def multiplier = { n1, n2 -> { m -> n1 * n2 * m } }

def ε = 0.00000001  // tolerance(epsilon): acceptable level of "wrongness" to account for rounding error
[(2.0):0.5, (4.0):0.25, (6.0):(1/6.0)].each { num, inv ->
    def new_function = multiplier(num, inv)
    (1.0..5.0).each { trial ->
        assert (new_function(trial) - trial).abs() < ε
        printf('%5.3f * %5.3f * %5.3f == %5.3f\n', num, inv, trial, trial)
    }
    println()
}


module Main
  where

import Text.Printf

-- Pseudo code happens to be valid Haskell
x  = 2.0
xi = 0.5
y  = 4.0
yi = 0.25
z  = x + y
zi = 1.0 / ( x + y )

-- Multiplier function
multiplier :: Double -> Double -> Double -> Double
multiplier a b = \m -> a * b * m

main :: IO ()
main = do
  let
    numbers = [x, y, z]
    inverses = [xi, yi, zi]
    pairs = zip numbers inverses
    print_pair (number, inverse) =
      let new_function = multiplier number inverse
      in printf "%f * %f * 0.5 = %f\n" number inverse (new_function 0.5)
  mapM_ print_pair pairs


import Utils

procedure main(A)
    mult := multiplier(get(A),get(A))   # first 2 args define function
    every write(mult(!A))     # remaining are passed to new function
end

procedure multiplier(n1,n2)
    return makeProc { repeat inVal := n1 * n2 * (inVal@&source)[1] }
end


   x          =:  2.0
   xi         =:  0.5
   y          =:  4.0
   yi         =:  0.25
   z          =:  x + y
   zi         =:  1.0 % (x + y)  NB. / is spelled % in J

   fwd        =:  x ,y ,z
   rev        =:  xi,yi,zi

   multiplier =:  2 : 'm * n * ]'


# Infrastructure:
# zip this and that
def zip(that):
  . as $this | reduce range(0;length) as $i ([]; . + [ [$this[$i], that[$i]] ]);

# The task:
def x:  2.0;
def xi: 0.5;
def y:  4.0;
def yi: 0.25;
def z:  x + y;
def zi: 1.0 / (x + y);

def numlist: [x,y,z];

def invlist: [xi, yi, zi];

# Input: [x,y]
def multiplier(j): .[0] * .[1] * j;

numlist|zip(invlist) | map( multiplier(0.5) )


const x = 2.0;
const xi = 0.5;
const y = 4.0;
const yi = 0.25;
const z = x + y;
const zi = 1.0 / (x + y);
const pairs = [[x, xi], [y, yi], [z, zi]];
const testVal = 0.5;

const multiplier = (a, b) => m => a * b * m;

const test = () => {
  return pairs.map(([a, b]) => {
    const f = multiplier(a, b);
    const result = f(testVal);
    return `${a} * ${b} * ${testVal} = ${result}`;
  });
}

test().join('\n');


x, xi  = 2.0, 0.5
y, yi  = 4.0, 0.25
z, zi  = x + y, 1.0 / ( x + y )

multiplier = (n1, n2) -> (m) -> n1 * n2 * m

numlist  = [x ,  y,  z]
numlisti = [xi, yi, zi]

@show collect(multiplier(n, invn)(0.5) for (n, invn) in zip(numlist, numlisti))


// version 1.1.2

fun multiplier(n1: Double, n2: Double) = { m: Double -> n1 * n2 * m}

fun main(args: Array<String>) {
    val x  = 2.0
    val xi = 0.5
    val y  = 4.0
    val yi = 0.25
    val z  = x + y
    val zi = 1.0 / ( x + y)
    val a  = doubleArrayOf(x, y, z)
    val ai = doubleArrayOf(xi, yi, zi)
    val m  = 0.5
    for (i in 0 until a.size) {
        println("${multiplier(a[i], ai[i])(m)} = multiplier(${a[i]}, ${ai[i]})($m)")
    }
}


-- This function returns another function that
-- keeps n1 and n2 in scope, ie. a closure.
function multiplier (n1, n2)
    return  function (m)
                return n1 * n2 * m
            end
end

-- Multiple assignment a-go-go
local x, xi, y, yi  = 2.0, 0.5, 4.0, 0.25
local z, zi = x + y, 1.0 / ( x + y )
local nums, invs = {x, y, z}, {xi, yi, zi}

-- 'new_function' stores the closure and then has the 0.5 applied to it
-- (this 0.5 isn't in the task description but everyone else used it)
for k, v in pairs(nums) do
    new_function = multiplier(v, invs[k])
    print(v .. " * " .. invs[k] .. " * 0.5 = " .. new_function(0.5))
end


Module CheckIt {
      \\ by default numbers are double
      x  = 2
      xi = 0.5
      y  = 4
      yi = 0.25
      z  = x + y
      zi = 1 / ( x + y )
      Composed=lambda (a, b)-> {
            =lambda a,b (n)->{
                  =a*b*n
            }
       }
      numbers=(x,y,z)
      inverses=(xi,yi,zi)
      Dim Base 0, combo(3)
      combo(0)=Composed(x,xi), Composed(y,yi), Composed(z,zi)
      num=each(numbers)
      inv=each(inverses)
      fun=each(combo())
      While num, inv, fun {
         Print $("0.00"), Array(num);" * ";Array(inv);" * 0.50 = "; combo(fun^)(0.5),$("")
         Print
      }
}
Checkit
\\ for functions  we have this definition
Composed=lambda (f1, f2) -> {
      =lambda f1, f2 (x)->{
            =f1(f2(x))
      }
}


multiplier[n1_,n2_]:=n1 n2 #&
num={2,4,2+4};
numi=1/num;
multiplierfuncs = multiplier @@@ Transpose[{num, numi}];


using System;
using System.Console;
using Nemerle.Collections.NCollectionsExtensions;

module FirstClassNums
{
    Main() : void
    {
        def x = 2.0;   def xi = 0.5;
        def y = 4.0;   def yi = 0.25;
        def z = x + y; def zi = 1.0 / (x + y);
        def multiplier = fun (a, b) {fun (c) {a * b * c}};
        def nums = [x, y, z];
        def inums = [xi, yi, zi];
        WriteLine($[multiplier(n, m) (0.5)|(n, m) in ZipLazy(nums, inums)]);
    }
}


func multiplier(a : float, b : float) -> (float) -> float {
    let func(m : float) -> float { a * b * m }
}

func main() -> int {
    var x = 2.0;
    var xi = 0.5;
    var y = 4.0;
    var yi = 0.25;
    var z = x + y;
    var zi = 1.0 / z;

    var f = [ x, y, z ] : float;
    var i = [ xi, yi, zi ] : float;
    var c = 0;
    var mult = let func(m : float) -> float { 0.0 };

    for (c = 0; c < 3; c = c + 1) {
        mult = multiplier(f[c], i[c]);
        prints(f[c] + " * " + i[c] + " * " + 1.0 + " = " + mult(1) + "\n")
    };

    0
}


func multiplier(a, b: float): auto =
  let ab = a * b
  result = func(c: float): float = ab * c

let
  x = 2.0
  xi = 0.5
  y  = 4.0
  yi = 0.25
  z  = x + y
  zi = 1.0 / ( x + y )

let list = [x, y, z]
let invlist = [xi, yi, zi]

for i in 0..list.high:
  # Create a multiplier function...
  let f = multiplier(list[i], invlist[i])
  # ... and apply it.
  echo f(0.5)


use Collection.Generic;

class FirstClass {
  function : Main(args : String[]) ~ Nil {
    x := 2.0;
    xi := 0.5;
    y := 4.0;
    yi := 0.25;
    z := x + y;
    zi := 1.0 / (x + y);

    numlist := CompareVector->New()<FloatHolder>;
    numlist->AddBack(x); numlist->AddBack(y); numlist->AddBack(z);

    numlisti := Vector->New()<FloatHolder>;
    numlisti->AddBack(xi); numlisti->AddBack(yi); numlisti->AddBack(zi);

    each(i : numlist) {
      v := numlist->Get(i); vi := numlisti->Get(i);
      mult := Multiplier(v, vi);
      r := mult(0.5);
      "{$v} * {$vi} * 0.5 = {$r}"->PrintLine();
    };
  }

  function : Multiplier(a : FloatHolder, b : FloatHolder) ~ (FloatHolder) ~ FloatHolder {
    return \(FloatHolder) ~ FloatHolder : (c) =>  a * b * c;
  }
}


# let x = 2.0;;

# let y = 4.0;;

# let z = x +. y;;

# let coll = [ x; y; z];;

# let inv_coll = List.map (fun x -> 1.0 /. x) coll;;

# let multiplier n1 n2 = (fun t -> n1 *. n2 *. t);;

(* create a list of new functions *)
# let func_list = List.map2 (fun n inv -> (multiplier n inv)) coll inv_coll;;

# List.map (fun f -> f 0.5) func_list;;
- : float list = [0.5; 0.5; 0.5]

(* or just apply the generated function immediately... *)
# List.map2 (fun n inv -> (multiplier n inv) 0.5) coll inv_coll;;
- : float list = [0.5; 0.5; 0.5]


: multiplier(n1, n2)  #[ n1 n2 * * ] ;

: firstClassNum
| x xi y yi z zi |
   2.0 ->x
   0.5 ->xi
   4.0 ->y
   0.25 ->yi
   x y + ->z
   x y + inv ->zi
   [ x, y, z ] [ xi, yi, zi ] zipWith(#multiplier) map(#[ 0.5 swap perform ] ) . ;


declare

  [X Y Z] = [2.0  4.0  Z=X+Y]
  [XI YI ZI] = [0.5  0.25  1.0/(X+Y)]

  fun {Multiplier A B}
     fun {$ M}
        A * B * M
     end
  end

in

  for
     N in [X  Y  Z]
     I in [XI YI ZI]
  do
     {Show {{Multiplier N I} 0.5}}
  end


multiplier(n1,n2)={
  x -> n1 * n2 * x
};

test()={
  my(x = 2.0, xi = 0.5, y = 4.0, yi = 0.25, z = x + y, zi = 1.0 / ( x + y ));
  print(multiplier(x,xi)(0.5));
  print(multiplier(y,yi)(0.5));
  print(multiplier(z,zi)(0.5));
};


sub multiplier {
    my ( $n1, $n2 ) = @_;
    sub {
        $n1 * $n2 * $_[0];
    };
}

my $x  = 2.0;
my $xi = 0.5;
my $y  = 4.0;
my $yi = 0.25;
my $z  = $x + $y;
my $zi = 1.0 / ( $x + $y );

my %zip;
@zip{ $x, $y, $z } = ( $xi, $yi, $zi );

while ( my ( $number, $inverse ) = each %zip ) {
    print multiplier( $number, $inverse )->(0.5), "\n";
}


with javascript_semantics
sequence mtable = {}

function multiplier(atom n1, atom n2)
    mtable = append(mtable,{n1,n2})
    return length(mtable)
end function

function call_multiplier(integer f, atom m)
atom {n1,n2} = mtable[f]
    return n1*n2*m
end function

constant x = 2,
         xi = 0.5,
         y  = 4,
         yi = 0.25,
         z  = x + y,
         zi = 1 / ( x + y )

?call_multiplier(multiplier(x,xi),0.5)
?call_multiplier(multiplier(y,yi),0.5)
?call_multiplier(multiplier(z,zi),0.5)


(load "@lib/math.l")

(de multiplier (N1 N2)
   (curry (N1 N2) (X)
      (*/ N1 N2 X `(* 1.0 1.0)) ) )

(let (X 2.0  Xi 0.5  Y 4.0  Yi 0.25  Z (+ X Y)  Zi (*/ 1.0 1.0 Z))
   (mapc
      '((Num Inv)
         (prinl (format ((multiplier Inv Num) 0.5) *Scl)) )
      (list X Y Z)
      (list Xi Yi Zi) ) )


IDLE 2.6.1
>>> # Number literals
>>> x,xi, y,yi = 2.0,0.5, 4.0,0.25
>>> # Numbers from calculation
>>> z  = x + y
>>> zi = 1.0 / (x + y)
>>> # The multiplier function is similar to 'compose' but with numbers
>>> multiplier = lambda n1, n2: (lambda m: n1 * n2 * m)
>>> # Numbers as members of collections
>>> numlist = [x, y, z]
>>> numlisti = [xi, yi, zi]
>>> # Apply numbers from list
>>> [multiplier(inversen, n)(.5) for n, inversen in zip(numlist, numlisti)]
[0.5, 0.5, 0.5]
>>>


multiplier <- function(n1,n2) { (function(m){n1*n2*m}) }
x  = 2.0
xi = 0.5
y  = 4.0
yi = 0.25
z  = x + y
zi = 1.0 / ( x + y )
num = c(x,y,z)
inv = c(xi,yi,zi)

multiplier(num,inv)(0.5)

Output
[1] 0.5 0.5 0.5


#lang racket

(define x  2.0)
(define xi 0.5)
(define y  4.0)
(define yi 0.25)
(define z  (+ x y))
(define zi (/ 1.0 (+ x y)))

(define ((multiplier x y) z) (* x y z))

(define numbers  (list x  y  z))
(define inverses (list xi yi zi))

(for/list ([n numbers] [i inverses])
  ((multiplier n i) 0.5))
;; -> '(0.5 0.5 0.5)


sub multiplied ($g, $f) { return { $g * $f * $^x } }

my $x  = 2.0;
my $xi = 0.5;
my $y  = 4.0;
my $yi = 0.25;
my $z  = $x + $y;
my $zi = 1.0 / ( $x + $y );

my @numbers = $x, $y, $z;
my @inverses = $xi, $yi, $zi;

for flat @numbers Z @inverses { say multiplied($^g, $^f)(.5) }


/*REXX program to use a  first-class function  to  use numbers analogously.             */
nums=   2.0     4.0      6.0                     /*various numbers,  can have fractions.*/
invs= 1/2.0   1/4.0    1/6.0                     /*inverses of the above (real) numbers.*/
   m=   0.5                                      /*multiplier when invoking new function*/
             do j=1  for words(nums);   num= word(nums, j);  inv= word(invs, j)
             nf= multiplier(num, inv);  interpret call nf m       /*sets the var RESULT.*/
             say 'number=' @(num)    'inverse=' @(inv)    'm=' @(m)    'result=' @(result)
             end   /*j*/
exit                                             /*stick a fork in it,  we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
@:          return left( arg(1) / 1, 15)         /*format the number,  left justified.  */
multiplier: procedure expose n1n2; parse arg n1,n2;   n1n2= n1 * n2;   return 'a_new_func'
a_new_func: return n1n2 * arg(1)


multiplier = proc {|n1, n2| proc {|m| n1 * n2 * m}}
numlist = [x=2, y=4, x+y]
invlist = [0.5, 0.25, 1.0/(x+y)]
p numlist.zip(invlist).map {|n, invn| multiplier[invn, n][0.5]}
# => [0.5, 0.5, 0.5]


#![feature(conservative_impl_trait)]
fn main() {
    let (x, xi) = (2.0, 0.5);
    let (y, yi) = (4.0, 0.25);
    let z = x + y;
    let zi = 1.0/z;

    let numlist = [x,y,z];
    let invlist = [xi,yi,zi];

    let result = numlist.iter()
                        .zip(&invlist)
                        .map(|(x,y)| multiplier(*x,*y)(0.5))
                        .collect::<Vec<_>>();
    println!("{:?}", result);
}

fn multiplier(x: f64, y: f64) -> impl Fn(f64) -> f64 {
    move |m| x*y*m
}


scala> val x = 2.0
x: Double = 2.0

scala> val xi = 0.5
xi: Double = 0.5

scala> val y = 4.0
y: Double = 4.0

scala> val yi = 0.25
yi: Double = 0.25

scala> val z = x + y
z: Double = 6.0

scala> val zi = 1.0 / ( x + y )
zi: Double = 0.16666666666666666

scala> val numbers = List(x, y, z)
numbers: List[Double] = List(2.0, 4.0, 6.0)

scala> val inverses = List(xi, yi, zi)
inverses: List[Double] = List(0.5, 0.25, 0.16666666666666666)

scala> def multiplier = (n1: Double, n2: Double) => (m: Double) => n1 * n2 * m
multiplier: (Double, Double) => (Double) => Double

scala> def comp = numbers zip inverses map multiplier.tupled
comp: List[(Double) => Double]

scala> comp.foreach(f=>println(f(0.5)))
0.5
0.5
0.5


(define x  2.0)
(define xi 0.5)
(define y  4.0)
(define yi 0.25)
(define z  (+ x y))
(define zi (/ (+ x y)))

(define number (list x y z))
(define inverse (list xi yi zi))

(define (multiplier n1 n2) (lambda (m) (* n1 n2 m)))

(define m 0.5)
(define (go n1 n2)
  (for-each (lambda (n1 n2)
              (display ((multiplier n1 n2) m))
              (newline))
            n1 n2))
(go number inverse)


func multiplier(n1, n2) {
    func (n3) {
        n1 * n2 * n3
    }
}

var x  = 2.0
var xi = 0.5
var y  = 4.0
var yi = 0.25
var z  = (x + y)
var zi = (1 / (x + y))

var numbers = [x, y, z]
var inverses = [xi, yi, zi]

for f,g (numbers ~Z inverses) {
    say multiplier(f, g)(0.5)
}


define: #multiplier -> [| :n1 :n2 | [| :m | n1 * n2 * m]].
define: #x -> 2.
define: #y -> 4.
define: #numlist -> {x. y. x + y}.
define: #numlisti -> (numlist collect: [| :x | 1.0 / x]).

numlist with: numlisti collect: [| :n1 :n2 | (multiplier applyTo: {n1. n2}) applyWith: 0.5].


package require Tcl 8.5
proc multiplier {a b} {
    list apply {{ab m} {expr {$ab*$m}}} [expr {$a*$b}]
}


#import std
#import flo

numbers  = <2.,4.,plus(2.,4.)>
inverses = <0.5,0.25,div(1.,plus(2.,4.))>

multiplier = //times+ times

#cast %eL

main = (gang multiplier*p\numbers inverses) 0.5


import "/fmt" for Fmt

var multiplier = Fn.new { |n1, n2| Fn.new { |m| n1 * n2 * m } }

var orderedCollection = Fn.new {
    var x  = 2.0
    var xi = 0.5
    var y  = 4.0
    var yi = 0.25
    var z  = x + y
    var zi = 1.0 / ( x + y )
    return [[x, y, z], [xi, yi, zi]]
}

var oc = orderedCollection.call()
for (i in 0..2) {
    var x = oc[0][i]
    var y = oc[1][i]
    var m = 0.5 // rather than 1 to compare with first-class functions task
    Fmt.print("$0.1g * $g * $0.1g = $0.1g", x, y, m, multiplier.call(x, y).call(m))
}


F p(=l, n, pwr = 2)
   l = Int(abs(l))
   V digitcount = floor(log(l, 10))
   V log10pwr = log(pwr, 10)
   V (raised, found) = (-1, 0)
   L found < n
      raised++
      V firstdigits = floor(10 ^ (fract(log10pwr * raised) + digitcount))
      I firstdigits == l
         found++
   R raised

L(l, n) [(12, 1), (12, 2), (123, 45), (123, 12345), (123, 678910)]
   print(‘p(’l‘, ’n‘) = ’p(l, n))


# find values of p( L, n ) where p( L, n ) is the nth-smallest j such that          #
#      the decimal representation of 2^j starts with the digits of L                #
BEGIN
    # returns a string representation of n with commas                              #
    PROC commatise = ( LONG INT n )STRING:
         BEGIN
            STRING result      := "";
            STRING unformatted  = whole( n, 0 );
            INT    ch count    := 0;
            FOR c FROM UPB unformatted BY -1 TO LWB unformatted DO
                IF   ch count <= 2 THEN ch count +:= 1
                ELSE                    ch count  := 1; "," +=: result
                FI;
                unformatted[ c ] +=: result
            OD;
            result
         END # commatise # ;
    # returns p( prefix, occurance )                                                 #
    PROC p = ( INT prefix, INT occurance )LONG INT:
    BEGIN
        LONG INT quarter long max int = long max int OVER 4;
        LONG INT p2                  := 1;
        INT      count               := 0;
        INT      power               := 0;
        WHILE count < occurance DO
            power       +:= 1;
            p2          +:= p2;
            LONG INT pre := p2;
            WHILE pre > prefix DO
                pre OVERAB 10
            OD;
            IF pre = prefix THEN
                count +:= 1
            FI;
            IF p2 > quarter long max int THEN
                p2 OVERAB 10 000
            FI
        OD;
        power
    END # p # ;
    # prints p( prefix, occurance )                                                 #
    PROC print p = ( INT prefix, INT occurance )VOID:
        print( ( "p(", whole( prefix, 0 ), ", ", whole( occurance, 0 ), ") = ", commatise( p( prefix, occurance ) ), newline ) );
    # task test cases                                                               #
    print p(  12,      1 );
    print p(  12,      2 );
    print p( 123,     45 );
    print p( 123,  12345 );
    print p( 123, 678910 )
END


global FAC
FAC = 0.30102999566398119521373889472449302677

print p(12, 1)
print p(12, 2)
print p(123, 45)
print p(123, 12345)
print p(123, 678910)
end

function p(L, n)
    cont = 0 : j = 0
    LS = string(L)
    while cont < n
        j += 1
        x = FAC * j
        if x < length(LS) then continue while
        y = 10^(x-int(x))
        y *= 10^length(LS)
        digits = string(y)
        if left(digits,length(LS)) = LS then cont += 1
    end while
    return j
end function


#include <math.h>
#include <stdio.h>

int p(int l, int n) {
    int test = 0;
    double logv = log(2.0) / log(10.0);
    int factor = 1;
    int loop = l;
    while (loop > 10) {
        factor *= 10;
        loop /= 10;
    }
    while (n > 0) {
        int val;

        test++;
        val = (int)(factor * pow(10.0, fmod(test * logv, 1)));
        if (val == l) {
            n--;
        }
    }
    return test;
}

void runTest(int l, int n) {
    printf("p(%d, %d) = %d\n", l, n, p(l, n));
}

int main() {
    runTest(12, 1);
    runTest(12, 2);
    runTest(123, 45);
    runTest(123, 12345);
    runTest(123, 678910);

    return 0;
}


// a mini chrestomathy solution

#include <string>
#include <chrono>
#include <cmath>
#include <locale>

using namespace std;
using namespace chrono;

// translated from java example
unsigned int js(int l, int n) {
  unsigned int res = 0, f = 1;
  double lf = log(2) / log(10), ip;
  for (int i = l; i > 10; i /= 10) f *= 10;
  while (n > 0)
    if ((int)(f * pow(10, modf(++res * lf, &ip))) == l) n--;
  return res;
}

// translated from go integer example (a.k.a. go translation of pascal alternative example)
unsigned int gi(int ld, int n) {
  string Ls = to_string(ld);
  unsigned int res = 0, count = 0; unsigned long long f = 1;
  for (int i = 1; i <= 18 - Ls.length(); i++) f *= 10;
  const unsigned long long ten18 = 1e18; unsigned long long probe = 1;
  do {
    probe <<= 1; res++; if (probe >= ten18) {
      do {
        if (probe >= ten18) probe /= 10;
        if (probe / f == ld) if (++count >= n) { count--; break; }
        probe <<= 1; res++;
      } while (1);
    }
    string ps = to_string(probe);
    if (ps.substr(0, min(Ls.length(), ps.length())) == Ls) if (++count >= n) break;
  } while (1);
  return res;
}

// translated from pascal alternative example
unsigned int pa(int ld, int n) {
  const double L_float64 = pow(2, 64);
  const unsigned long long Log10_2_64 = (unsigned long long)(L_float64 * log(2) / log(10));
  double Log10Num; unsigned long long LmtUpper, LmtLower, Frac64;
  int res = 0, dgts = 1, cnt;
  for (int i = ld; i >= 10; i /= 10) dgts *= 10;
  Log10Num = log((ld + 1.0) / dgts) / log(10);
  // '316' was a limit
  if (Log10Num >= 0.5) {
    LmtUpper = (ld + 1.0) / dgts < 10.0 ? (unsigned long long)(Log10Num * (L_float64 * 0.5)) * 2 + (unsigned long long)(Log10Num * 2) : 0;
    Log10Num = log((double)ld / dgts) / log(10);
    LmtLower = (unsigned long long)(Log10Num * (L_float64 * 0.5)) * 2 + (unsigned long long)(Log10Num * 2);
  } else {
    LmtUpper = (unsigned long long)(Log10Num * L_float64);
    LmtLower = (unsigned long long)(log((double)ld / dgts) / log(10) * L_float64);
  }
  cnt = 0; Frac64 = 0; if (LmtUpper != 0) {
    do {
      res++; Frac64 += Log10_2_64;
      if ((Frac64 >= LmtLower) & (Frac64 < LmtUpper))
        if (++cnt >= n) break;
    } while (1);
  } else { // '999..'
    do {
      res++; Frac64 += Log10_2_64;
      if (Frac64 >= LmtLower) if (++cnt >= n) break;
    } while (1);
  };
  return res;
}

int params[] = { 12, 1, 12, 2, 123, 45, 123, 12345, 123, 678910, 99, 1 };

void doOne(string name, unsigned int (*func)(int a, int b)) {
  printf("%s version:\n", name.c_str());
  auto start = steady_clock::now();
  for (int i = 0; i < size(params); i += 2)
    printf("p(%3d, %6d) = %'11u\n", params[i], params[i + 1], func(params[i], params[i + 1]));
  printf("Took %f seconds\n\n", duration<double>(steady_clock::now() - start).count());
}

int main() {
  setlocale(LC_ALL, "");
  doOne("java simple", js);
  doOne("go integer", gi);
  doOne("pascal alternative", pa);
}


// a mini chrestomathy solution

using System;

class Program {

    // translated from java example
    static long js(int l, int n) {
        long res = 0, f = 1;
        double lf = Math.Log10(2);
        for (int i = l; i > 10; i /= 10) f *= 10;
        while (n > 0)
            if ((int)(f * Math.Pow(10, ++res * lf % 1)) == l) n--;
        return res;
    }

    // translated from go integer example (a.k.a. go translation of pascal alternative example)
    static long gi(int ld, int n) {
        string Ls = ld.ToString();
        long res = 0, count = 0, f = 1;
        for (int i = 1; i <= 18 - Ls.Length; i++) f *= 10;
        const long ten18 = (long)1e18; long probe = 1;
        do {
            probe <<= 1; res++; if (probe >= ten18)
                do {
                    if (probe >= ten18) probe /= 10;
                    if (probe / f == ld)
                        if (++count >= n) { count--; break; }
                    probe <<= 1; res++;
                } while (true);
            string ps = probe.ToString();
            if (ps.Substring(0, Math.Min(Ls.Length, ps.Length)) == Ls)
                if (++count >= n) break;
        } while (true);
        return res;
    }

    // translated from pascal alternative example
    static long pa(int ld, int n) {
        double L_float64 = Math.Pow(2, 64);
        ulong Log10_2_64 = (ulong)(L_float64 * Math.Log10(2));
        double Log10Num; ulong LmtUpper, LmtLower, Frac64;
        long res = 0, dgts = 1, cnt;
        for (int i = ld; i >= 10; i /= 10) dgts *= 10;
        Log10Num = Math.Log10((ld + 1.0) / dgts);
        // '316' was a limit
        if (Log10Num >= 0.5) {
            LmtUpper = (ld + 1.0) / dgts < 10.0 ? (ulong)(Log10Num * (L_float64 * 0.5)) * 2 + (ulong)(Log10Num * 2) : 0;
            Log10Num = Math.Log10((double)ld / dgts);
            LmtLower = (ulong)(Log10Num * (L_float64 * 0.5)) * 2 + (ulong)(Log10Num * 2);
        } else {
            LmtUpper = (ulong)(Log10Num * L_float64);
            LmtLower = (ulong)(Math.Log10((double)ld / dgts) * L_float64);
        }
        cnt = 0; Frac64 = 0; if (LmtUpper != 0)
            do {
                res++; Frac64 += Log10_2_64;
                if ((Frac64 >= LmtLower) & (Frac64 < LmtUpper))
                    if (++cnt >= n) break;
            } while (true);
        else // '999..'
            do {
                res++; Frac64 += Log10_2_64;
                if (Frac64 >= LmtLower) if (++cnt >= n) break;
            } while (true);
        return res;
    }

    static int[] values = new int[] { 12, 1, 12, 2, 123, 45, 123, 12345, 123, 678910, 99, 1 };

    static void doOne(string name, Func<int, int, long> fun) {
        Console.WriteLine("{0} version:", name);
        var start = DateTime.Now;
        for (int i = 0; i < values.Length; i += 2)
            Console.WriteLine("p({0,3}, {1,6}) = {2,11:n0}", values[i], values[i + 1], fun(values[i], values[i + 1]));
        Console.WriteLine("Took {0} seconds\n", DateTime.Now - start);
    }

    static void Main() {
        doOne("java simple", js);
        doOne("go integer", gi);
        doOne("pascal alternative", pa);
    }
}


import std.math;
import std.stdio;

int p(int l, int n) {
    int test = 0;
    double logv = log(2.0) / log(10.0);
    int factor = 1;
    int loop = l;
    while (loop > 10) {
        factor *= 10;
        loop /= 10;
    }
    while (n > 0) {
        int val;

        test++;
        val = cast(int)(factor * pow(10.0, fmod(test * logv, 1)));
        if (val == l) {
            n--;
        }
    }
    return test;
}

void runTest(int l, int n) {
    writefln("p(%d, %d) = %d", l, n, p(l, n));
}

void main() {
    runTest(12, 1);
    runTest(12, 2);
    runTest(123, 45);
    runTest(123, 12345);
    runTest(123, 678910);
}


// First power of 2 that has specified leading decimal digits. Nigel Galloway: March 14th., 2021
let fG n g=let fN l=let l=10.0**(l-floor l) in l>=n && l<g in let f=log10 2.0 in seq{1..0x0FFFFFFF}|>Seq.filter(float>>(*)f>>fN)
printfn "p(23,1)->%d"       (int(Seq.item      0 (fG 2.3 2.4)))
printfn "p(99,1)->%d"       (int(Seq.item      0 (fG 9.9 10.0)))
printfn "p(12,1)->%d"       (int(Seq.item      0 (fG 1.2 1.3)))
printfn "p(12,2)->%d"       (int(Seq.item      1 (fG 1.2 1.3)))
printfn "p(123,45)->%d"     (int(Seq.item     44 (fG 1.23 1.24)))
printfn "p(123,12345)->%d"  (int(Seq.item  12344 (fG 1.23 1.24)))
printfn "p(123,678910)->%d" (int(Seq.item 678909 (fG 1.23 1.24)))


USING: formatting fry generalizations kernel literals math
math.functions math.parser sequences tools.time ;

CONSTANT: ld10 $[ 2 log 10 log / ]

: p ( L n -- m )
    swap [ 0 0 ]
    [ '[ over _ >= ] ]
    [ [ log10 >integer 10^ ] keep ] tri*
    '[
        1 + dup ld10 * dup >integer - 10 log * e^ _ * truncate
        _ number= [ [ 1 + ] dip ] when
    ] until nip ;

[
    12 1
    12 2
    123 45
    123 12345
    123 678910
    [ 2dup p "%d %d p = %d\n" printf ] 2 5 mnapply
] time


#define FAC 0.30102999566398119521373889472449302677

function p( L as uinteger, n as uinteger ) as uinteger
    dim as uinteger count, j = 0
    dim as double x, y
    dim as string digits, LS = str(L)
    while count < n
        j+=1
        x = FAC * j
        if x < len(LS) then continue while
        y = 10^(x-int(x))
        y *= 10^len(LS)
        digits  = str(y)
        if left(digits,len(LS)) = LS then count += 1
    wend
    return j
end function

print p(12, 1)
print p(12, 2)
print p(123, 45)
print p(123, 12345)
print p(123, 678910)


package main

import (
    "fmt"
    "math"
    "time"
)

const ld10 = math.Ln2 / math.Ln10

func commatize(n uint64) string {
    s := fmt.Sprintf("%d", n)
    le := len(s)
    for i := le - 3; i >= 1; i -= 3 {
        s = s[0:i] + "," + s[i:]
    }
    return s
}

func p(L, n uint64) uint64 {
    i := L
    digits := uint64(1)
    for i >= 10 {
        digits *= 10
        i /= 10
    }
    count := uint64(0)
    for i = 0; count < n; i++ {
        e := math.Exp(math.Ln10 * math.Mod(float64(i)*ld10, 1))
        if uint64(math.Trunc(e*float64(digits))) == L {
            count++
        }
    }
    return i - 1
}

func main() {
    start := time.Now()
    params := [][2]uint64{{12, 1}, {12, 2}, {123, 45}, {123, 12345}, {123, 678910}}
    for _, param := range params {
        fmt.Printf("p(%d, %d) = %s\n", param[0], param[1], commatize(p(param[0], param[1])))
    }
    fmt.Printf("\nTook %s\n", time.Since(start))
}


import           Control.Monad (guard)
import           Text.Printf   (printf)

p :: Int -> Int -> Int
p l n = calc !! pred n
  where
    digitCount = floor $ logBase 10 (fromIntegral l :: Float)
    log10pwr   = logBase 10 2
    calc = do
      raised <- [-1 ..]
      let firstDigits = floor $ 10 ** (snd (properFraction $ log10pwr * realToFrac raised)
                        + realToFrac digitCount)
      guard (firstDigits == l)
      [raised]

main :: IO ()
main = mapM_ (\(l, n) -> printf "p(%d, %d) = %d\n" l n (p l n))
  [(12, 1), (12, 2), (123, 45), (123, 12345), (123, 678910)]


p=: adverb define
:
 el =. x
 en =. y
 pwr =. m
 el =. <. | el
 digitcount =. <. 10 ^. el
 log10pwr =. 10 ^. pwr
 'raised found' =. _1 0
 while. found < en do.
  raised =. >: raised
  firstdigits =. (<.!.0) 10^digitcount + 1 | log10pwr * raised
  found =. found + firstdigits = el
 end.
 raised
)


public class FirstPowerOfTwo {

    public static void main(String[] args) {
        runTest(12, 1);
        runTest(12, 2);
        runTest(123, 45);
        runTest(123, 12345);
        runTest(123, 678910);
    }

    private static void runTest(int l, int n) {
        System.out.printf("p(%d, %d) = %,d%n", l, n, p(l, n));
    }

    public static int p(int l, int n) {
        int test = 0;
        double log = Math.log(2) / Math.log(10);
        int factor = 1;
        int loop = l;
        while ( loop > 10 ) {
            factor *= 10;
            loop /= 10;
        }
        while ( n > 0) {
            test++;
            int val = (int) (factor * Math.pow(10, test * log % 1));
            if ( val == l ) {
                n--;
            }
        }
        return test;
    }

}


def normalize_base($base):
  def n:
    if length == 1 and .[0] < $base then .[0]
    else .[0] % $base,
           ((.[0] / $base|floor) as $carry
            |.[1:]
	    | .[0] += $carry
            | n )
    end;
   n;

def integers_as_arrays_times($n; $base):
  map(. * $n)
  | [normalize_base($base)];

def p($L; $n):
  # @assert($L > 0 and $n > 0)
  ($L|tostring|explode|reverse|map(. - 48)) as $digits   # "0" is 48
  | ($digits|length) as $ndigits
  | (2*(2+($n|log|floor))) as $extra
  | { m: $n,
      i: 0,
      keep: ( 2*(2+$ndigits) + $extra),
      p: [1] # reverse-array representation of 1
    }
  | until(.m == 0;
           .i += 1
         | .p |= integers_as_arrays_times(2; 10)
	 | .p = .p[ -(.keep) :]
         | if (.p[-$ndigits:]) == $digits
           then
           | .m += -1  | .keep -= ($extra/$n)
	   else . end )
  | .i;

## The task
[[12, 1], [12, 2], [123, 45], [123, 12345], [123, 678910]][]
| "With L = \(.[0]) and n = \(.[1]), p(L, n) = \( p(.[0]; .[1]))"


function p(L, n)
    @assert(L > 0 && n > 0)
    places, logof2, nfound = trunc(log(10, L)), log(10, 2), 0
    for i in 1:typemax(Int)
        if L == trunc(10^(((i * logof2) % 1) + places)) && (nfound += 1) == n
            return i
        end
    end
end

for (L, n) in [(12, 1), (12, 2), (123, 45), (123, 12345), (123, 678910)]
    println("With L = $L and n = $n, p(L, n) = ", p(L, n))
end


import kotlin.math.ln
import kotlin.math.pow

fun main() {
    runTest(12, 1)
    runTest(12, 2)
    runTest(123, 45)
    runTest(123, 12345)
    runTest(123, 678910)
}

private fun runTest(l: Int, n: Int) {
//    System.out.printf("p(%d, %d) = %,d%n", l, n, p(l, n))
    println("p($l, $n) = %,d".format(p(l, n)))
}

fun p(l: Int, n: Int): Int {
    var m = n
    var test = 0
    val log = ln(2.0) / ln(10.0)
    var factor = 1
    var loop = l
    while (loop > 10) {
        factor *= 10
        loop /= 10
    }
    while (m > 0) {
        test++
        val value = (factor * 10.0.pow(test * log % 1)).toInt()
        if (value == l) {
            m--
        }
    }
    return test
}


f = Compile[{{ll, _Integer}, {n, _Integer}},
   Module[{l, digitcount, log10power, raised, found, firstdigits, pwr = 2},
    l = Abs[ll];
    digitcount = Floor[Log[10, l]];
    log10power = Log[10, pwr];
    raised = -1;
    found = 0;
    While[found < n,
     raised++;
     firstdigits = Floor[10^(FractionalPart[log10power raised] + digitcount)];
     If[firstdigits == l,
      found += 1;
      ]
     ];
    Return[raised]
    ]
 ];
f[12, 1]
f[12, 2]
f[123, 45]
f[123, 12345]
f[123, 678910]


import math, strformat

const
  Lfloat64 = pow(2.0, 64)
  Log10_2_64 = int(Lfloat64 * log10(2.0))

#---------------------------------------------------------------------------------------------------

func ordinal(n: int): string =
  case n
  of 1: "1st"
  of 2: "2nd"
  of 3: "3rd"
  else: $n & "th"

#---------------------------------------------------------------------------------------------------

proc findExp(number, countLimit: int) =

  var i = number
  var digits = 1
  while i >= 10:
    digits *= 10
    i = i div 10

  var lmtLower, lmtUpper: uint64
  var log10num = log10((number + 1) / digits)
  if log10num >= 0.5:
    lmtUpper = if (number + 1) / digits < 10: uint(log10Num * (Lfloat64 * 0.5)) * 2 + uint(log10Num * 2)
               else: 0
    log10Num = log10(number / digits)
    lmtLower = uint(log10Num * (Lfloat64 * 0.5)) * 2 + uint(log10Num * 2)
  else:
    lmtUpper = uint(log10Num * Lfloat64)
    lmtLower = uint(log10(number / digits) * Lfloat64)

  var count = 0
  var frac64 = 0u64
  var p = 0
  if lmtUpper != 0:
    while true:
      inc p
      inc frac64, Log10_2_64
      if frac64 in lmtLower..lmtUpper:
        inc count
        if count >= countLimit:
          break
  else:
    # Searching for "999...".
    while true:
      inc p
      inc frac64, Log10_2_64
      if frac64 >= lmtLower:
        inc count
        if count >= countLimit:
          break

  echo fmt"""The {ordinal(count)} occurrence of 2 raised to a power""" &
       fmt""" whose product starts with "{number}" is {p}"""

#———————————————————————————————————————————————————————————————————————————————————————————————————

findExp(12, 1)
findExp(12, 2)

findExp(123, 45)
findExp(123, 12345)
findExp(123, 678910)


program Power2FirstDigits;

uses
  sysutils,
  strUtils;

const
{$IFDEF FPC}
  {$MODE DELPHI}

  ld10 :double = ln(2)/ln(10);// thats 1/log2(10)
{$ELSE}
  ld10 = 0.30102999566398119521373889472449;

function Numb2USA(const S: string): string;
var
  i, NA: Integer;
begin
  i := Length(S);
  Result := S;
  NA := 0;
  while (i > 0) do
  begin
    if ((Length(Result) - i + 1 - NA) mod 3 = 0) and (i <> 1) then
    begin
      insert(',', Result, i);
      inc(NA);
    end;
    Dec(i);
  end;
end;

{$ENDIF}

function FindExp(CntLmt, Number: NativeUint): NativeUint;
var
  i, cnt, DgtShift: NativeUInt;
begin
  //calc how many Digits needed
  i := Number;
  DgtShift := 1;
  while i >= 10 do
  begin
    DgtShift := DgtShift * 10;
    i := i div 10;
  end;

  cnt := 0;
  i := 0;
  repeat
    inc(i);
    // x= i*ld10 -> 2^I = 10^x
    // 10^frac(x) -> [0..10[ = exp(ln(10)*frac(i*lD10))
    if Trunc(DgtShift * exp(ln(10) * frac(i * lD10))) = Number then
    begin
      inc(cnt);
      if cnt >= CntLmt then
        BREAK;
    end;
  until false;
  write('The  ', Numb2USA(IntToStr(cnt)), 'th  occurrence of 2 raised to a power');
  write(' whose product starts with "', Numb2USA(IntToStr(Number)));
  writeln('" is ', Numb2USA(IntToStr(i)));
  FindExp := i;
end;

begin
  FindExp(1, 12);
  FindExp(2, 12);

  FindExp(45, 123);
  FindExp(12345, 123);
  FindExp(678910, 123);
end.


use strict;
use warnings;
use feature 'say';
use feature 'state';

use POSIX qw(fmod);
use Perl6::GatherTake;

use constant ln2ln10 => log(2) / log(10);

sub comma { reverse ((reverse shift) =~ s/(.{3})/$1,/gr) =~ s/^,//r }

sub ordinal_digit {
    my($d) = $_[0] =~ /(.)$/;
    $d eq '1' ? 'st' : $d eq '2' ? 'nd' : $d eq '3' ? 'rd' : 'th'
}

sub startswith12 {
    my($nth) = @_;
    state $i = 0;
    state $n = 0;
    while (1) {
      next unless '1.2' eq substr(( 10 ** fmod(++$i * ln2ln10, 1) ), 0, 3);
      return $i if ++$n eq $nth;
    }
}

sub startswith123 {
    my $pre = '1.23';
    my ($this, $count) = (0, 0);

    gather {
      while (1) {
        if ($this == 196) {
            $this = 289;
            $this = 485 unless $pre eq substr(( 10 ** fmod(($count+$this) * ln2ln10, 1) ), 0, 4);
        } elsif ($this == 485) {
            $this = 196;
            $this = 485 unless $pre eq substr(( 10 ** fmod(($count+$this) * ln2ln10, 1) ), 0, 4);
        } elsif ($this == 289) {
            $this = 196
        } elsif ($this ==  90) {
            $this = 289
        } elsif ($this ==   0) {
            $this = 90;
        }
        take $count += $this;
      }
    }
}

my $start_123 = startswith123(); # lazy list

sub p {
    my($prefix,$nth) = @_;
    $prefix eq '12' ? startswith12($nth) : $start_123->[$nth-1];
}

for ([12, 1], [12, 2], [123, 45], [123, 12345], [123, 678910]) {
    my($prefix,$nth) = @$_;
    printf "%-15s %9s power of two (2^n) that starts with %5s is at n = %s\n", "p($prefix, $nth):",
        comma($nth) . ordinal_digit($nth), "'$prefix'", comma p($prefix, $nth);
}


with javascript_semantics
function p(integer L, n)
    atom logof2 = log10(2)
    integer places = trunc(log10(L)),
            nfound = 0, i = 1
    while true do
        atom a = i * logof2,
             b = trunc(power(10,a-trunc(a)+places))
        if L == b then
            nfound += 1
            if nfound == n then exit end if
        end if
        i += 1
    end while
    return i
end function

constant tests = {{12, 1}, {12, 2}, {123, 45}, {123, 12345}, {123, 678910}}
include ordinal.e
include mpfr.e
mpz z = mpz_init()
atom t0 = time()
for i=1 to length(tests)-(2*(platform()=JS)) do
    integer {L,n} = tests[i], pln = p(L,n)
    mpz_ui_pow_ui(z,2,pln)
    integer digits = mpz_sizeinbase(z,10)
    string st = iff(digits>2e6?sprintf("%,d digits",digits):
                               shorten(mpz_get_str(z),"digits",5))
    printf(1,"The %d%s power of 2 that starts with %d is %d [i.e. %s]\n",{n,ord(n),L,pln,st})
end for
?elapsed(time()-t0)


from math import log, modf, floor

def p(l, n, pwr=2):
    l = int(abs(l))
    digitcount = floor(log(l, 10))
    log10pwr = log(pwr, 10)
    raised, found = -1, 0
    while found < n:
        raised += 1
        firstdigits = floor(10**(modf(log10pwr * raised)[0] + digitcount))
        if firstdigits == l:
            found += 1
    return raised

if __name__ == '__main__':
    for l, n in [(12, 1), (12, 2), (123, 45), (123, 12345), (123, 678910)]:
        print(f"p({l}, {n}) =", p(l, n))


#lang racket
(define (fract-part f)
  (- f (truncate f)))

(define ln10 (log 10))
(define ln2/ln10 (/ (log 2) ln10))

(define (inexact-p-test L)
  (let ((digit-shift (let loop ((L (quotient L 10)) (shift 1))
                       (if (zero? L) shift (loop (quotient L 10) (* 10 shift))))))
    (λ (p) (= L (truncate (* digit-shift (exp (* ln10 (fract-part (* p ln2/ln10))))))))))

(define (p L n)
  (let ((test? (inexact-p-test L)))
    (let loop ((j 1) (n (sub1 n)))
      (cond [(not (test? j)) (loop (add1 j) n)]
            [(zero? n) j]
            [else (loop (add1 j) (sub1 n))]))))

(module+ main
  (define (report-p L n)
    (time (printf "p(~a, ~a) = ~a~%" L n (p L n))))

  (report-p 12 1)
  (report-p 12 2)
  (report-p 123 45)
  (report-p 123 12345)
  (report-p 123 678910))


use Lingua::EN::Numbers;

constant $ln2ln10 = log(2) / log(10);

my @startswith12  = ^∞ .grep: { ( 10 ** ($_ * $ln2ln10 % 1) ).substr(0,3) eq '1.2' };

my @startswith123 = lazy gather loop {
    state $pre   = '1.23';
    state $count = 0;
    state $this  = 0;
    given $this {
        when 196 {
            $this = 289;
            my \n = $count + $this;
            $this = 485 unless ( 10 ** (n * $ln2ln10 % 1) ).substr(0,4) eq $pre;
        }
        when 485 {
            $this = 196;
            my \n = $count + $this;
            $this = 485 unless ( 10 ** (n * $ln2ln10 % 1) ).substr(0,4) eq $pre;
        }
        when 289 { $this = 196 }
        when 90  { $this = 289 }
        when 0   { $this = 90  }
    }
    take $count += $this;
}

multi p ($prefix where *.chars == 2, $nth) {  @startswith12[$nth-1] }
multi p ($prefix where *.chars == 3, $nth) { @startswith123[$nth-1] }

# The Task
for < 12 1  12 2  123 45  123 12345  123 678910 > -> $prefix, $nth {
    printf "%-15s %9s power of two (2^n) that starts with %5s is at n = %s\n", "p($prefix, $nth):",
        comma($nth) ~ ordinal-digit($nth).substr(*-2), "'$prefix'", comma p($prefix, $nth);
}


/*REXX program computes powers of two whose leading decimal digits are "12" (in base 10)*/
parse arg L n b .                                /*obtain optional arguments from the CL*/
if L=='' | L=="," then L= 12                     /*Not specified?  Then use the default.*/
if n=='' | n=="," then n=  1                     /* "      "         "   "   "     "    */
if b=='' | b=="," then b=  2                     /* "      "         "   "   "     "    */
LL= length(L)                                    /*obtain the length of  L  for compares*/
fd=   left(L, 1)                                 /*obtain the first   dec. digit  of  L.*/
fr= substr(L, 2)                                 /*   "    "  rest of dec. digits  "  " */
numeric digits max(20, LL+2)                     /*use an appropriate value of dec. digs*/
rest= LL - 1                                     /*the length of the rest of the digits.*/
#= 0                                             /*the number of occurrences of a result*/
x= 1                                             /*start with a product of unity (B**0).*/
     do j=1  until #==n;        x= x * b         /*raise  B  to a whole bunch of powers.*/
     parse var x _ 2                             /*obtain the first decimal digit of  X.*/
     if _ \== fd  then iterate                   /*check only the 1st digit at this time*/
     if LL>1  then do                            /*check the rest of the digits, maybe. */
                   $= format(x, , , , 0)         /*express  X  in exponential format.   */
                   parse var $ '.' +1 f +(rest)  /*obtain the rest of the digits.       */
                   if f \== fr  then iterate     /*verify that  X  has the rest of digs.*/
                   end                           /* [↓] found an occurrence of an answer*/
     #= # + 1                                    /*bump the number of occurrences so far*/
     end   /*j*/

say 'The '  th(n)  ' occurrence of '   b  ' raised to a power whose product starts with' ,
                                                  ' "'L"'"       ' is '        commas(j).
exit                                             /*stick a fork in it,  we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
commas: arg _;     do c=length(_)-3  to 1  by -3;  _= insert(',', _, c);  end;    return _
th:     arg _;  return _ || word('th st nd rd', 1 +_//10 * (_//100 % 10\==1) * (_//10 <4))


def p(l, n)
    test = 0
    logv = Math.log(2.0) / Math.log(10.0)
    factor = 1
    loopv = l
    while loopv > 10 do
        factor = factor * 10
        loopv = loopv / 10
    end
    while n > 0 do
        test = test + 1
        val = (factor * (10.0 ** ((test * logv).modulo(1.0)))).floor
        if val == l then
            n = n - 1
        end
    end
    return test
end

def runTest(l, n)
    print "P(%d, %d) = %d\n" % [l, n, p(l, n)]
end

runTest(12, 1)
runTest(12, 2)
runTest(123, 45)
runTest(123, 12345)
runTest(123, 678910)


fn power_of_two(l: isize, n: isize) -> isize {
    let mut test: isize = 0;
    let log: f64 = 2.0_f64.ln() / 10.0_f64.ln();
    let mut factor: isize = 1;
    let mut looop = l;
    let mut nn = n;
    while looop > 10 {
        factor *= 10;
        looop /= 10;
    }

    while nn > 0 {
        test = test + 1;
        let val: isize = (factor as f64 * 10.0_f64.powf(test as f64 * log % 1.0)) as isize;

        if val == l {
            nn = nn - 1;
        }
    }

    test
}

fn run_test(l: isize, n: isize) {
    println!("p({}, {}) = {}", l, n, power_of_two(l, n));
}

fn main() {
    run_test(12, 1);
    run_test(12, 2);
    run_test(123, 45);
    run_test(123, 12345);
    run_test(123, 678910);
}


object FirstPowerOfTwo {
  def p(l: Int, n: Int): Int = {
    var n2 = n
    var test = 0
    val log = math.log(2) / math.log(10)
    var factor = 1
    var loop = l
    while (loop > 10) {
      factor *= 10
      loop /= 10
    }
    while (n2 > 0) {
      test += 1
      val value = (factor * math.pow(10, test * log % 1)).asInstanceOf[Int]
      if (value == l) {
        n2 -= 1
      }
    }
    test
  }

  def runTest(l: Int, n: Int): Unit = {
    printf("p(%d, %d) = %,d%n", l, n, p(l, n))
  }

  def main(args: Array[String]): Unit = {
    runTest(12, 1)
    runTest(12, 2)
    runTest(123, 45)
    runTest(123, 12345)
    runTest(123, 678910)
  }
}


func farey_approximations(r, callback) {

    var (a1 = r.int, b1 = 1)
    var (a2 = a1+1,  b2 = 1)

    loop {
        var a3 = a1+a2
        var b3 = b1+b2

        if (a3 < r*b3) {
            (a1, b1) = (a3, b3)
        }
        else {
            (a2, b2) = (a3, b3)
        }

        callback(a3 / b3)
    }
}

func p(L, nth) {

    define ln2  = log(2)
    define ln5  = log(5)
    define ln10 = log(10)

    var t = L.len-1

    func isok(n) {
        floor(exp(ln2*(n - floor((n*ln2)/ln10) + t) + ln5*(t - floor((n*ln2)/ln10)))) == L
    }

    var deltas = gather {
        farey_approximations(ln2/ln10, {|r|
            take(r.de) if (r.de.len == L.len)
            break      if (r.de.len >  L.len)
        })
    }.sort.uniq

    var c = 0
    var k = (1..Inf -> first(isok))

    loop {
        return k if (++c == nth)
        k += (deltas.first {|d| isok(k+d) } \\ die "error: #{k}")
    }
}

var tests = [
    [12, 1],
    [12, 2],
    [123, 45],
    [123, 12345],
    [123, 678910],

    # extra
    [1234, 10000],
    [12345, 10000],
]

for a,b in (tests) {
    say "p(#{a}, #{b}) = #{p(a,b)}"
}


let ld10 = log(2.0) / log(10.0)

func p(L: Int, n: Int) -> Int {
  var l = L
  var digits = 1

  while l >= 10 {
    digits *= 10
    l /= 10
  }

  var count = 0
  var i = 0

  while count < n {
    let rhs = (Double(i) * ld10).truncatingRemainder(dividingBy: 1)
    let e = exp(log(10.0) * rhs)

    if Int(e * Double(digits)) == L {
      count += 1
    }

    i += 1
  }

  return i - 1
}

let cases = [
  (12, 1),
  (12, 2),
  (123, 45),
  (123, 12345),
  (123, 678910)
]

for (l, n) in cases {
  print("p(\(l), \(n)) = \(p(L: l, n: n))")
}


Module Module1

    Function Func(ByVal l As Integer, ByVal n As Integer) As Long
        Dim res As Long = 0, f As Long = 1
        Dim lf As Double = Math.Log10(2)
        Dim i As Integer = l

        While i > 10
            f *= 10
            i /= 10
        End While

        While n > 0
            res += 1

            If CInt((f * Math.Pow(10, res * lf Mod 1))) = l Then
                n -= 1
            End If
        End While

        Return res
    End Function

    Sub Main()
        Dim values = {Tuple.Create(12, 1), Tuple.Create(12, 2), Tuple.Create(123, 45), Tuple.Create(123, 12345), Tuple.Create(123, 678910), Tuple.Create(99, 1)}
        For Each pair In values
            Console.WriteLine("p({0,3}, {1,6}) = {2,11:n0}", pair.Item1, pair.Item2, Func(pair.Item1, pair.Item2))
        Next
    End Sub

End Module


import "/fmt" for Fmt
import "/math" for Math

var ld10 = Math.ln2 / Math.ln10

var p = Fn.new { |L, n|
    var i = L
    var digits = 1
    while (i >= 10) {
        digits = digits * 10
        i = (i/10).floor
    }
    var count = 0
    i = 0
    while (count < n) {
        var e = (Math.ln10 * (i * ld10).fraction).exp
        if ((e * digits).truncate == L) count = count + 1
        i = i + 1
    }
    return i - 1
}

var start = System.clock
var params = [ [12, 1] , [12, 2], [123, 45], [123, 12345], [123, 678910] ]
for (param in params) {
    Fmt.print("p($d, $d) = $,d", param[0], param[1], p.call(param[0], param[1]))
}

System.print("\nTook %(System.clock - start) seconds.")


FAC = 0.30102999566398119521373889472449302677

print p(12, 1)
print p(12, 2)
print p(123, 45)
print p(123, 12345)
print p(123, 678910)
end

sub p(L, n)
    cont = 0 : j = 0
    LS$ = str$(L)
    while cont < n
        j = j + 1
        x = FAC * j
        //if x < len(LS$)  continue while       'sino da error
        y = 10^(x-int(x))
        y = y * 10^len(LS$)
        digits$ = str$(y)
        if left$(digits$, len(LS$)) = LS$  cont = cont + 1
    end while
    return j
end sub


// float*int --> float and int*float --> int
fcn p(L,nth){   // 2^j = <L><digits>
   var [const] ln10=(10.0).log(), ld10=(2.0).log() / ln10;
   digits := (10).pow(L.numDigits - 1);
   foreach i in ([1..]){
      z:=ld10*i;
      if(L == ( ln10 * (z - z.toInt()) ).exp()*digits and (nth-=1) <= 0)
	 return(i);
   }
}


L(i) 1..100
   I i % 15 == 0
      print(‘FizzBuzz’)
   E I i % 3 == 0
      print(‘Fizz’)
   E I i % 5 == 0
      print(‘Buzz’)
   E
      print(i)


with: n

: num?  \ n f --   )
	if drop else . then ;

\ is m mod n 0? leave the result twice on the stack
: div? \ m n -- f f
	mod 0 = dup ;

: fizz? \ n -- n f
	dup 3
	div? if "Fizz" .  then ;

: buzz? \ n f -- n f
	over 5
	div? if "Buzz" .  then or ;

\ print a message as appropriate for the given number:
: fizzbuzz  \ n --
	fizz? buzz? num?
	space ;

\ iterate from 1 to 100:
' fizzbuzz 1 100 loop
cr bye


	ORG	$4357
; SYS 17239 or CALL 17239

EMPTY2	=	$00
TREE2	=	$44
FIRE2	=	$99

; common available zero page

GBASL	=	$26
GBASH	=	$27

SEED2	=	$28
SEED0	=	$29
SEED1	=	$2A

H2	=	$2B
V2	=	$2C
PLOTC	=	$2D
COLOR	=	$2E
PAGE	=	$2F
TOPL	=	$30
TOPH	=	$31
MIDL	=	$32
MIDH	=	$33
BTML	=	$34
BTMH	=	$35
PLOTL	=	$36
PLOTH	=	$37
lastzp	=	$38

tablelo	=	$5000
tablehi = tablelo+25

	JSR START
	STA V2
	LDA #$4C ; JMP instruction
	STA SEED2 ; temporary JMP
	LDX #$00 ; y coord
table:
	TXA
	JSR SEED2 ; temporary JMP GBASCALC
	LDA GBASL
	STA tablelo,X
	LDA GBASH
	STA tablehi,X
	LDY #$00
	TYA
clrline:
	STA (GBASL),Y
	INY
	CPY #40
	BNE clrline

	INX
	CPX V2
	BNE table

	JSR sseed0
	JSR sseed2

	LDX #$60
	STX PAGE
	STX TOPH
	LDY #$00
	STY TOPL
	TYA
zero:	STA (TOPL),Y
	INY
	BNE zero
	INX
	STX TOPH
	CPX #$80
	BNE zero

loop3:
	LDX #0
	STX TOPL
	LDA #41
	STA MIDL
	STA PLOTL
	LDA #83
	STA BTML
	LDA PAGE
	STA TOPH
	STA MIDH
	STA BTMH
	EOR #$10
	STA PLOTH
	STA PAGE
loop2:
	TXA
	STX V2
	LSR       ; F800 PLOT-like...
	; PHP       ; F801
	TAY	 ; save A in Y without touching C
	LDA #$0F
	BCC over2
	ADC #$E0
over2:	STA PLOTC   ; PLOT...
	LDA tablelo,Y ; lookup instead of GBASCALC
	STA GBASL
	LDA tablehi,Y
	STA GBASH
	; PLP     ; continue PLOT
	LDY #$01 ; x coord
loop1:
	STY H2
	LDA (MIDL),Y
	STA (PLOTL),Y
	BEQ empty
	BPL tree
	LDA #EMPTY2
doplot:	LDY H2
	STA (PLOTL),Y
	DEY
	EOR (GBASL),Y
	AND PLOTC
	EOR (GBASL),Y
	STA (GBASL),Y
noplot:
	LDY H2
	INY
	CPY #41
	BNE loop1
	LDA MIDL
	STA TOPL
	LDA MIDH
	STA TOPH
	LDA BTML
	STA MIDL
	STA PLOTL
	CLC
	ADC #42
	STA BTML
	LDA BTMH
	EOR #$10
	STA PLOTH
	EOR #$10
	STA MIDH
	ADC #$00
	STA BTMH
	LDX V2
	INX
	CPX #48
	BNE loop2
	JSR QUIT
	JMP loop3
empty:
	DEC SEED2
	BNE noplot
	JSR sseed2 ; probability f
	LDA #TREE2
	BNE doplot
ignite:
	LDA #FIRE2
	BNE doplot
tree:
	DEC SEED0
	BNE check
	DEC SEED1
	BNE check
	JSR sseed0 ; probability p
	BNE ignite
check:
	LDA (TOPL),Y ; n
	ORA (BTML),Y ; s
	DEY
	ORA (TOPL),Y ; nw
	ORA (MIDL),Y ; w
	ORA (BTML),Y ; sw
	INY
	INY
	ORA (TOPL),Y ; ne
	ORA (MIDL),Y ; e
	ORA (BTML),Y ; se
	BMI ignite
	BPL noplot

sseed0:
	LDA #$17 ; 1 in 10007 (prime)
	STA SEED0
	LDA #$27
	STA SEED1
	RTS
sseed2:
	LDA #$65  ; 1 in 101 (prime)
	STA SEED2
	RTS

default:
	LDA #<GBASCALC ; setup GBASCALC
	STA SEED0
	LDA #>GBASCALC
	STA SEED1
	LDA #25 ; screen rows
	RTS
GBASCALC:
	LDY #$00
	STY GBASH
	ASL
	ASL
	ASL
	STA GBASL
	ASL
	ROL GBASH
	ASL
	ROL GBASH
	ADC GBASL
	STA GBASL
	LDA GBASH
	ADC #$04
	STA GBASH
	RTS

QUIT:
	LDA $E000

; APPLE II

	CMP #$4C
	BNE c64quit

	BIT $C000 ; apple ii keypress?
	BPL CONTINUE ; no keypressed then continue
	BIT $C010 ; clear keyboard strobe
	BIT $C051 ; text mode

; end APPLE II specific

ABORT:
	PLA
	PLA

	LDX #GBASL
restorzp:
	LDA $5100,X
	STA $00,X
	INX
	CPX #lastzp
	BNE restorzp

CONTINUE:
	RTS

START:
	LDX #GBASL
savezp:
	LDA $00,X
	STA $5100,X
	INX
	CPX #lastzp
	BNE savezp

; machine ???

	LDA $E000 ; terribly unreliable, oh well

; APPLE II

	CMP #$4C ; apple ii?
	BNE c64start ; nope, try another

	BIT $C056 ; low resolution
	BIT $C052 ; full screen
	BIT $C054 ; page one
	BIT $C050 ; graphics
; GBASCALC = $F847
	LDA #$47
	STA SEED0
	LDA #$F8
	STA SEED1
	LDA #24 ; screen rows
	RTS

; end APPLE II specific

; COMMODORE 64 specific

c64quit:

; COMMODORE 64

	CMP #$85 ; commodore 64?
	BNE CONTINUE ; nope, default to no keypress

	LDA $C6 ; commodore keyboard buffer length
	BEQ CONTINUE ; no keypressed then continue

	LDA #$00
	STA $C6
	LDA $D016 ; Screen control register #2
	AND #$EF  ; Bit #4: 0 = Multicolor mode off.
	STA $D016
	LDA #21 ; default character set
	STA $D018
	BNE ABORT

c64start:

	CMP #$85 ; commodore 64?
	BEQ c64yes ; yes
	JMP default ; no, default to boringness
c64yes:
	LDA #$00  ; black
	STA $D020 ; border
	LDA #$00  ; black
	STA $D021 ; background
	LDA #$05  ; dark green
	STA $D022 ; Extra background color #1
	LDA #$08  ; orange
	STA $D023 ; Extra background color #2
	LDA $D016 ; Screen control register #2
	ORA #$10  ; Bit #4: 1 = Multicolor mode on.
	STA $D016

	LDA #$30  ; 0011 0000 $3000 charset page
	STA PLOTH
	LSR
	LSR
	STA PLOTC ; 0000 1100 #$0C
; 53272 $D018
; POKE 53272,(PEEK(53272)AND240)+12: REM SET CHAR POINTER TO MEM. 12288
;     Bits #1-#3: In text mode, pointer to character memory
;    (bits #11-#13), relative to VIC bank, memory address $DD00
;     %110, 6: $3000-$37FF, 12288-14335.
	LDA $D018
	AND #$F0
	ORA PLOTC
	STA $D018
; setup nine characters

; 00- 00 00
	LDA #$00 ; chr(0) * 8
	STA PLOTL
	; --- LDA #$00 ; already zero
	TAX ; LDX #$00
	JSR charset

; 04- 00 55
	LDA #32 ; chr(4) * 8
	STA PLOTL
	LDA #$55
	; LDX #$00 ; already zero
	JSR charset

; 09- 00 AA
	LDA #72 ; chr(9) * 8
	STA PLOTL
	LDA #$AA
	; LDX #$00 ; already zero
	JSR charset

; 40- 55 00
	LDA PLOTH ; 512 = chr(64) * 8
	CLC
	ADC #$02
	STA PLOTH
	LDX #$00
	STX PLOTL
	LDA #$00
	LDX #$55
	JSR charset

; 44- 55 55
	LDA #32 ; chr(68) * 8
	STA PLOTL
	TXA ; LDA #$55
	; LDX #$55 ; already 55
	JSR charset

; 49- 55 AA
	LDA #72 ; chr(73) * 8
	STA PLOTL
	LDA #$AA
	; LDX #$55 ; already 55
	JSR charset

; 90- AA 00
	LDA PLOTH ; chr(144) * 8
	CLC
	ADC #$02
	STA PLOTH
	LDA #128
	STA PLOTL
	LDA #$00
	LDX #$AA
	JSR charset

; 94- AA 55
	LDA #160 ; chr(148) * 8
	STA PLOTL
	LDA #$55
	; LDX #$AA ; already AA
	JSR charset

; 99- AA AA
	LDA #200 ; chr(153) * 8
	STA PLOTL
	TXA ; LDA #$AA
	; LDX #$AA ; already AA
	JSR charset
	JMP default
charset:
	LDY #$00
chartop:
	STA (PLOTL),Y
	INY
	CPY #$04
	BNE chartop
	TXA
charbtm:
	STA (PLOTL),Y
	INY
	CPY #$08
	BNE charbtm
	RTS

; end COMMODORE 64 specific


	;;;	Simulation settings (probabilities are P/65536)
probF:	equ	7		; P(spontaneous combustion) ~= 0.0001
probP:	equ	655		; P(spontaneous growth) ~= 0.01
HSIZE:	equ	320 		; Field width (320x200 fills CGA screen)
VSIZE:	equ	200		; Field height
FSIZE:	equ	HSIZE*VSIZE	; Field size
FPARA:	equ	FSIZE/16+1	; Field size in paragraphs
	;;;	Field values
EMPTY:	equ	0 		; Empty cell (also CGA black)
TREE:	equ	1		; Tree cell (also CGA green)
FIRE:	equ	2		; Burning cell (also CGA red)
	;;;	MS-DOS system calls and values
TOPSEG:	equ	2		; First unavailable segment
puts:	equ	9		; Print a string
time:	equ	2Ch		; Get system time
exit:	equ	4Ch		; Exit to DOS
	;;;	BIOS calls and values
palet:	equ	0Bh		; Set CGA color pallette
vmode:	equ	0Fh		; Get current video mode
keyb:	equ	1		; Get keyboard status
CGALO:	equ	4		; Low-res (4-color) CGA graphics mode
MDA:	equ	7		; MDA monochrome text mode
CGASEG:	equ	0B800h		; CGA memory segment
	cpu	8086
	org	100h
section	.text
	;;;	Program set-up (check memory size and set video mode)
	mov	sp,stack.top	; Move stack inwards
	mov	bp,sp		; Set BP to first available paragraph
	mov	cl,4
	shr	bp,cl
	inc	bp
	mov	dx,cs
	add	bp,dx
	mov	bx,[TOPSEG]	; Get first unavailable segment
	sub	bx,bp		; Get amount of available memory
	cmp	bx,FPARA*2	; Enough to fit two fields?
	ja	mem_ok
	mov	dx,errmem	; If not, print error message
err:	mov	ah,puts
	int	21h
	mov	ah,exit		; And stop
	int	21h
mem_ok:	mov	ah,vmode	; Get current video mode
	int	10h
	push	ax		; Keep on stack for later retrieval
	cmp	al,MDA		; MDA card does not support CGA graphics,
	mov	dx,errcga	; so print an error and quit.
	je	err
	mov	ax,CGALO	; Otherwise, switch to 320x200 CGA mode
	int	10h
	mov	ah,palet	; And set the black/green/red/brown palette
	mov	bx,0100h
	int	10h
	mov	ah,time		; Get the system time
	int	21h
	mov	[rnddat],cx	; Use it as the RNG seed
	mov	[rnddat+2],dx
	;;;	Initialize the field (place trees randomly)
	mov	es,bp		; ES = field segment
	xor	di,di		; Start at first field
	mov	cx,FSIZE	; CX = how many cells to initialize
	mov	ah,TREE
ptrees:	call	random		; Get random byte
	and	al,ah 		; Place a tree 50% of the time
	stosb
	loop	ptrees
	mov	ds,bp		; DS = field segment
	;;;	Write field to CGA display
disp:	xor	si,si		; Start at beginning
	mov	dx,CGASEG	; ES = CGA memory segment
.scrn:	mov	es,dx
	xor	di,di		; Start of segment
.line:	mov	cx,HSIZE/8	; 8 pixels per word
.word:	xor	bx,bx		; BX will hold CGA word
	xor	ah,ah		; Set high byte to zero
%rep 	7			; Unroll this loop for speed
	lodsb			; Get cell
	or	bx,ax		; Put it in low 2 bits of BX
	shl	bx,1		; Shift BX to make room for next field
	shl	bx,1
%endrep
	lodsb			; No shift needed for final cell
	or	ax,bx
	stosw			; Store word in CGA memory
	loop	.word		; Do next byte of line
	add	si,HSIZE	; Even and odd lines stored separately
	cmp	si,FSIZE	; Done yet?
	jb	.line		; If not, do next line
	add	dx,200h		; Move to next segment
	cmp	dx,CGASEG+200h	; If we still need to do the odd lines,
	mov	si,HSIZE	; then do them
	jbe	.scrn
	;;;	Stop the program if a key is pressed
	mov	ah,1		; Check if a key is pressed
	int	16h
	jz 	calc		; If not, calculate next field state
	pop	ax		; Otherwise, restore the old video mode,
	cbw
	int	10h
	mov	ah,exit		; and exit to DOS.
	int	21h
	;;;	Calculate next field state
calc:	mov	ax,ds		; Set ES = new field segment
	add	ax,FPARA
	mov	es,ax
	xor	di,di		; Start at beginning
	xor	si,si
.cell:	lodsb			; Get cell
	dec	al		; A=1 = tree
	jz	.tree
	dec	al		; A=2 = fire
	jz	.fire
	call	rand16		; An empty space fills with a tree
	cmp	ax,probP	; with probability P.
	jc	.mtree		; Otherwise it stays empty
.fire:	xor	al,al		; A burning tree turns into an empty cell
	stosb
	jmp	.cnext
.mtree:	mov	al,TREE
	stosb
.cnext:	cmp	si,FSIZE	; Are we there yet?
	jne	.cell		; If not, do next cell
	push	es		; Done - set ES=old field, DS=new field,
	push	ds
	pop	es
	pop	ds
	mov	cx,FSIZE/2
	xor	si,si
	xor	di,di
	rep	movsw		; copy the new field to the old field,
	push	es		; set DS to be the field to draw,
	pop	ds
	xor	di,di		; Instead of doing edge case handling in the
	xor	ax,ax		; Moore neighbourhood calculation, just zero
	mov	cx,HSIZE/2	; out the borders for a slightly smaller image
	rep	stosw		; Upper border,
	mov	di,FSIZE-HSIZE
	mov	cx,HSIZE/2
	rep	stosw		; lower border,
	mov	di,HSIZE-5	; right border.
	mov	cx,VSIZE-1
.bordr:	stosb
	add	di,HSIZE-1
	loop	.bordr
	jmp	disp		; and update the display.
.tree:	mov	ax,[si-HSIZE-2] ; Load Moore neighbourhood
	or	al,[si-HSIZE]
	or	ax,[si-2]
	or	al,[si]
	or	ax,[si+HSIZE-2]
	or	al,[si+HSIZE]
	or	al,ah
	test	al,FIRE		; Are any of the trees on fire?
	jnz	.tburn		; Then set this tree on fire too
	call	rand16		; Otherwise, spontaneous combustion?
	cmp	ax,probF
	jc	.tburn
	mov	al,TREE		; If not, the tree remains a tree
	stosb
	jmp	.cnext
.tburn:	mov	al,FIRE		; Set the tree on fire
	stosb
	jmp	.cnext
	;;;	Get a random word in AX
rand16:	call	random
	xchg	al,ah
	;;;	Get a random byte in AL. BX and DX destroyed.
random:	mov	bx,[cs:rnddat]	; BL=X BH=A
	mov	dx,[cs:rnddat+2]	; DL=B DH=C
	inc	bl		; X++
	xor	bh,dh		; A ^= C
	xor	bh,bl		; A ^= X
	add	dl,bh		; B += A
	mov	al,dl		; C' = B
	shr	al,1		; C' >>= 1
	add	al,dh		; C' += C
	xor	al,bh		; C' ^= A
	mov	dh,al		; C = C'
	mov	[cs:rnddat+2],dx	; Update RNG state
	mov	[cs:rnddat],bx
	ret
section	.data
errcga:	db	'CGA mode not supported.$'
errmem:	db	'Not enough memory.$'
section	.bss
rnddat:	resb	4		; RNG state
stack:	resw	128		; Stack space
.top:	equ	$


with Ada.Numerics.Float_Random;  use Ada.Numerics.Float_Random;
with Ada.Text_IO;                use Ada.Text_IO;

procedure Forest_Fire is
   type Cell is (Empty, Tree, Fire);
   type Board is array (Positive range <>, Positive range <>) of Cell;
   procedure Step (S : in out Board; P, F : Float; Dice : Generator) is
      function "+" (Left : Boolean; Right : Cell) return Boolean is
      begin
         return Left or else Right = Fire;
      end "+";
      function "+" (Left, Right : Cell) return Boolean is
      begin
         return Left = Fire or else Right = Fire;
      end "+";
      Above : array (S'Range (2)) of Cell := (others => Empty);
      Left_Up, Up, Left : Cell;
   begin
      for Row in S'First (1) + 1..S'Last (1) - 1 loop
         Left_Up := Empty;
         Up      := Empty;
         Left    := Empty;
         for Column in S'First (2) + 1..S'Last (2) - 1 loop
            Left_Up := Up;
            Up      := Above (Column);
            Above (Column) := S (Row, Column);
            case S (Row, Column) is
               when Empty =>
                  if Random (Dice) < P then
                     S (Row, Column) := Tree;
                  end if;
               when Tree =>
                  if Left_Up                 + Up                  +      Above (Column + 1) +
                     Left                    + S (Row,     Column) + S (Row,     Column + 1) +
                     S (Row + 1, Column - 1) + S (Row + 1, Column) + S (Row + 1, Column + 1)
                  or else Random (Dice) < F then
                     S (Row, Column) := Fire;
                  end if;
               when Fire =>
                  S (Row, Column) := Empty;
            end case;
            Left := Above (Column);
         end loop;
      end loop;
   end Step;
   procedure Put (S : Board) is
   begin
      for Row in S'First (1) + 1..S'Last (1) - 1 loop
         for Column in S'First (2) + 1..S'Last (2) - 1 loop
            case S (Row, Column) is
               when Empty => Put (' ');
               when Tree  => Put ('Y');
               when Fire  => Put ('#');
            end case;
         end loop;
         New_Line;
      end loop;
   end Put;

   Dice   : Generator;
   Forest : Board := (1..10 => (1..40 => Empty));
begin
   Reset (Dice);
   for I in 1..10 loop
      Step (Forest, 0.3, 0.1, Dice);
      Put_Line ("-------------" & Integer'Image (I) & " -------------");
      Put (Forest);
   end loop;
end Forest_Fire;


LONG REAL tree prob = 0.55, # original tree probability #
          f prob =    0.01, # new combustion probability #
          p prob =    0.01; # tree creation probability #
MODE CELL = CHAR; CELL empty=" ", tree="T", burning="#";
MODE WORLD = [6, 65]CELL;

PROC has burning neighbours = (WORLD world, INT r, c)BOOL:(
  FOR row shift FROM -1 TO 1 DO
    FOR col shift FROM -1 TO 1 DO
      INT rs = r + row shift, cs = c + col shift;
      IF rs >= LWB world AND rs <= UPB world AND
          cs >= 2 LWB world AND cs <= 2 UPB world THEN
        IF world[rs, cs] = burning THEN true exit FI
      FI
    OD
  OD;
  FALSE EXIT
  true exit: TRUE
);

PROC next state = (REF WORLD world, REF WORLD next world)VOID:(
  FOR r FROM LWB world TO UPB world DO
    REF[]CELL row = world[r, ];
    FOR c FROM LWB row TO UPB row DO
      REF CELL elem = row[c];
      next world[r, c] :=
        IF elem = empty THEN
          IF random<p prob THEN tree ELSE empty FI
        ELIF elem = tree THEN
          IF has burning neighbours(world, r, c) THEN
            burning
          ELSE
            IF random<f prob THEN burning ELSE tree FI
          FI
        ELIF elem = burning THEN
          empty
        FI
    OD
  OD;
  world := next world
);

main:(
  WORLD world; # create world #
  FOR r FROM LWB world TO UPB world DO
    REF []CELL row = world[r, ];
    FOR i FROM LWB row TO UPB row DO
      REF CELL el = row[i];
      el := IF random < tree prob THEN tree ELSE empty FI
    OD
  OD;

  WORLD next world;
  FOR i FROM 0 TO 4 DO
    next state(world, next world);
    printf(($n(2 UPB world)(a)l$, world)); # show world #
    printf(($gl$, 2 UPB world * "-"))
  OD
)


with Ada.Text_IO; use Ada.Text_IO;
with Ada.Containers.Generic_Array_Sort;

procedure Main is
   package Real_Io is new Float_IO (Long_Float);
   use Real_Io;

   type Data_Array is array (Natural range <>) of Long_Float;
   subtype Five_Num_Type is Data_Array (0 .. 4);

   procedure Sort is new Ada.Containers.Generic_Array_Sort
     (Index_Type => Natural, Element_Type => Long_Float,
      Array_Type => Data_Array);

   function Median (X : Data_Array) return Long_Float with
      Pre => X'Length > 0;

   function Median (X : Data_Array) return Long_Float is
      M : constant Natural := X'First + X'Last / 2;
   begin
      if X'Length rem 2 = 1 then
         return X (M);
      else
         return (X (M - 1) + X (M)) / 2.0;
      end if;
   end Median;

   procedure fivenum (X : Data_Array; Result : out Five_Num_Type) is
      Temp      : Data_Array := X;
      m         : Natural    := X'Length / 2;
      Lower_end : Natural    := (if X'Length rem 2 = 0 then m - 1 else m);
   begin
      Sort (Temp);
      Result (0) := Temp (Temp'First);
      Result (2) := Median (Temp);
      Result (4) := Temp (Temp'Last);
      Result (1) := Median (Temp (1 .. Lower_end));
      Result (3) := Median (Temp (m .. Temp'Last));
   end fivenum;

   procedure print (Result : Five_Num_Type; Aft : Natural) is
   begin
      Put ("[");
      for I in Result'Range loop
         Put (Item => Result (I), Fore => 1, Aft => Aft, Exp => 0);
         if I < Result'Last then
            Put (", ");
         else
            Put_Line ("]");
         end if;
      end loop;
      New_Line;
   end print;

   X1 : Data_Array :=
     (15.0, 6.0, 42.0, 41.0, 7.0, 36.0, 49.0, 40.0, 39.0, 47.0, 43.0);
   X2 : Data_Array := (36.0, 40.0, 7.0, 39.0, 41.0, 15.0);
   X3 : Data_Array :=
     (0.140_828_34, 0.097_487_90, 1.731_315_07, 0.876_360_09, -1.950_595_94,
      0.734_385_55, -0.030_357_26, 1.466_759_70, -0.746_213_49, -0.725_887_72,
      0.639_051_60, 0.615_015_27, -0.989_837_80, -1.004_478_74, -0.627_594_69,
      0.662_061_63, 1.043_120_09, -0.103_053_85, 0.757_756_34, 0.325_665_78);
   Result : Five_Num_Type;
begin
   fivenum (X1, Result);
   print (Result, 1);
   fivenum (X2, Result);
   print (Result, 1);
   fivenum (X3, Result);
   print (Result, 9);
end Main;