Merge branch 'coding-horror:main' into main

This commit is contained in:
Steve Bosman
2022-02-05 22:32:36 +00:00
committed by GitHub
7 changed files with 1160 additions and 0 deletions

View File

@@ -10,6 +10,8 @@ import java.util.stream.Collectors;
* Converted from BASIC to Java by Aldrin Misquitta (@aldrinm)
* The original BASIC program uses an array to maintain the questions and answers and to decide which question to
* ask next. Updated this Java implementation to use a tree instead of the earlier faulty one based on a list (thanks @patimen).
*
* Bonus option: TREE --> prints the game decision data as a tree to visualize/debug the state of the game
*/
public class Animal {

43
58_Love/ruby/love.rb Normal file
View File

@@ -0,0 +1,43 @@
data = [60, 1, 12, 26, 9, 12, 3, 8, 24, 17, 8, 4, 6, 23, 21, 6, 4, 6, 22, 12, 5, 6, 5,
4, 6, 21, 11, 8, 6, 4, 4, 6, 21, 10, 10, 5, 4, 4, 6, 21, 9, 11, 5, 4, 4, 6, 21,
8, 11, 6, 4, 4, 6, 21, 7, 11, 7, 4, 4, 6, 21, 6, 11, 8, 4, 4, 6, 19, 1, 1, 5,
11, 9, 4, 4, 6, 19, 1, 1, 5, 10, 10, 4, 4, 6, 18, 2, 1, 6, 8, 11, 4, 4, 6, 17,
3, 1, 7, 5, 13, 4, 4, 6, 15, 5, 2, 23, 5, 1, 29, 5, 17, 8, 1, 29, 9, 9, 12, 1,
13, 5, 40, 1, 1, 13, 5, 40, 1, 4, 6, 13, 3, 10, 6, 12, 5, 1, 5, 6, 11, 3, 11,
6, 14, 3, 1, 5, 6, 11, 3, 11, 6, 15, 2, 1, 6, 6, 9, 3, 12, 6, 16, 1, 1, 6, 6,
9, 3, 12, 6, 7, 1, 10, 7, 6, 7, 3, 13, 6, 6, 2, 10, 7, 6, 7, 3, 13, 14, 10, 8,
6, 5, 3, 14, 6, 6, 2, 10, 8, 6, 5, 3, 14, 6, 7, 1, 10, 9, 6, 3, 3, 15, 6, 16, 1,
1, 9, 6, 3, 3, 15, 6, 15, 2, 1, 10, 6, 1, 3, 16, 6, 14, 3, 1, 10, 10, 16, 6, 12,
5, 1, 11, 8, 13, 27, 1, 11, 8, 13, 27, 1, 60]
puts 'LOVE'.center(60)
puts 'stephan.com'.center(60)
puts "\n\n"
puts <<~EOLOVE
A TRIBUTE TO THE GREAT AMERICAN ARTIST, ROBERT INDIANA.
HIS GREATEST WORK WILL BE REPRODUCED WITH A MESSAGE OF
YOUR CHOICE UP TO 60 CHARACTERS. IF YOU CAN'T THINK OF
A MESSAGE, SIMPLY TYPE THE WORD 'LOVE'\n
EOLOVE
message = gets.strip
message = 'love' if message.empty?
l = message.length
until data.empty?
puts
col = 0
p = true
while col < 60
run = data.shift
if p
run.times { |i| print message[(col + i) % l] }
else
print ' ' * run
end
p = !p
col += run
end
end

View File

@@ -1,3 +1,7 @@
Original source downloaded [from Vintage Basic](http://www.vintage-basic.net/games.html)
Conversion to [Perl](https://www.perl.org/)
This is pretty much a re-implementation of the BASIC, taking advantage
of Perl's array functionality and working directly with the alphabetic
color codes.

419
60_Mastermind/perl/mastermind.pl Executable file
View File

@@ -0,0 +1,419 @@
#!/usr/bin/env perl
use 5.010; # To get 'state' and 'say'
use strict; # Require explicit declaration of variables
use warnings; # Enable optional compiler warnings
use English; # Use more friendly names for Perl's magic variables
use List::Util qw{ min sum }; # Convenient list utilities
use Term::ReadLine; # Prompt and return user input
our $VERSION = '0.000_01';
use constant MAX_GUESSES => 10;
print <<'EOD';
MASTERMIND
Creative Computing Morristown, New Jersey
EOD
=begin comment
MASTERMIND II
STEVE NORTH
CREATIVE COMPUTING
PO BOX 789-M MORRISTOWN NEW JERSEY 07960
=end comment
=cut
# NOTE that mixed-case 'my' variables are 'global' in the sense that
# they are used in subroutines, but not passed to them.
say '';
my $number_of_colors = get_input(
'Number of colors [1-8]: ',
sub { m/ \A [1-8] \z /smx },
"No more than 8, please!\n",
);
say '';
my $Number_of_Positions = get_input(
'Number of positions: ',
sub { m/ \A [0-9]+ \z /smx && $ARG },
"A positive number, please\n",
);
say '';
my $number_of_rounds = get_input(
'Number of rounds: ',
sub { m/ \A [0-9]+ \z /smx && $ARG },
"A positive number, please\n",
);
my $P = $number_of_colors ** $Number_of_Positions;
say 'Total possibilities = ', $P;
my @colors = ( qw{
Black White Red Green Orange Yellow Purple Tan
})[ 0 .. $number_of_colors - 1 ];
my @Color_Codes = map { uc substr $ARG, 0, 1 } @colors;
print <<'EOD';
Color Letter
===== ======
EOD
foreach my $inx ( 0 .. $#colors ) {
printf "%-13s%s\n", $colors[$inx], $Color_Codes[$inx];
}
say '';
my $computer_score = 0; # Computer score
my $human_score = 0; # Human score
foreach my $round_number ( 1 .. $number_of_rounds ) {
print <<"EOD";
Round number $round_number ----
Guess my combination.
EOD
$human_score += human_guesses( $Number_of_Positions );
print_score( $computer_score, $human_score );
$computer_score += computer_guesses();
print_score( $computer_score, $human_score );
}
# Make a $pattern into a hash with one key for each possible color. The
# value for each color is the number of times it appears in the pattern.
sub hashify_pattern {
my $pattern = uc $ARG[0];
my %p = map { $ARG => 0 } @Color_Codes;
$p{$ARG}++ for split qr//, $pattern;
return \%p;
}
# Given a $pattern, a $guess at that pattern, and $black and $white
# scores, return a true value if the $black and $white scores of the
# $guess are those supplied as arguments; otherwise return a false
# value. This is used by computer_guesses() to eliminate possibilities.
sub analyze_black_white {
my ( $pattern, $guess, $black, $white ) = @ARG;
my $info = analyze_guess( $pattern, $guess );
return $info->{black} == $black && $info->{white} == $white;
}
# Given a $pattern and a $guess at that pattern, return a reference to a
# hash with the following keys:
# {guess} is the guess;
# {black} is the black score of the guess
# {white} is the white score of the guess
sub analyze_guess {
my ( $pattern, $guess ) = @ARG;
my $pattern_hash = hashify_pattern( $pattern );
my $guess_hash = hashify_pattern( $guess );
my $white = sum(
map { min( $pattern_hash->{$ARG}, $guess_hash->{$ARG} ) } @Color_Codes,
);
my $black = 0;
foreach my $inx ( 0 .. length( $pattern ) - 1 ) {
if ( substr( $pattern, $inx, 1 ) eq substr( $guess, $inx, 1 ) )
{
$black++;
--$white;
}
}
return +{
guess => $guess,
black => $black,
white => $white,
}
}
# Used by the computer to guess the human's choice. The return is the
# number of guesses the computer took. The return is the maximum plus
# one if the computer failed to guess.
sub computer_guesses {
print <<'EOD';
Now I guess. Think of a combination.
EOD
get_input(
'Hit <return> when ready:',
);
# Generate all possible permutations.
my @possible;
foreach my $permutation ( 0 .. @Color_Codes ** $Number_of_Positions - 1 ) {
my $guess;
for ( 1 .. $Number_of_Positions ) {
my $inx = $permutation % @Color_Codes;
$guess .= $Color_Codes[ $inx ];
$permutation = int( $permutation / @Color_Codes );
}
push @possible, $guess;
}
# Guess ...
foreach my $guess_num ( 1 .. MAX_GUESSES ) {
# Guess a possible permutation at random, removing it from the
# list.
my $guess = splice @possible, int rand @possible, 1;
say 'My guess is: ', $guess;
# Find out its black/white score.
my ( $black, $white ) = split qr< , >smx, get_input(
'Blacks, Whites: ',
sub { m/ \A [0-9]+ , [0-9]+ \z /smx },
"Please enter two unsigned integers\n",
);
# If it's all black, the computer wins.
if ( $black == $Number_of_Positions ) {
say "I got it in $guess_num moves!";
return $guess_num;
}
# Eliminate all possible permutations that give the black/white
# score that our guess got. If there are any left, take another
# guess.
next if @possible = grep { analyze_black_white( $ARG, $guess, $black,
$white ) } @possible;
# There were no permutations left. Complain.
print <<'EOD';
You have given me inconsistent information.
Try again, and this time please be more careful.
EOD
goto &computer_guesses; # Tail-call ourselves to try again.
}
print <<'EOD';
I used up all my moves!
I guess my CPU is just having an off day.
EOD
return MAX_GUESSES + 1;
}
# Used to generate a pattern and process the human's guesses. The return
# is the number of guesses the human took. The return is the maximum
# plus one if the human failed to guess.
sub human_guesses {
my @saved_moves; # Saved moves
my $pattern = uc join '',
map { $Color_Codes[ rand @Color_Codes ] } 1 .. $Number_of_Positions;
foreach my $guess_num ( 1 .. MAX_GUESSES ) {
my $guess = uc get_input(
"Move # $guess_num guess: ",
sub {
# If the user entered 'quit', bail out.
if ( m/ \A quit \z /smxi ) {
die "Quitter! My combination was $pattern\n\nGood bye\n";
}
# If the user entered 'board', display the board so far.
# We return success to prevent the warning message, but
# we also clear $ARG. The caller's caller sees this and
# re-queries.
if ( m/ \A board \z /smxi ) {
print <<'EOD';
Board
Move Guess Black White
EOD
my $number = 1;
foreach my $item ( @saved_moves ) {
printf "%4d %-13s %3d %3d\n", $number++,
@{ $item }{ qw{ guess black white } };
}
return undef; # Validation failure, but suppress warning.
}
# End of special-case code. Below here we are dealing
# with guess input.
# The length of the input must equal the number of
# positions.
if ( $Number_of_Positions != length ) {
warn "Bad number of positions\n";
return 0;
}
# The input may contain only valid color codes.
state $invalid_color = do { # Evaluated only once
local $LIST_SEPARATOR = '';
qr< [^@Color_Codes] >smxi;
};
if ( m/ ( $invalid_color ) /smxi ) {
warn "'$1' is unrecognized.\n";
return 0;
}
# We're good.
return 1;
},
"Please enter 'board', 'quit', or any $Number_of_Positions of @{[
join ', ', map { qq<'$ARG'> } @Color_Codes ]}.\n",
);
my $rslt = analyze_guess( $pattern, $guess );
push @saved_moves, $rslt;
if ( $rslt->{black} == $Number_of_Positions ) {
say "You guessed it in $guess_num moves.";
return $guess_num;
}
say "You have $rslt->{black} blacks and $rslt->{white} whites.";
}
print <<"EOD";
You ran out of moves. That's all you get.
The actual combination was: $pattern
EOD
return MAX_GUESSES + 1;
}
# Print the $computer and $human score
sub print_score {
my ( $computer, $human ) = @ARG;
print <<"EOD";
Score:
Computer: $computer
Human: $human
EOD
return;
}
# Get input from the user. The arguments are:
# * The prompt
# * A reference to validation code. This code receives the response in
# $ARG and returns true for a valid response.
# * A warning to print if the response is not valid. This must end in a
# return. It is suppressed if the validation code returned undef.
# The first valid response is returned. An end-of-file terminates the
# script.
sub get_input {
my ( $prompt, $validate, $warning ) = @ARG;
# If no validator is passed, default to one that always returns
# true.
$validate ||= sub { 1 };
# Create the readline object. The 'state' causes the variable to be
# initialized only once, no matter how many times this subroutine is
# called. The do { ... } is a compound statement used because we
# need to tweak the created object before we store it.
state $term = do {
my $obj = Term::ReadLine->new( 'reverse' );
$obj->ornaments( 0 );
$obj;
};
while ( 1 ) { # Iterate indefinitely
# Read the input into the topic variable, localized to prevent
# Spooky Action at a Distance. We exit on undef, which signals
# end-of-file.
exit unless defined( local $ARG = $term->readline( $prompt ) );
# Return the input if it is valid.
return $ARG if my $rslt = $validate->();
# Issue the warning, and go around the merry-go-round again.
warn $warning if defined $rslt;
}
}
# NOTE the following is unused, but left in place in case someone wants
# to add a 'Do you want instructions?'
#
# Get a yes-or-no answer. The argument is the prompt, which will have
# '? [y/n]: ' appended. The donkey work is done by get_input(), which is
# requested to validate the response as beginning with 'y' or 'n',
# case-insensitive. The return is a true value for 'y' and a false value
# for 'n'.
sub get_yes_no {
my ( $prompt ) = @ARG;
state $map_answer = {
n => 0,
y => 1,
};
my $resp = lc get_input(
"$prompt? [y/n]: ",
sub { m/ \A [yn] /smxi },
"Please respond 'y' or 'n'\n",
);
return $map_answer->{ substr $resp, 0, 1 };
}
__END__
=head1 TITLE
mastermind - Play the game 'Mastermind' from Basic Computer Games
=head1 SYNOPSIS
mastermind.pl
=head1 DETAILS
This Perl script is a port of mastermind, which is the 60th
entry in Basic Computer Games.
This is pretty much a re-implementation of the BASIC, taking advantage
of Perl's array functionality and working directly with the alphabetic
color codes.
=head1 PORTED BY
Thomas R. Wyant, III F<wyant at cpan dot org>
=head1 COPYRIGHT AND LICENSE
Copyright (C) 2022 by Thomas R. Wyant, III
This program is free software; you can redistribute it and/or modify it
under the same terms as Perl 5.10.0. For more details, see the Artistic
License 1.0 at
L<https://www.perlfoundation.org/artistic-license-10.html>, and/or the
Gnu GPL at L<http://www.gnu.org/licenses/old-licenses/gpl-1.0.txt>.
This program is distributed in the hope that it will be useful, but
without any warranty; without even the implied warranty of
merchantability or fitness for a particular purpose.
=cut
# ex: set expandtab tabstop=4 textwidth=72 :

View File

@@ -0,0 +1,426 @@
import java.util.ArrayList;
import java.util.InputMismatchException;
import java.util.List;
import java.util.Random;
import java.util.Scanner;
/**
* Stock Market Simulation
*
* Some of the original program's variables' documentation and their equivalent in this program:
* A-MRKT TRND SLP; marketTrendSlope
* B5-BRKRGE FEE; brokerageFee
* C-TTL CSH ASSTS; cashAssets
* C5-TTL CSH ASSTS (TEMP); tmpCashAssets
* C(I)-CHNG IN STK VAL; changeStockValue
* D-TTL ASSTS; assets
* E1,E2-LRG CHNG MISC; largeChange1, largeChange2
* I1,I2-STCKS W LRG CHNG; randomStockIndex1, randomStockIndex2
* N1,N2-LRG CHNG DAY CNTS; largeChangeNumberDays1, largeChangeNumberDays2
* P5-TTL DAYS PRCHSS; totalDaysPurchases
* P(I)-PRTFL CNTNTS; portfolioContents
* Q9-NEW CYCL?; newCycle
* S4-SGN OF A; slopeSign
* S5-TTL DYS SLS; totalDaysSales
* S(I)-VALUE/SHR; stockValue
* T-TTL STCK ASSTS; totalStockAssets
* T5-TTL VAL OF TRNSCTNS; totalValueOfTransactions
* W3-LRG CHNG; bigChange
* X1-SMLL CHNG(<$1); smallChange
* Z4,Z5,Z6-NYSE AVE.; tmpNyseAverage, nyseAverage, nyseAverageChange
* Z(I)-TRNSCT transactionQuantity
*
* new price = old price + (trend x old price) + (small random price
* change) + (possible large price change)
*
* Converted from BASIC to Java by Aldrin Misquitta (@aldrinm)
*/
public class StockMarket {
private static final Random random = new Random();
public static void main(String[] args) {
Scanner scan = new Scanner(System.in);
printIntro();
printGameHelp(scan);
final List<Stock> stocks = initStocks();
double marketTrendSlope = Math.floor((random.nextFloat() / 10) * 100 + 0.5)/100f;
double totalValueOfTransactions;
int largeChangeNumberDays1 = 0;
int largeChangeNumberDays2 = 0;
//DAYS FOR FIRST TREND SLOPE (A)
var t8 = randomNumber(1, 6);
//RANDOMIZE SIGN OF FIRST TREND SLOPE (A)
if (random.nextFloat() <= 0.5) {
marketTrendSlope = -marketTrendSlope;
}
// INITIALIZE CASH ASSETS:C
double cashAssets = 10000;
boolean largeChange1 = false;
boolean largeChange2 = false;
double tmpNyseAverage;
double nyseAverage = 0;
boolean inProgress = true;
var firstRound = true;
while (inProgress) {
/* Original documentation:
RANDOMLY PRODUCE NEW STOCK VALUES BASED ON PREVIOUS DAY'S VALUES
N1,N2 ARE RANDOM NUMBERS OF DAYS WHICH RESPECTIVELY
DETERMINE WHEN STOCK I1 WILL INCREASE 10 PTS. AND STOCK
I2 WILL DECREASE 10 PTS.
IF N1 DAYS HAVE PASSED, PICK AN I1, SET E1, DETERMINE NEW N1
*/
int randomStockIndex1 = 0;
int randomStockIndex2 = 0;
if (largeChangeNumberDays1 <= 0) {
randomStockIndex1 = randomNumber(0, stocks.size());
largeChangeNumberDays1 = randomNumber(1, 6);
largeChange1 = true;
}
if (largeChangeNumberDays2 <= 0) {
randomStockIndex2 = randomNumber(0, stocks.size());
largeChangeNumberDays2 = randomNumber(1, 6);
largeChange2 = true;
}
adjustAllStockValues(stocks, largeChange1, largeChange2, marketTrendSlope, stocks.get(randomStockIndex1), stocks.get(randomStockIndex2));
//reset largeChange flags
largeChange1 = false;
largeChange2 = false;
largeChangeNumberDays1--;
largeChangeNumberDays2--;
//AFTER T8 DAYS RANDOMLY CHANGE TREND SIGN AND SLOPE
t8 = t8 - 1;
if (t8 < 1) {
marketTrendSlope = newMarketTrendSlope();
t8 = randomNumber(1, 6);
}
//PRINT PORTFOLIO
printPortfolio(firstRound, stocks);
tmpNyseAverage = nyseAverage;
nyseAverage = 0;
double totalStockAssets = 0;
for (Stock stock : stocks) {
nyseAverage = nyseAverage + stock.getStockValue();
totalStockAssets = totalStockAssets + stock.getStockValue() * stock.getPortfolioContents();
}
nyseAverage = Math.floor(100 * (nyseAverage / 5) + .5) / 100f;
double nyseAverageChange = Math.floor((nyseAverage - tmpNyseAverage) * 100 + .5) / 100f;
// TOTAL ASSETS:D
double assets = totalStockAssets + cashAssets;
if (firstRound) {
System.out.printf("\n\nNEW YORK STOCK EXCHANGE AVERAGE: %.2f", nyseAverage);
} else {
System.out.printf("\n\nNEW YORK STOCK EXCHANGE AVERAGE: %.2f NET CHANGE %.2f", nyseAverage, nyseAverageChange);
}
totalStockAssets = Math.floor(100 * totalStockAssets + 0.5) / 100d;
System.out.printf("\n\nTOTAL STOCK ASSETS ARE $ %.2f", totalStockAssets);
cashAssets = Math.floor(100 * cashAssets + 0.5) / 100d;
System.out.printf("\nTOTAL CASH ASSETS ARE $ %.2f", cashAssets);
assets = Math.floor(100 * assets + .5) / 100d;
System.out.printf("\nTOTAL ASSETS ARE $ %.2f\n", assets);
if (!firstRound) {
System.out.print("\nDO YOU WISH TO CONTINUE (YES-TYPE 1, NO-TYPE 0)? ");
var newCycle = readANumber(scan);
if (newCycle < 1) {
System.out.println("HOPE YOU HAD FUN!!");
inProgress = false;
}
}
if (inProgress) {
boolean validTransaction = false;
// TOTAL DAY'S PURCHASES IN $:P5
double totalDaysPurchases = 0;
// TOTAL DAY'S SALES IN $:S5
double totalDaysSales = 0;
double tmpCashAssets;
while (!validTransaction) {
//INPUT TRANSACTIONS
readStockTransactions(stocks, scan);
totalDaysPurchases = 0;
totalDaysSales = 0;
validTransaction = true;
for (Stock stock : stocks) {
stock.setTransactionQuantity(Math.floor(stock.getTransactionQuantity() + 0.5));
if (stock.getTransactionQuantity() > 0) {
totalDaysPurchases = totalDaysPurchases + stock.getTransactionQuantity() * stock.getStockValue();
} else {
totalDaysSales = totalDaysSales - stock.getTransactionQuantity() * stock.getStockValue();
if (-stock.getTransactionQuantity() > stock.getPortfolioContents()) {
System.out.println("YOU HAVE OVERSOLD A STOCK; TRY AGAIN.");
validTransaction = false;
break;
}
}
}
//TOTAL VALUE OF TRANSACTIONS:T5
totalValueOfTransactions = totalDaysPurchases + totalDaysSales;
// BROKERAGE FEE:B5
var brokerageFee = Math.floor(0.01 * totalValueOfTransactions * 100 + .5) / 100d;
// CASH ASSETS=OLD CASH ASSETS-TOTAL PURCHASES
//-BROKERAGE FEES+TOTAL SALES:C5
tmpCashAssets = cashAssets - totalDaysPurchases - brokerageFee + totalDaysSales;
if (tmpCashAssets < 0) {
System.out.printf("\nYOU HAVE USED $%.2f MORE THAN YOU HAVE.", -tmpCashAssets);
validTransaction = false;
} else {
cashAssets = tmpCashAssets;
}
}
// CALCULATE NEW PORTFOLIO
for (Stock stock : stocks) {
stock.setPortfolioContents(stock.getPortfolioContents() + stock.getTransactionQuantity());
}
firstRound = false;
}
}
}
/**
* Random int between lowerBound(inclusive) and upperBound(exclusive)
*/
private static int randomNumber(int lowerBound, int upperBound) {
return random.nextInt((upperBound - lowerBound)) + lowerBound;
}
private static double newMarketTrendSlope() {
return randomlyChangeTrendSignAndSlopeAndDuration();
}
private static void printPortfolio(boolean firstRound, List<Stock> stocks) {
//BELL RINGING-DIFFERENT ON MANY COMPUTERS
if (firstRound) {
System.out.printf("%n%-30s\t%12s\t%12s", "STOCK", "INITIALS", "PRICE/SHARE");
for (Stock stock : stocks) {
System.out.printf("%n%-30s\t%12s\t%12.2f ------ %12.2f", stock.getStockName(), stock.getStockCode(),
stock.getStockValue(), stock.getChangeStockValue());
}
System.out.println("");
} else {
System.out.println("\n********** END OF DAY'S TRADING **********\n\n");
System.out.printf("%n%-12s\t%-12s\t%-12s\t%-12s\t%-20s", "STOCK", "PRICE/SHARE",
"HOLDINGS", "VALUE", "NET PRICE CHANGE");
for (Stock stock : stocks) {
System.out.printf("%n%-12s\t%-12.2f\t%-12.0f\t%-12.2f\t%-20.2f",
stock.getStockCode(), stock.getStockValue(), stock.getPortfolioContents(),
stock.getStockValue() * stock.getPortfolioContents(), stock.getChangeStockValue());
}
}
}
private static void readStockTransactions(List<Stock> stocks, Scanner scan) {
System.out.println("\n\nWHAT IS YOUR TRANSACTION IN");
for (Stock stock : stocks) {
System.out.printf("%s? ", stock.getStockCode());
stock.setTransactionQuantity(readANumber(scan));
}
}
private static int readANumber(Scanner scan) {
int choice = 0;
boolean validInput = false;
while (!validInput) {
try {
choice = scan.nextInt();
validInput = true;
} catch (InputMismatchException ex) {
System.out.println("!NUMBER EXPECTED - RETRY INPUT LINE");
} finally {
scan.nextLine();
}
}
return choice;
}
private static void adjustAllStockValues(List<Stock> stocks, boolean largeChange1,
boolean largeChange2,
double marketTrendSlope,
Stock stockForLargeChange1, Stock stockForLargeChange2
) {
//LOOP THROUGH ALL STOCKS
for (Stock stock : stocks) {
double smallChange = random.nextFloat();
if (smallChange <= 0.25) {
smallChange = 0.25;
} else if (smallChange <= 0.5) {
smallChange = 0.5;
} else if (smallChange <= 0.75) {
smallChange = 0.75;
} else {
smallChange = 0;
}
//BIG CHANGE CONSTANT:W3 (SET TO ZERO INITIALLY)
var bigChange = 0;
if (largeChange1) {
if (stock.getStockCode().equals(stockForLargeChange1.getStockCode())) {
//ADD 10 PTS. TO THIS STOCK; RESET E1
bigChange = 10;
}
}
if (largeChange2) {
if (stock.getStockCode().equals(stockForLargeChange2.getStockCode())) {
//SUBTRACT 10 PTS. FROM THIS STOCK; RESET E2
bigChange = bigChange - 10;
}
}
stock.setChangeStockValue(Math.floor(marketTrendSlope * stock.stockValue) + smallChange +
Math.floor(3 - 6 * random.nextFloat() + .5) + bigChange);
stock.setChangeStockValue(Math.floor(100 * stock.getChangeStockValue() + .5) / 100d);
stock.stockValue += stock.getChangeStockValue();
if (stock.stockValue > 0) {
stock.stockValue = Math.floor(100 * stock.stockValue + 0.5) / 100d;
} else {
stock.setChangeStockValue(0);
stock.stockValue = 0;
}
}
}
private static double randomlyChangeTrendSignAndSlopeAndDuration() {
// RANDOMLY CHANGE TREND SIGN AND SLOPE (A), AND DURATION
var newTrend = Math.floor((random.nextFloat() / 10) * 100 + .5) / 100d;
var slopeSign = random.nextFloat();
if (slopeSign > 0.5) {
newTrend = -newTrend;
}
return newTrend;
}
private static List<Stock> initStocks() {
List<Stock> stocks = new ArrayList<>();
stocks.add(new Stock(100, "INT. BALLISTIC MISSILES", "IBM"));
stocks.add(new Stock(85, "RED CROSS OF AMERICA", "RCA"));
stocks.add(new Stock(150, "LICHTENSTEIN, BUMRAP & JOKE", "LBJ"));
stocks.add(new Stock(140, "AMERICAN BANKRUPT CO.", "ABC"));
stocks.add(new Stock(110, "CENSURED BOOKS STORE", "CBS"));
return stocks;
}
private static void printGameHelp(Scanner scan) {
System.out.print("DO YOU WANT THE INSTRUCTIONS (YES-TYPE 1, NO-TYPE 0) ? ");
int choice = scan.nextInt();
if (choice >= 1) {
System.out.println("");
System.out.println("THIS PROGRAM PLAYS THE STOCK MARKET. YOU WILL BE GIVEN");
System.out.println("$10,000 AND MAY BUY OR SELL STOCKS. THE STOCK PRICES WILL");
System.out.println("BE GENERATED RANDOMLY AND THEREFORE THIS MODEL DOES NOT");
System.out.println("REPRESENT EXACTLY WHAT HAPPENS ON THE EXCHANGE. A TABLE");
System.out.println("OF AVAILABLE STOCKS, THEIR PRICES, AND THE NUMBER OF SHARES");
System.out.println("IN YOUR PORTFOLIO WILL BE PRINTED. FOLLOWING THIS, THE");
System.out.println("INITIALS OF EACH STOCK WILL BE PRINTED WITH A QUESTION");
System.out.println("MARK. HERE YOU INDICATE A TRANSACTION. TO BUY A STOCK");
System.out.println("TYPE +NNN, TO SELL A STOCK TYPE -NNN, WHERE NNN IS THE");
System.out.println("NUMBER OF SHARES. A BROKERAGE FEE OF 1% WILL BE CHARGED");
System.out.println("ON ALL TRANSACTIONS. NOTE THAT IF A STOCK'S VALUE DROPS");
System.out.println("TO ZERO IT MAY REBOUND TO A POSITIVE VALUE AGAIN. YOU");
System.out.println("HAVE $10,000 TO INVEST. USE INTEGERS FOR ALL YOUR INPUTS.");
System.out.println("(NOTE: TO GET A 'FEEL' FOR THE MARKET RUN FOR AT LEAST");
System.out.println("10 DAYS)");
System.out.println("-----GOOD LUCK!-----");
}
System.out.println("\n\n");
}
private static void printIntro() {
System.out.println(" STOCK MARKET");
System.out.println(" CREATIVE COMPUTING MORRISTOWN, NEW JERSEY");
System.out.println("\n\n");
}
/**
* Stock class also storing the stock information and other related information for simplicity
*/
private static class Stock {
private final String stockName;
private final String stockCode;
private double stockValue;
private double portfolioContents = 0;
private double transactionQuantity = 0;
private double changeStockValue = 0;
public Stock(double stockValue, String stockName, String stockCode) {
this.stockValue = stockValue;
this.stockName = stockName;
this.stockCode = stockCode;
}
public String getStockName() {
return stockName;
}
public String getStockCode() {
return stockCode;
}
public double getStockValue() {
return stockValue;
}
public double getPortfolioContents() {
return portfolioContents;
}
public void setPortfolioContents(double portfolioContents) {
this.portfolioContents = portfolioContents;
}
public double getTransactionQuantity() {
return transactionQuantity;
}
public void setTransactionQuantity(double transactionQuantity) {
this.transactionQuantity = transactionQuantity;
}
public double getChangeStockValue() {
return changeStockValue;
}
public void setChangeStockValue(double changeStockValue) {
this.changeStockValue = changeStockValue;
}
@Override
public String toString() {
return "Stock{" +
"stockValue=" + stockValue +
", stockCode='" + stockCode + '\'' +
", portfolioContents=" + portfolioContents +
", transactionQuantity=" + transactionQuantity +
", changeStockValue=" + changeStockValue +
'}';
}
}
}

View File

@@ -1,3 +1,20 @@
Original source downloaded [from Vintage Basic](http://www.vintage-basic.net/games.html)
Conversion to [Perl](https://www.perl.org/)
I have replaced the manual date logic with Perl built-ins to the extent
possible. Unfortunately the kind of date math involved in the "time
spent doing ..." functionality is not well-defined, so I have been
forced to retain the original logic here. Sigh.
You can use any punctuation character you please in the date
input. So something like 2/29/2020 is perfectly acceptable.
It would also have been nice to produce a localized version that
supports day/month/year or year-month-day input, but that didn't happen.
Also nice would have been language-specific output -- especially if it
could have accommodated regional differences in which day of the week or
month is unlucky.
Tom Wyant

249
95_Weekday/perl/weekday.pl Executable file
View File

@@ -0,0 +1,249 @@
#!/usr/bin/env perl
use 5.010; # To get 'state' and 'say'
use strict; # Require explicit declaration of variables
use warnings; # Enable optional compiler warnings
use English; # Use more friendly names for Perl's magic variables
use Term::ReadLine; # Prompt and return user input
use Time::Local qw{ timelocal }; # date-time to epoch
# FIXME timelocal() is too smart for its own good in the interpretation
# of years, and caused a bunch of Y2020 problems in Perl code that used
# it. I believe that this script avoids these problems (which only occur
# if the year is less than 1000), but it is probably safer in general to
# use timelocal_modern() or timelocal_posix(). These are also exported
# by Time::Local, but only by versions 1.28 and 1.30 respectively. This
# means that they only come (by default) with Perl 5.30 and 5.34
# respectively. Now, Time::Local is a dual-life module, meaning it can
# be upgraded from the version packaged with older Perls. But I did not
# want to assume that it HAD been upgraded. Caveat coder.
use Time::Piece; # O-O epoch to date-time, plus formatting
our $VERSION = '0.000_01';
print <<'EOD';
WEEKDAY
Creative Computing Morristown, New Jersey
WEEKDAY is a computer demonstration that
gives facts about a date of interest to you.
EOD
my $now = localtime;
my $default_date = join ',', map { $now->$_() } qw{ mon mday year };
my $today = get_date(
"Enter today's date in the form month,day,year (default: $default_date): ",
"Please enter month,day,year or return for default\n",
$default_date,
);
my $birthday = get_date(
'Ender day of birth (or other day of interest): ',
"Please enter month,day,year\n",
);
say '';
printf "%d/%d/%d %s a %s\n", $birthday->mon, $birthday->mday,
$birthday->year, tense( $today, $birthday),
( $birthday->mday == 13 && $birthday->wday == 6 ) ?
$birthday->fullday . ' the thirteenth --- Beware!' :
$birthday->fullday . '.';
if ( $birthday->epoch <= $today->epoch ) {
say '*** Happy Birthday! ***'
if $birthday->mon == $today->mon &&
$birthday->mday == $today->mday;
print <<'EOD';
Years Months Days
----- ------ ----
EOD
my @delta = map { $today->$_() - $birthday->$_() } qw{ year mon mday };
if ( $delta[2] < 0 ) {
$delta[2] += 30;
$delta[1] -= 1;
}
if ( $delta[1] < 0 ) {
$delta[1] += 12;
$delta[0] -= 1;
}
my @residue = @delta;
my $delta_days = 365 * $delta[0] + 30 * $delta[1] + $delta[2];
display_ymd( 'Your age (if birthdate)', compute_ymd( $delta_days ) );
display_ymd( 'You have slept', compute_ymd( $delta_days, 0.35,
\@residue ) );
display_ymd( 'You have eaten', compute_ymd( $delta_days, 0.17,
\@residue ) );
display_ymd(
$residue[0] > 9 ? 'You have worked/played' :
$residue[0] > 3 ? 'You have played/studied' :
'You have played',
compute_ymd( $delta_days, 0.23,
\@residue ) );
display_ymd( 'You have relaxed', \@residue );
say '';
say "\t\t*** You may retire in @{[ $birthday->year + 65 ]} ***";
}
say '';
sub compute_ymd {
my ( $delta_days, $fract, $residue ) = @ARG;
my $days = defined $fract ? int ( $delta_days * $fract ) : $delta_days;
my $years = int( $days / 365 );
$days -= $years * 365;
my $months = int( $days / 30 );
$days -= $months * 30;
if ( $residue ) {
$residue->[2] -= $days;
if ( $residue->[2] < 0 ) {
$residue->[2] += 30;
$residue->[1] -= 1;
}
$residue->[1] -= $months;
if ( $residue->[1] < 0 ) {
$residue->[1] += 12;
$residue->[0] -= 1;
}
$residue->[0] -= $years;
}
return [ $years, $months, $days ];
}
sub display_ymd {
my ( $label, $ymd ) = @ARG;
printf "%-24s%4d%6d%8d\n", $label, @{ $ymd };
return;
}
sub get_date {
my ( $prompt, $warning, $default ) = @ARG;
my ( $month, $day, $year ) = split qr< [[:punct:]] >smx, get_input(
$prompt,
sub {
return 0 unless m/ \A (?: [0-9]+ [[:punct:]] ){2} ( [0-9]+ ) \z /smx;
return 1 if $1 >= 1582;
warn "Not prepared to give day of week prior to MDLXXXII.\n";
return 0;
},
$warning,
$default,
);
return localtime timelocal( 0, 0, 0, $day, $month - 1, $year );
}
sub tense {
my ( $today, $birthday ) = @ARG;
my $cmp = $birthday->epoch <=> $today->epoch
or return 'is';
return $cmp < 0 ? 'was' : 'will be';
}
# Get input from the user. The arguments are:
# * The prompt
# * A reference to validation code. This code receives the response in
# $ARG and returns true for a valid response.
# * A warning to print if the response is not valid. This must end in a
# return.
# * A default to return if the user simply presses <return>.
# The first valid response is returned. An end-of-file terminates the
# script.
sub get_input {
my ( $prompt, $validate, $warning, $default ) = @ARG;
# If no validator is passed, default to one that always returns
# true.
$validate ||= sub { 1 };
# Create the readline object. The 'state' causes the variable to be
# initialized only once, no matter how many times this subroutine is
# called. The do { ... } is a compound statement used because we
# need to tweak the created object before we store it.
state $term = do {
my $obj = Term::ReadLine->new( 'reverse' );
$obj->ornaments( 0 );
$obj;
};
while ( 1 ) { # Iterate indefinitely
# Read the input into the topic variable, localized to prevent
# Spooky Action at a Distance. We exit on undef, which signals
# end-of-file.
exit unless defined( local $ARG = $term->readline( $prompt ) );
# Return the default if it exists AND we got an empty line
return $default if defined( $default ) && $ARG eq '';
# Return the input if it is valid.
return $ARG if $validate->();
# Issue the warning, and go around the merry-go-round again.
warn $warning;
}
}
__END__
=head1 TITLE
weekday - Play the game 'Weekday' from Basic Computer Games
=head1 SYNOPSIS
weekday.pl
=head1 DETAILS
This Perl script is a port of weekday.bas, which is the 95th entry in
Basic Computer Games.
I have replaced the manual date logic with Perl built-ins to the extent
possible. Unfortunately the kind of date math involved in the "time
spent doing ..." functionality is not well-defined, so I have been
forced to retain the original logic here. Sigh.
You can use any punctuation character you please in the date
input. So something like 2/29/2020 is perfectly acceptable.
It would also have been nice to produce a localized version that
supports day/month/year or year-month-day input, but that didn't happen.
Also nice would have been language-specific output -- especially if it
could have accommodated regional differences in which day of the week or
month is unlucky.
=head1 PORTED BY
Thomas R. Wyant, III F<wyant at cpan dot org>
=head1 COPYRIGHT AND LICENSE
Copyright (C) 2022 by Thomas R. Wyant, III
This program is free software; you can redistribute it and/or modify it
under the same terms as Perl 5.10.0. For more details, see the Artistic
License 1.0 at
L<https://www.perlfoundation.org/artistic-license-10.html>, and/or the
Gnu GPL at L<http://www.gnu.org/licenses/old-licenses/gpl-1.0.txt>.
This program is distributed in the hope that it will be useful, but
without any warranty; without even the implied warranty of
merchantability or fitness for a particular purpose.
=cut
# ex: set expandtab tabstop=4 textwidth=72 :