BitFoam

More Monster Maze

Mon, 22 Apr 2024 00:00:00 +0000

A lot has happened in Monster Maze for the last months and a new chapter has now opened.

(previously seen in this series: Shiny Monster Maze and Monster Maze)

Wanna play?

Play here

Code

The code is publicly available in Github:

monster-maze-shiny-mobile/tree/from_emojis_to_images

Time-keeping

In the prior version of the game, time-keeping was turn-based and sequential, I-Go-You-Go. And the speed of any change in the game referred to the player´s speed. Simple put, things took a number of player´s moves to change or happen, most notably, the ghosts appearing and disappearing and the zombies moving.

Now time progresses according to the game clock and the speed of the characters is based on the clock. This is arguably when it comes to the player though, in this case her speed is limited by the player herself and the response time of the game, meaning that is not capped to any specific value (Wikipedia contributors (2023)).

In this case the time is not continuous and passes in discrete units of 1 sec (1000 ms). This can be easily achieved through the function reactiveTimer that invalidates the context next time the interval elapses.

WARNING

I haven´t settled down on a naming convention yet, moving between camelCase and snake_case, it is difficult to stick to one when the packages I use don't do it.

A few additional reactive values are required to harness the power of time.

timerRunning: this flag allows to pause the master clock.
afterIntro: this flag indicates the tipping event when game time starts.
ghostTimer and zombieTimer are used to determine ghost and zombie speeds based on the master clock.

1  #timer
2  autoInvalidate <- reactiveTimer(1000)
3  timerRunning = reactiveVal(NULL)
4  afterIntro = reactiveVal(NULL)
5  ghostTimer = reactiveVal(0)
6  zombieTimer = reactiveVal(0)

The observeEvent function that initializes the values has changed slightly to accommodate the changes.

 1 # set the initial values 
 2  observeEvent(TRUE, ignoreNULL = FALSE, ignoreInit = FALSE, once = TRUE, {
 3      game_info$scene = "intro"
 4      renderEvent(TRUE)
 5      hide_action_buttons()
 6      timerRunning(FALSE)
 7      afterIntro(FALSE)
 8      console$data <- "Nobody believes me.
 9There is no hope for them...
10...unless I do it myself.
11I couldn´t look myself 
12in the mirror.
13I have to go back 
14and save their souls.
15"
16  })

A new Observe function is invoked every time the reactiveTimer invalidates the context. This function represents the master clock.

 1  
 2    observe({
 3    # Invalidate and re-execute this reactive expression every time the
 4    # timer fires.
 5    autoInvalidate()
 6    if (timerRunning()) {
 7      isolate(level_timer(level_timer() + 1))
 8      isolate(ghostTimer(ghostTimer() + 1))
 9      isolate(zombieTimer(zombieTimer() + 1))
10      isolate(move_monsters())
11    }
12  })

And the motion of Ghosts and Zombies is now controlled by the following snippets that check their corresponding clocks against their speeds.

 1 
 2    #ghosts move according to ghost speed
 3    if (ghostTimer() == ghost_speed()) {
 4      occupied_positions <- append(zombie_positions(),
 5                                   get_positions_nearby(maze = maze(),
 6                                                        this_position = player_position(),
 7                                                        radius = 1))
 8      ghost_positions(get_random_free_positions(
 9        maze = maze(), num = num_ghosts(), 
10        occupied_positions = occupied_positions))
11      ghost_moves(ghost_moves() +  1)
12     ghostTimer(0)
13    }

Ghosts still disappear and appear on free positions. I have changed their action radius so that now the player has to bump into them to trigger the shuffle.

 1 
 2    #zombies move according to zombie speed
 3    if (zombieTimer() == zombie_speed()) {
 4      zombie_positions(move_zombies(
 5        maze=maze(),
 6        zombie_positions = zombie_positions(),
 7        other_positions = append(ghost_positions(),zombie2_positions()), 
 8        player_position = player_position()))
 9      zombie2_positions(move_zombies(
10        maze=maze(),
11        zombie_positions = zombie2_positions(),
12        other_positions = append(ghost_positions(),zombie_positions()), 
13        player_position = player_position()))
14      zombie_moves(zombie_moves() +  1)
15      zombieTimer(0)
16    }

As before, the zombies move towards the player. Considering to limit the distance within which they can sense the player and be aware of her presence. They could stay still or move randomly till her presence is detected.

Image processing and resources

The R package magick for advanced image processing (Ooms (2023)) and the website OpenGameArt.Org have been a galvanizing discovery that has lead to this set of changes and finally moving away from emojis to images.

I came across some amazing 16x16 and 32x32 tiles for the mazes and sprites and a few transformations (crop, scale and animation) from the magick package got me the gifs to render a more dynamic scene.

basictiles.png

characters

1library(magick)
2
3tiles <- image_read("images/characters.png")
4char1 <- image_scale(image_crop(tiles,"16x16+48+48"),"32x32")
5char2 <- image_scale(image_crop(tiles,"16x16+64+48"),"32x32")
6char3 <- image_scale(image_crop(tiles,"16x16+80+48"),"32x32")
7char_ani <- image_animate(c(char1,char2,char3, char2), fps=4, loop=0, dispose="background")
8image_write(char_ani,"images/char.gif")

Player

1host1 <- image_scale(image_crop(tiles,"16x16+112+0"),"32x32")
2host3 <- image_scale(image_crop(tiles,"16x16+96+16"),"32x32")
3host5 <- image_scale(image_crop(tiles,"16x16+128+32"),"32x32")
4host_ani <- image_animate(c(host1,host3,host1,host5), fps=1, loop=0, dispose="background")
5image_write(host_ani,"images/hostage.gif")

Hostage

5ZombieSpriteSheet

1tiles <- image_read("images/5ZombieSpriteSheet.png")
2z1 <- image_scale(image_crop(tiles,"36x36+0"),"32x32")
3z2 <- image_scale(image_crop(tiles,"36x36+44"),"32x32")
4z3 <- image_scale(image_crop(tiles,"36x36+90"),"32x32")
5zombie_ani <- image_animate(c(z1,z2,z3), fps=4, dispose="background")
6image_write(zombie_ani, "images/zombie_down.gif")

Zombie

Similarly, the mazes have improved significantly. However, I keep the first person viewpoint. The player doesn’t turn, the wold spins around her but too fast to notice :D. I have to admit that in a 2D, topview game; it may not be the best fit but I want to push this still a bit further.

Level 9

New chapter (rescue mission)

The game is shaping itself into a horror survival plot, still working on it, aiming for a simple plot where puzzles, rescuing hostages and more collectables and monsters can easily fit in.

And more subtle changes

improved audios, the audio should now work in Safari as well.
finally same presentation in iphone and android.
coins as first collectable, not sure if they will stay though.
added some tests, tried testthat, not great as the game is not a package.
And a suprise if the player takes too long to rescue the hostages….

References

Ooms, Jeroen. 2023. Magick: Advanced Graphics and Image-Processing in r. https://CRAN.R-project.org/package=magick.

Wikipedia contributors. 2023. “Timekeeping in Games — Wikipedia, the Free Encyclopedia.” https://en.wikipedia.org/w/index.php?title=Timekeeping_in_games&oldid=1186332126.

R To trade or not to trade with Shitcoins and Memecoins (part 1)

Mon, 01 Jan 2024 00:00:00 +0000

Figure 1: Trade or not to Trade (Designed by Dooder / Freepik)

It took me long time to muster the motivation to write this post. I greedily dreamed of putting something together that would unveil the secret to crypto trading while amassing a fortune thank to my R skills. The title of the article would then be “How to get rich using R and how to get even richer talking about it” or the likes of that.

Well, it turned out to be a very different article.

In this series I will share what I had in mind and why it didn’t work. Perhaps, someone can shed some light on how to conduct a better analysis or more suitable tools for this purpose.

Sure, none of this is really new, but I will try to share as much detail as possible.

Trading what?

Shitcoins/Memecoins. These crypto-coins or tokens are highly volatile, risky, susceptible to market sentiment and manipulations. Their price is merely driven by hype and speculation and have no intrisic value whatsoever.

Strictly speaking, the terms do not mean exactly the same. But I use them interchangeably. In my opinion the difference is mostly subjective and, while working on this, I have become more and more skeptical about these coins so I have opted for calling them simply Shitcoins :|

Read the article Understanding Shitcoins and Memecoins for a clearer view on the differences.

Trading how?

Buy the Shitcoins before the prices go up and sell them before the prices go down. Voilà.

This strategy is called timing the market in the financial jargon. In this particular case the timing is event-based: some of the Shitcoins make it to well-known price-tracking websites where they are listed as “New Cryptocurrencies” and the working hypothesis goes as follows: the broader visibility to a large mass of greedy investors pumps up their prices as soon as they are listed only to fall shortly after. The Shitcoin price would then enter a new chapter where its evolution is no longer driven by the “listing” event but other factors.

Assumptions

The listing is the only event considered in this strategy and the expectation was that it would lead to profits even in a bearish market, as of the time of writing the many many … versions of this post. Simply put, the speculators and other bots cannot help doing their stuff, pumping up the price. So, even over a short period of time, the profits would make up for the eventual losses.

Rules and model

The trading strategy can be summarised in the following rules:

Be fast. Buy as soon as the Shitcoins are listed to beat other speculators and bots.
Don’t be greedy. Set a sell-limit: to execute a sale order as soon as the price rises above a desired price to take profit.
Be brave..to a point. Set a stop-loss: to execute a sale order as soon as the price falls below a desired price to limit the loss.
Do not linger. Set a time-limit: to execute a sale order regardless of the price after a certain period when the effect of the “listing” event has waned off. We are not informed traders, we do not really know what to do and we need to cash back whatever is left to buy new recently listed Shitcoins with the hope of having profits.

Figure 2: Assumptions and model

What happens after the purchase is framed by these parameters: sell-limit, stop-loss and time-limit; a purchase will always end up in a sale (if funds permit) due to one of them.

Thus, the possible outcomes of this strategy are as follows:

SALE PROFIT: the price reaches the sell-limit, defined as a % increase since the purchase.
SALE LOSS: the price reaches the stop-loss, defined as a % decrease since the purchase.
FORCED SALE PROFIT: the time since the purchase exceeds the time-limit resulting in a sale in profit, the price increased but not reached the sell-limit.
FORCED SALE LOSS: the time since the purchase exceeds the time-lmit resulting in a sale in loss, the price went down but not down enough to hit the stop-loss.

Which well-known price-tracking websites?

CoinMarketCap and CoinGecko were chosen due to the following reasons:

although their free APIs do not provide the list of new cryptos or not with sufficient detail, their websites are easy to scrape. Update: This is no longer the case for CoingGecko since the 8th of May.
they covered the Binance blockchain BNB Smart Chain (BSC) where I avail of a trader to put my buy and sell orders. In addition, Shitcoins abound in these parts, reportedly due to the low gas price compared to other blockchains.
they had earned a reputation of safe place (free of scams). I can confirm they have not lived up to the expectations, not at all.

WARNING

I am not encouraging to trade Shitcoins, quite the opposite. Please read the article(s) before drawing any conclusion.

DATA

Let’s have a quick look in to the data:

Newly listed tokens

Data scraped from the well-known price-tracking websites and enriched with other sources.

Coin: [String] Name of the Shitcoin.
Code: [String] Shortname of the Shitcoin.
Contract: [String] BSC contract id of the Shitcoin..
API_id: [String] Shitcoin identifier to be used in the API provided by the “source”.
Source: [String] Either CongGecko or CoinMarketCap.
Added_timestamp: [Timestamp] When the Shitcoin was discovered and added to the file.
Score: [Integer] Score provided by Token Sniffer - a smart contract scam scanner - at the time of discovery. Notes: -1 not found or token pending. -5 The score retrieval threw an error.
Botty_price: [Number] Price as retrieved by the trader Botty at the time of discovery.
IsPancakeSwapV2: [Boolean] Whether the Shitcoin is available in PancakeSwapV2. Implemented as an API call to Bitquery.io.

1NEW_TOKENS <- read_csv('data/NEW_LISTED_TOKENS.csv',)
2kable(head(NEW_TOKENS,5), caption = 'First 5 rows of newly listed tokens')

Table 1: First 5 rows of newly listed tokens
X1	Coin	Code	Contract	API_id	Source	Added_timestamp	Score	Botty_price	IsPancakeSwapV2
384	HoppyInu	HOPPYINU	0x2e7f28f0d27ffa238fdf7517a3bbe239b8189741	hoppyinu	CoinGecko	2023-02-26 06:02:17	-5
385	CEO	CEO	0x237ace23ab2c36a004aa5e4fb134fe5c1cedf06c	ceo	CoinGecko	2023-02-26 07:02:17	100	‘0.0001359185’	True
386	Crimson Network	CRIMSON	0x2ee8ca014fdab5f5d0436c866937d32ef97373b0	crimson-network	CoinGecko	2023-02-26 07:43:16	75	‘0.0000007451’	True
387	DogeArmy	DOGRMY	0xbf758f2afec32b92e8008b5671088d42af616515	dogearmy	CoinGecko	2023-02-26 07:49:16	55	‘0.0000000000’	True
388	SB Group	SBG	0x5E95A952a7f79f978585aFd54A053aF0f51372Fa	sb-group	CoinMarketCap	2023-02-26 18:38:14	5

Price history after the listing

Detailed price information is not always availble through the free APIs at those websites. Each new listed token was monitored by means of a third party solution capturing the following details approx. every 5 minutes and saved on its own CSV file “{added}-{code}-{contract}.csv”.

unixtime:[Integer] Unix_time of the price
usd_price: [Decimal] Price in USD
utility_price: [Decimal] Price in the paired token.
timestamp: [Datetime] Timestamp corresponding to the unixtime

 1to_datetime <- function(unixtime) {
 2  return(as_datetime(unixtime/1000))
 3}
 4token <- NEW_TOKENS  %>% filter(Code == 'CRIMSON')
 5
 6code <- token[['Code']]
 7contract <- token[['Contract']]
 8added <- format(date(token[['Added_timestamp']]),'%Y%m%d')
 9filename <- glue('{added}-{code}-{contract}.csv')
10log_info(glue('generating dataframe for {filename}'))
11  
12csv_file <- file.path('data',filename)
13hist <- read.csv(csv_file, header=T, stringsAsFactors = F)
14  
15df_raw_price <- hist %>% mutate(timestamp = to_datetime(unixtime))
16options(scipen=999)
17kable(head(df_raw_price,5), caption = 'First 5 rows of price history after the listing event')

Table 2: First 5 rows of price history after the listing event
X	unixtime	usd_price	utility_price	timestamp
1	1677412148120	0.0002639	0.0000009	2023-02-26 11:49:08
2	1677412248720	0.0002639	0.0000009	2023-02-26 11:50:48
3	1677412548300	0.0002764	0.0000009	2023-02-26 11:55:48
4	1677412848581	0.0002569	0.0000008	2023-02-26 12:00:48
5	1677413148784	0.0002604	0.0000009	2023-02-26 12:05:48

Next, I chart the price change respect to the price when the shitcoin is listed (named as “purchase_price” in the code as the token was immediately purchased as soon as listed) over time as a boxplot to get an idea of the distribution.

 1purchase_price <- hist$utility_price[1]
 2
 3df_price <- data.frame(
 4    timestamp = hist$unixtime,
 5    price = hist$utility_price,
 6    p_var = (hist$utility_price - purchase_price) * 100 / purchase_price
 7    , stringsAsFactors = F)
 8  
 9df_price <- df_price %>% mutate(timestamp = to_datetime(timestamp))
10plot1 <- plot_ly(x=df_price$timestamp, y=df_price$p_var, type='scatter', mode='lines', name=token[['Coin']])
11plot2 <- plot_ly(y=df_price$p_var, type='box',  name=glue('{token[['Code']]}'), showlegend=F) 
12plot <- subplot(plot1, plot2, shareY = TRUE, nrows=1, widths = c(0.9,0.1))
13plot

Early (probably wrong) conclusions

Reasons for optimism: ther are a few spikes after the listing event.
The volatility and change rate is higher than anticipated.
Shortly after the listing event, the effect wanes off.

Stay tuned, the journey has only begun.

Shiny Monster Maze

Tue, 24 Jan 2023 00:00:00 +0000

Shiny version for mobile

The eerie wails, the apparitions and other supernatural manifestations are an unlimited source for entertainment.

I could not just keep Monster Maze for myself and deprive you of such a joyful game. So I decided to bring it to you and the general public by the hand of Shiny, an R package that makes it easy to build interactive web apps straight from R.

The game is simple enough to be my first Shiny app and the idea of sharing it with you has been a strong motivation to explore and understand shiny and reactive programming beyond the initial examples.

Basically I found everything needed for the refactoring of the console-version of the game into a shiny browser-version in the online version of the book Mastering Shiny (Wickham and autor (2021)).

Below I share a recording on how the game looks on my Android smartphone.

But don’t be shy and give it a go https://ehermo.shinyapps.io/monster-maze-shiny/

Play here

Code

The code is publicly available in Github:

monster-maze-shiny-mobile Download

I kept it very simple, the code consists of the following files:

game/monster-maze-all.R: game logic including maze building, characters motion, collision detection, player’s view, ascii art…
.gitignore
app.R: Shiny UI, Server logic and reactive context.
monster-maze-shiny.Rproj: RStudio project

How to run it

If you want to run the code locally then you require RSudio.

Download and unzip the repo ( or clone it )
Open the project in RStudio double clicking on monster-maze-shiny.Rproj
In RStudio open the file app.R
Click on “Run App” above the file
Depending on your choice (Run in Window, Run in Viewer pane or Run External) the game will run in a window in RStudio, a detached Viewer pane or your default browser.

Shinyapps.io

I decided to host the game in Shinyapps.io, a platform as a service (PaaS) specialized in hosting Shiny web apps. Please, refer to this article to learn how to create a shinyapps.io account and deploy your first application to the cloud.

Shinyapps.io Free plan includes:

5 application
25 active hours/month (25 not idle)
community support

So, unless this post is a completely unexpected success, the free plan will do for now.

Next I share a number of solutions and findings I have encountered:

The paradigm shift: reactive programming

The main challenge is, of course, shifting from an imperative programming style - where you give a clear command, a step, and you have a clear idea when the command is carried out - its position in a larger sequence of steps - to a declarative one - where you describe the results and dependencies but delegate on something else to decide to what extent and when the instructions are put into action.

Figure 1: Paradigm shift

The diagram on the left is the game loop in the console version. The diagram was generated with PlantUML from the txt.

The thoughtful developer thanks to Image by jcomp on Freepik.

The diagram on the right is a simplification of the reactive graph used by the shiny version, where:

Game holds
- the lives
- the level
- the scene (intro, ghost encounter, zombie encounter, level passed, game over or you won) to display/play.
Level holds the details such as:
- maze: the walls and corridors as well as the exit.
- forward_vision: sight depth at the front.
- rear_vision: sight depth at the back.
- num_ghosts : number of ghosts in the level.
- num_zombies: number of zombies in the level.
- ghost_speed: ghost speed expressed as how many times the player moves before the ghost appears/disappears.
- zombie_speed : zombie speed expressed as how many times the player moves before the zombie moves.
- radius_to_exit: distance to the exit where the player starts at the beginning or every time the level resets.
Positions holds
- the player’s position in the maze.
- the player’s direction: which direction the player is looking at.
- the list of zombie positions in the maze.
- the list of ghost positions in the maze.
Counters holds
- ghost_moves: number of ghost’s moves in that level.
- player_moves_since_last_ghost_move: number of player’s moves since the last time a ghost moved.
- zombie_moves: number of zombie’s moves in that level.
- player_moves_since_last_zombie_move: number of player’s moves since the last time a zombie moved.
- player_moves: number of player’s moves in that level.

A detailed reactive graph can be generated by means of the R package reactlog (Schloerke (2022)). However, if you are new to reactive programming like I am, then I encourage you to start drawing a reactive graph after a few reads of the basics to start challenging your comprehension, even if some ideas have not really taken shape yet.

The figure 2 shows one of my first attempts to draw the graph to implement the equivalent to the game loop, it is mostly wrong, but I do believe it helped me to grasp a deeper understanding.

Figure 2: First attempts

How to initialize reactive values before any interaction with the user

The first question I faced that was not directly used by the tutorials and guides I consulted is “how do I initialize reactive values that are not set by any user input?”.

After a little big of digging I solved with an observeEvent that is triggered at the beginning and only once.

 1  # set the initial values 
 2  observeEvent(TRUE, ignoreNULL = FALSE, ignoreInit = FALSE, once = TRUE, {
 3      initial = shuffle(maze=maze(), 
 4                        num_ghosts=num_ghosts(), 
 5                        num_zombies = num_zombies(), 
 6                        radius_to_exit = radius_to_exit())
 7
 8      game_info$scene = "intro"
 9      player_direction(initial$player_direction)
10      player_position(initial$player_position)
11      ghost_positions(initial$ghost_positions)
12      zombie_positions(initial$zombie_positions)
13      console$data <- "** CLICK ANYWHERE TO PLAY THE AUDIO **
14  
1539 years have passed since 
16the unsettling events in that 
17creepy sort of place known as
18'Ghost Maze'.
19The yells and shouts haven’t 
20ceased ever since. But it has 
21only been recently when villagers
22have started to claim that
23something new has nested 
24and dwells inside those walls.
25"
26  })

Play sound on the browser side: Howler.js

The package beepr (Bååth (2018)) served me well in the console version to play basic sounds on any platform. In the browser version, however, the users are too far away from the server to hear a thing, the server may not even have speakers. So, the sound must be played on the browser side.

After a little bit or research I opted for the package howler (Baldry and Simpson (2022)) that enables the communication between the audio player on the browser side and the server and allows the latter to control the audio. I also resorted to the package shinyjs (Attali (2021)) to assist me with Javascript operations.

So it is as simple as importing the aforementioned packages.

1library(shiny)
2library("howler")
3library("shinyjs")

Adding the path to the beepr audio files as a resource path in order to reuse them.

1audio_files_dir <- system.file("sounds", package = "beepr")
2addResourcePath("sample_audio", audio_files_dir)
3audio_files <- file.path("sample_audio", list.files(audio_files_dir, ".wav$"))

Making sure the javascript files are imported when defining the UI. In the case of shinyjs you can simply use useShinyjs(), I could not find a similar way for howler so I just created a howler element. However, I initialise it with the dummy values, I defer that to a later point. Perhaps something to polish, advices are welcome in the comments.

 1# Define UI for application 
 2ui<- fluidPage(
 3  useShinyjs(),  
 4  howler(
 5    elementId = "sound", 
 6    tracks = list("Track 1" = "sample_audio/smb_stage_clear.wav"),
 7    auto_continue = FALSE,
 8    auto_loop = FALSE,
 9    seek_ping_rate = 1000
10  ),
11  ...

And finally, add the corresponding wav file to that particular scene when repainting the player’s view in the reactive expression.

 1players_view <- reactive({
 2    isolate(scene_to_play <- game_info$scene)
 3    if (scene_to_play != "") {
 4      scene <- scene_map$get(scene_to_play)
 5      sound <- scene$sound
 6      wav_file = sound$wav
 7      isolate(game_info$scene <- "")
 8      shinyjs::runjs(paste0("var music = new Howl({src: ['",wav_file,"']}); music.play();"))
 9      duration <- sound$duration
10      result <- div(pre(HTML(scene$ascii),style=scene$style),style="background-color:black;color:green;text-align=center;")
11      if(scene$invalidate) {
12        if(duration != 0 ) {
13          invalidateLater(duration * 1000 + 500)
14        }
15      }
16      return(result)
17    }

I was delighted to see how easy was to get the same files playing on the browser and on my phone.

However, the feeling diminished slightly as soon as I realized that the audio was not played correctly at the start on Chrome. Then I came to know that Chrome’s autoplay policies changed in April of 2018 in order to improve the user experience. Basically Autoplay with sound is allowed if the user has interacted with the domain (BeaufortDives (2017)). The issue was not observed on the Viewer pane in RStudio and at that point I had no intention to change the flow to force a user interaction before starting to play the game. Below I share the warning prompted on the Chrome console for your information.

1howler.min.js:2 The AudioContext was not allowed to start. It must be resumed (or created) after a user gesture on the page. https://goo.gl/7K7WLu

Monospace on Android Chrome

I could not get a monospace font working on Android Chrome. It seems that the issue has been around for a long time. It works smoothly on Desktop Chrome and Safari. The visual impact is tolerable and therefore I have not really invested a big deal of time. I tried different fonts but none of them work so I think the fix is something else. Online you can find more suggestions. Please leave me a comment if you know how to fix it.

The figure 3 shows the difference between a monospace font and a non-monospace.

Figure 3: Monospace v Non-monospace

Emojis

Again I rely heavily on Emojis to render the board and characters. I faced similar issues to those in the console version, with emojis overlapping or not rendering correctly when a particular emoji is in the proximity. In this case I did not resort to combination of invisible characters to separate them, a brittle solution I came up through trial-and-error in the console version, this time a simple HTML table resolved the issue, regrettably no without bringing a few of its own. Especially in terms of controlling the distance between cells, it sounds simple, doesn’t it? But Android Chrome and Safari do not render CSS exactly in the same way. Once more I had to settle for a compromise solution. Overall it is acceptable on both Android Chrome and Safari but not quite what I wanted.

The figure 4 shows the difference between an Android smartphone and an iPhone.

Figure 4: Android v iPhone

Final notes

The game is not responsive in that it does not resize, re-arrange accordingly to the device or orientation. I am also working on a desktop version with keyboard input and a different layout. Later I would like to check if Shiny is capable of merging both. I will keep you updated.

References

Attali, Dean. 2021. Shinyjs: Easily Improve the User Experience of Your Shiny Apps in Seconds. https://CRAN.R-project.org/package=shinyjs.

Bååth, Rasmus. 2018. Beepr: Easily Play Notification Sounds on Any Platform. https://CRAN.R-project.org/package=beepr.

Baldry, Ashley, and James Simpson. 2022. Howler: ’Shiny’ Extension of ’Howler.js’. https://CRAN.R-project.org/package=howler.

BeaufortDives, François. 2017. “Autoplay Policy in Chrome.” Chrome Developers. https://developer.chrome.com/blog/autoplay/.

Schloerke, Barret. 2022. Reactlog: Reactivity Visualizer for ’Shiny’. https://CRAN.R-project.org/package=reactlog.

Wickham, Hadley, and autor. 2021. Mastering Shiny: Build Interactive Apps, Reports, and Dashboards Powered by r. O’Reilly Media, Incorporated.

Special Halloween 2022 - Monster Maze

Thu, 20 Oct 2022 00:00:00 +0000

39 years have passed since the unsettling events in that creepy sort of place known as “Ghost Maze”. The yells and shouts haven’t ceased ever since. But it has only been recently when villagers have started to claim that something new has nested and dwells inside those walls.

The place is continously visited by fresh cohorts of reckless youngsters looking for ways to prove themselves and adrenaline junkies with a morbid fascination for anything supernatural. Most of them only make it to the door like playing the knick knack knock game. The few who have set foot on that unholy ground come out changed, having lost a part of themselves in the experience, eaten by fear and muttering under their breaths about a noise… a dragging of feet accompanied by a muffled sound, a yell coming from a soul in misery that cannot become airborne and dries in the throat.

When questioned for details, the people cover their eyes with their hands in an attempt to block the memory as it was just before them. Apparently this muted sound is more dreadful than the eerie wails that fill the desecrated rooms and corridors because, even if inaudible, it follows you around and carries a promise…“you will never leave”.

Since the Autumn equinox the paranormal activity around the place is spiraling upwards. Many believe of this to be an omen of something evil occurring in Halloween and others only see a business opportunity to siphon money out from the most gullible. However, an increasing number of fanatics, seized by horror and hysteria, presage that the Hellmouth is about to open right there to set the damned upon us.

I do not give myself much credit to such fantasies, but I cannot ignore the agitated state of mind of these people, completely unsuited to carry out any tasks on the terrain. So, I have decided to send you word of my whereabouts and plans in case these weirdos get me in trouble, because I am planning to get in tomorrow, take some samples from the basement and get out. Quick and clean :D

I am determined to prove once and for all that all the phenomena (screams, disorientation, visual and audible hallucinations…) are easily explained by a puncture in a natural gas reservoir very close to the surface beneath that horrible property.

Measures must be taken immediately to secure the area before we have to regret human losses again.

On my return I will share the creepy details with you over a pint or two.

Cheers

Seeking inspiration for a Halloween post I came across Peter Pravos’ Celebrate Halloween with Creepy Computer Games in R.

Following his example I decided to translate into R one of the other creepy games in the book Creepy Computer Games (Usborne, London). This book and many other wonders are available in the previous link. The book collection has been a completely unexpected discovery, I am really thankful to Peter for such an interesting series in his blog.

The books are richly coloured with beautiful illustrations everywhere. There is a big contrast between the illustrations and the simple graphics of the games in ZX Spectrum and BBC Micro. I was considering if the book was trying to compensate somehow, but now I just think that the same imagination that was powering the illustrations was also behind the graphics, so the contrast is due to the different degree of development of the the tools.

For this occasion I have selected “Ghost Maze” written by Colin Reynolds.

Figure 1: Fragment from Creepy Computer Games (Usborne, London)

I have never programmed on a Spectrum and spent a good time going through the codelines, I absolutely admire the efficiency and elegance of the code, the subroutines, the string manipulation to create and navigate the maze. I started translating the lines but half way I decided to do things differently, times have changed after all.

So, this game is not an accurate translation but it is strongly inspired by Ghost Maze.

How to run it

The code is publicly available in Github:

monster-maze-console Download

The game requires RStudio or Rscript.

MONOSPACE FONT

Make sure to choose a MONOSPACE font (like 'Courier', 'Monaco', 'Andale Mono', 'Lucida Console' or any other 'Mono' font) in your terminal/console.

Option 1: RStudio Console

Download and unzip the repo
Open the project in RStudio double clicking on monster-maze-console.Rproj
Source the file R/monster-maze-all.R
The game runs on the RStudio console
Move to the console to enter the input

Option 2: RStudio Console

In Github, copy the code from R/monster-maze-all.R
Open a new file in RStudio
Paste the contents
Source the new file
The game runs on the RStudio console
Move to the console to enter the input

Option 3: Terminal

Download and unzip the repo
Open a terminal
Run the command Rscript <path_to_the_unzipped_repo>/R/monster-maze-all.R

Game Basics

Next I explain some of the implementation decisions behind the game.

Mazes

First thing I opted for a matrix of integers to represent the maze rather than strings where:

0: represents the walls.
1: represents the corridors and rooms.
9: represents the exit.

The following code snippet shows the syntax used, the reason for this verbose approach is simply to have a matrix-like representation in the code that I could easily check while coding.

1maze1_data <-            c(0,0,0,0,0,0,0,0,0,0)
2maze1_data <- c(maze1_data,0,1,1,1,1,1,0,1,1,0)
3maze1_data <- c(maze1_data,0,0,1,0,0,1,1,1,0,0)
4maze1_data <- c(maze1_data,0,0,1,1,0,1,0,1,1,0)
5maze1_data <- c(maze1_data,0,1,1,0,1,0,0,1,0,0)
6maze1_data <- c(maze1_data,0,1,1,1,1,1,1,1,0,0)
7maze1_data <- c(maze1_data,0,0,0,0,0,0,0,9,0,0)
8maze1 = matrix(maze1_data,nrow=7,ncol=10,byrow=TRUE);

Extract the rooms and corridors positions from the maze

1require(invctr)
2CORRIDOR <- 1
3corridor_positions <- CORRIDOR %ai% maze1 # gets the indices for all CORRIDOR places in the maze

Table 1: Corridor positions
nv	row	col
1	2	2
1	5	2
1	6	2
1	2	3
1	3	3

Extract the exit position from the maze 🏆

1require(invctr)
2EXIT <- 9
3exit_position <- EXIT %ai% maze1 # gets the indeces for all CORRIDOR places in the maze

The steps so far has brought us from the plain matrix to the maze depicted in the figure 2. We have:

the underlying lattice in a matrix.
the corridors and rooms positions in a dataframe.
the exit position in a dataframe.

Figure 2: Maze showing walls, corridors, rooms and exit

Where the player starts 👤

After a few tests I decided to assign the player position randomly to any free corridor cell that is at least 4 cells away from the exit.

The distance between two position in the matrix is calculated accordingly to the following function.

1calc_distance <- function(position_1, position_2) {
2  row_distance <- abs(position_1$row - position_2$row)
3  col_distance <- abs(position_1$col - position_2$col)
4  distance <- row_distance + col_distance
5}

The figure 3 shows the distance of each cell in a corridor or room to the exit.

Figure 3: Maze with each cell showing the distance from the exit

As an example, in figure 4 the player has been placed in the position (row=4, col=3).

Figure 4: Player position in the maze

The player is simply tracked as a position and a direction (North, South, East, West). The latter will become clearer when I explain what the player sees.

Next is determining the positions of the other characters of the game, their initial positions are randomly selected from free cells, corridors and rooms that are not occupied by other characters and that are at least 2 cells away from the player (Figure 5) so that the player stands a chance of reaching the exit.

Figure 5: Distances from player

Ghosts 👻

appear and disappear at a constant speed.
only appear on corridor or rooms but they can walk through walls, the position must be a free position but does not need to be connected through a corridor to the previous.
do not pursue the player.
if the player looks aside and back, the ghost may disappear.
if a ghost materialises in a position at distance 1 of the player (front, back or either side) or the player bumps into it, then the player is whisked away to a new random position at least 4 cells from the exit, disoriented not knowing which direction is facing. In practice the game is reset but no life is taken.
From 0 to as many as you can fit in considering the player and the distance limit.

In the figure 6 2 ghosts are placed in positions (row=2, col=4) and (row=4,col=8).

Figure 6: Ghost positions

The ghost positions are tracked in a list of positions.

Zombies 🧟

move at a constant speed, usually slower than the player. However, zombies move awkwardly, they do not turn and can move in diagonal.
cannot walk through walls or other characters.
do pursue the player, getting closer and closer.
if a zombie grabs a player, it hurts the player, taking away 1 life before whisking her and resetting he game.
From 0 to as many as you can fit in considering the player, the ghosts and the distance limit.

In the figure 7 2 zombies are placed in positions (row=1, col=6) and (row=1,col=9).

Figure 7: Zombie positions

The zombie positions are tracked in a list of positions.

So, let’s recap the different elements we have so far.

the underlying lattice in a matrix.
the corridors and rooms positions in a dataframe.
the exit position in a dataframe.
the player as a position and a direction (North, South, East, West).
the ghosts as a list of positions, a constant speed, range of effect (distance=1).
the zombies as a list of positions, a constant speed, range of effect (distance=0).

What the player sees

What the player sees is determined by the maze (walls, corridors and exit), player position, player direction, ghost positions, zombie positions, forward vision, lateral vision (defined as half of the forward vision each side) and rear vision.

The steps followed in the game to render the player’s view are as follows:

a new matrix (meta_maze) is created with extra rows and columns around the maze to support the depth of the vision even if the player is on the border of the maze, the padding is made with walls.
the maze is copied in the meta_maze.
the ghosts are placed in the meta_maze using the list of ghost positions.
the zombies are placed in the met_maze using the list of zombie positions.
based on the player position, direction, and the depth of the vision (forward, rear, lateral) the area that is visible is determined. The figure shows the different areas according to the direction for (forward vision = 4, lateral vision = 1 and rear vision = 1).

Figure 8: Player’s view based on the direction

the direction is also used to determine how many times the view has to be rotated clockwise so that it is always facing North when presented.
the view is rotated using the following function

1rotate_clockwise <- function(x) {t( apply(x, 2, rev))}

Figure 9: Player’s view after rotating

the player position is set in the view.

Figure 10: Example of player’s view depending on the direction

Game loop (engine)

The game loop or engine is implemented simply as an infinite loop “while(T)” and certain conditions that break the loop. The diagram 11 shows the loop and the main activities (collisions, render, characters movements …) as well as the exit conditions (exit, quit, game over).

Figure 11: High level game loop

Console / Terminal

Below I mention some of the features in R I have stumbled upon and consider worth outlining.

Print / cat

Print doesn’t work on the terminal, the code uses only cat.

Clear Screen

The game is rendered by cleaning the terminal and re-printing it. Surprisingly the character to clear the screen in the terminal and the console are different. For that reason I used the following function (Code 2022).

1clear_screen <- function() {
2  if (interactive()) {
3    cat("\014") #or cat("\f")
4  } else {
5    cat("\33[2J")
6  }
7}

User Input

I had to resort to different code to capture the user input.

According to the documentation readLine in non-interactive use the result is as if the response was RETURN and the value is ““. I followed the recommended solution in stackoverflow: Make readline wait for input in R

1user_input <- function(prompt) {
2  if (interactive()) {
3    return(readline(prompt))
4  } else {
5    cat(prompt)
6    return(readLines("stdin", n=1))
7  }
8}

Emojis

I decided to use emojis rather the plain characters. And I think the result is very positive. However, emojis are not generally supported and the behaviour may vary from OS to OS. I have only tested the game in my personal Mac. And even in such a narrow scenario the terminal and the console behave differently, not printing the emojis as expectedly. I have partially overcome this issue but introducing a graph_sep, currently a combination of invisible characters that forces the emojis to be displayed correctly on the screen. Each invisible character works either on the console or the terminal.

An easier way to fix this is resorting to whitespace as graph_sep. The extra space between the emojis makes the maze less pleasant to the sight, at least so my taste is.

 1# Graph map
 2# https://invisible-characters.com/
 3graph_sep="\U17B5\U2063" # each invisible char works on a different terminal
 4graph_map <- dict()
 5# https://www.w3schools.com/charsets/ref_emoji.asp
 6graph_map$set(WALL,     list("block"=paste0("🏾",graph_sep),"desc"="wall")) 
 7graph_map$set(CORRIDOR, list("block"=paste0("🏻",graph_sep),"desc"="corridor"))
 8graph_map$set(GHOST,    list("block"=paste0("👻",graph_sep), "desc"="ghost" ))
 9graph_map$set(EXIT,     list("block"=paste0("🏆",graph_sep)  ,"desc"="exit"))
10graph_map$set(PLAYER,   list("block"=paste0("👤",graph_sep),"desc"="player"))
11graph_map$set(ZOMBIE,   list("block"=paste0("🧟",graph_sep),"desc"="zombie"))

Figure 12: Comparison between invisible character and whitespace

References

Code, Rosetta. 2022. “Terminal Control/Clear the Screen — Rosetta Code,” https://rosettacode.org/w/index.php?title=Terminal_control/Clear_the_screen&oldid=328572.

Desert crossing problem

Thu, 01 Sep 2022 00:00:00 +0000

This puzzle and its many variants have been around for over a millenium and is known by many names “desert crossing problem”, “jeep problem” and “exploration problem” among others. The first known written version of the puzzle appeared in a collection of recreational math problems back in the 9th century (Wikipedia contributors 2022). Apparently puzzles have been used by masters and mentors to train the mind of the youngsters and inflame their intelect since the dawn of human civilization.

And so shall we.

Initially, I didn’t hold it in very high regard, thought I got the solution a couple of times only to realise later that these first attempts did not stand further scrutiny. At that instant I totally fell for it. And the resulting exertion led, in the end, to a high sense of satisfaction and pride when I came out of it.

Context & Rules

3 explorers are stranded in the middle of the desert
They are 6 days march away from the nearest oasis
At the starting base they have 21 units of supplies, enough to sustain themselves for 7 days
Each explorer can carry at most 4 units of supplies.
To not starve, each explorer must eat 1 unit of supplies every day (every 24 hours)
The supplies can be left, collected, carried and consumed only in discrete amounts
No help from others
No other source of supplies but the oasis, where there are unlimited supplies

Clarifications about time

It took me a while to understand how the above rules define the time and the temporal relations between activities, so I share my conclusions here for your revision:

Time spent in any other activity but travelling can be ignored (such as sleeping, eating, toileting, collecting…).
In a sense, explorers’ motion is the clearest manifestation of the passage of time. Therefore to cover a distance of 1 day march, an entire day passes, and we know that the explorers must feed every single day.
Let the above sink for a second, if the explorers are 1 day march from the oasis and have no supplies, at the end of the day they will reach the oasis and die, not dine. The very instant the explorer steps on the oasis, the clock ticks 1 day and she is dead of starvation. Eating and collecting supplies do not take time, but they cannot eat before reaching the oasis because they have no supplies, and they cannot collect supplies simply because they are not there yet.

Puzzle

How can they all survive?

Anything not stated above is at your own discretion! Stay creative.

Below I share the solution I found. Please let me know in the comments if you find any other or a flaw in mine.

Have fun and remember “No explorer is left behind”.

Note

To add a responsive google slides on Hugo, check Add Responsive Google Slides on Hugo (Tiwari 2020)

References

Tiwari, Ashish. 2020. “Add Responsive Google Slides on Hugo.” 2020. https://ashish.one/blogs/add-responsive-google-slides-on-hugo/.

Wikipedia contributors. 2022. “Jeep Problem — Wikipedia, the Free Encyclopedia.” 2022. https://en.wikipedia.org/w/index.php?title=Jeep_problem&oldid=1104529631.

Turing machines and the busy beavers

Tue, 17 May 2022 00:00:00 +0000

For years I have been an avid reader of the Science website Naukas. The website is a carrier for online science popularization in Spanish. If you speak the language and love Science, I greatly encourage you to add it to your bookmarks.

In particular, I am a big (BIG) fan of Francis’ blog as well as Daniel’s blog that are part of the Naukas family.

I must admit that they have been an inspiration for the creation of this micro-blog. So, when I came across the article “Carnaval de Matemáticas: La función castor afanoso cumple 60 años” (Villatorio 2022) and the R code snippet of a Turing Machine simulator and a Busy Beaver, I couldn’t help but put together this small post and explore how to represent the Busy Beaver output using R.

Turing Machines

The Wikipedia (Wikipedia contributors 2022b) provides an excellent overview about the Turing Machines.

While some details may vary depending on the definition, basically, a Turing machine is an abstract machine - or theoretical model - consisting of :

An infinite tape divided into cells. Each cell contains a symbol from a finite alphabet.
A head that can read (scan) the symbol on the tape under the head or write a new symbol. The head can shift one cell at a time to either (L)eft or (R)ight.
A state register that stores the current state.
A table of instructions (states).

A new state is derived from the combination of the symbol in the tape and the current state, the machine runs till it reaches the state “H” (Halt).

Busy Beaver

Francis’ article (Villatorio 2022) is about Tibor Radó who discovered the Busy Beaver functions, a type of Turing machines, in 1962 (Rado 1962) and provides a brief context on the topic as well as the main references.

Below I bring over a simple description from Wikipedia to share some context.

… the busy beaver game consists of designing a halting Turing machine with alphabet {0,1} which writes the most 1s on the tape, using only a given set of states. The rules for the 2-state game are as follows:

the machine must have two states in addition to the halting state, and

the tape initially contains 0s only.(Wikipedia contributors 2022a)

The website Turing Machine Visualization is of great assistance in visualising Turing machines. Among others you can simulate and visualise a 3-state and 4-state Busy Beaver.

Next I share the code taken from Francis’ article with some minor changes.

 1## Turing Machine Simulator in R
 2## Based on Francis', in turn, based on Nick Drozd's code
 3##
 4## This 4-state busy beaver was proven by Allen Brady in 1983.
 5##
 6turing.string = '1RB 1LB 1LA 0LC 1RH 1LD 1RD 0RA'; 
 7M = 24; 
 8##
 9turing.vector = unlist(strsplit(turing.string,' '))
10turing.table = matrix(turing.vector,ncol=2,byrow=TRUE)
11colnames(turing.table)=c('0','1')
12rownames(turing.table)=toupper(letters[1:nrow(turing.table)])
13
14library(knitr)
15kable(t(turing.table), caption = 'Table of states (instructions) of 4-state 2-symbol Busy Beaver')

Table 1: 4-state 2-symbol Busy Beaver: Table of states (instructions)
	A	B	C	D
0	1RB	1LA	1RH	1RD
1	1LB	0LC	1LD	0RA

I have changed the code to generate a numeric matrix describing the tape for each step ,from top to bottom, untils the machine halts, the numbers in the matrix hold the following meanings:

0: symbol 0 in cell
1: symbo1 1 in cell
2: head on symbol 0 in cell
3: head on symbol 1 in cell

 1##
 2tape = rep(0,M); 
 3pos = M/2; 
 4state = 'A';
 5##
 6tape.print = tape;
 7tape.print[tape==0]=0; 
 8tape.print[tape==1]=1; 
 9tape.print = c(tape.print[1:(pos-1)],tape.print[pos] + 2 ,tape.print[(pos+1):M]);
10## 
11tape.matrix = matrix(tape.print,nrow=1);
12library(stringr)
13while (state != 'H') # H represents the Halt state
14{
15  SMS = turing.table[state, as.character(tape[pos])]; ## Symbol-Movement-State
16  tape[pos] = as.integer(substr(SMS,1,1));            ## write symbol in tape
17  pos = pos + switch(1+(substr(SMS,2,2)=='R'),-1,+1); ## move Right or Left
18  state = substr(SMS,3,3);
19  tape.print = tape; 
20  tape.print[tape==0]=0; 
21  tape.print[tape==1]=1; 
22  tape.print = c(tape.print[1:(pos-1)],tape.print[pos] + 2 ,tape.print[(pos+1):M]);
23  tape.matrix = rbind(tape.matrix,tape.print)
24}

Goal

Francis in his article raised a request for finding a better representation of the output of the 4-state 2-symbol Busy Beaver function.

In Wikipedia one comes across the following representation of a 3-state Busy Beaver (Commons 2021):

Figure 1: 3-state Busy Beaver. Black icons represent location and state of head; square colors represent 1s (orange) and 0s (white); time progresses vertically from the top until the HALT state at the bottom.

This figure is used as a model for the the representations in this post.

Using plot.matrix

Below represents the very first attempt using the library plot.matrix.

1#install.packages('plot.matrix')
2library('plot.matrix' )
3plot(tape.matrix ,col = c('white','orange','grey','red'), key=NULL,axis.col = NULL,  axis.row= NULL, xlab='Tape', ylab='Steps', border=NA,polygon.cell = NULL)

This has been very easy, however I have found it difficult to apply further changes.

Using plotly

The second and most successful attempt so far is using plotly (Sievert 2020).

The challenge is getting a discrete colorbar so that one discrete colour is assign to the possible cell values. The article shares the trick to get this precisely.

 1library(plotly)
 2library(dplyr)
 3
 4colorScale <- data.frame(z=c(0,0.25,
 5                             0.25,0.5,
 6                             0.5,0.75,
 7                             0.75,1
 8               ),col=c('white','white','orange','orange','gray','gray','red','red'))
 9colorScale$col <- as.character(colorScale$col)
10
11fig <- plot_ly(z = tape.matrix,
12               type = 'heatmap',
13               ygap=1,
14               xgap=1,
15               colorscale=colorScale ,
16               width=300, height=600)
17
18fig <- fig  %>% 
19  config(displayModeBar = FALSE, scrollZoom = FALSE) %>%
20  layout(plot_bgcolor='rgb(0,0,0)', 
21             autosize = F,
22             xaxis = list(
23               constrain='domain',
24               title='Tape',
25               ticks = '',
26               tickvals = '',
27               range=c(0,M -1)
28               ),
29             yaxis = list(
30               title='Step',
31               autorange = 'reversed',
32               scaleanchor = 'x',
33               scaleratio = 0.8,
34               tickmode = 'linear',
35               dtick = 1,
36               tickfont = list(size=8)
37               ),
38             showlegend = F) %>% 
39  colorbar(title = 'Tape cell',
40           len=0.2, 
41           dtick =1,
42           tickvals=c(0.5,1.25,2,2.75), 
43           ticktext=c(' 0 ',' 1 ','[0]','[1]')) 
44
45fig

So far, this approach has taken me closer to what I had in mind and within reasonable time. It hasn´t been easy or quick but I found the details I needed to move on.

Using ggplot2

And finally, ggplot2(Wickham 2016).

 1library(dplyr)
 2library(reshape2)
 3df <- as_data_frame(tape.matrix)
 4df <- df %>% mutate(step = as.integer(rownames(df)))
 5df1 <- melt(df, id.vars = 'step')
 6df1<- df1 %>% mutate(value = factor(value))
 7
 8fig3 <- ggplot(df1, aes(x = variable, y = step))  + 
 9  geom_tile(aes(fill = value),colour = 'black') + 
10  scale_y_reverse(breaks=seq(nrow(tape.matrix) - 1,0,-1)) +
11  coord_fixed(ratio=0.7) + 
12  xlab('Tape') + 
13  theme_minimal() +
14  theme(axis.text.x=element_blank(),axis.ticks.x=element_blank(), axis.text = element_text(size = 3),legend.text = element_text(size = 5),legend.title = element_text(size = 6)) + 
15  scale_x_discrete(breaks=NULL) + 
16  scale_fill_manual(values=c('white','orange','grey','red'),name = 'Tape cell', labels = c('0', '1', '[0]','[1]')) 
17fig3

With ggplot2 it took more less the same time to plot as plotly, however bear in mind that both do not deliver the same type of visulation. Preparing the data took definately longer.

References

Commons, Wikimedia. 2021. “File:busy Beaver 3 State.png — Wikimedia Commons, the Free Media Repository.” https://commons.wikimedia.org/w/index.php?title=File:Busy_Beaver_3_State.png&oldid=531671843.

Rado, T. 1962. “On Non-Computable Functions.” Bell System Technical Journal 41 (3): 877–84. https://doi.org/10.1002/j.1538-7305.1962.tb00480.x.

Sievert, Carson. 2020. Interactive Web-Based Data Visualization with r, Plotly, and Shiny. Chapman; Hall/CRC. https://plotly-r.com.

Villatorio, Francisco R. 2022. “Carnaval de Matemáticas: La Función Castor Afanoso Cumple 60 Años.” 2022. https://francis.naukas.com/2022/05/14/carnaval-de-matematicas-la-funcion-castor-afanoso-cumple-60-anos/.

Wickham, Hadley. 2016. Ggplot2: Elegant Graphics for Data Analysis. Springer-Verlag New York. https://ggplot2.tidyverse.org.

Wikipedia contributors. 2022a. “Busy Beaver — Wikipedia, the Free Encyclopedia.” https://en.wikipedia.org/w/index.php?title=Busy_beaver&oldid=1087004102.

———. 2022b. “Turing Machine — Wikipedia, the Free Encyclopedia.” https://en.wikipedia.org/w/index.php?title=Turing_machine&oldid=1087872127.

Daytime length variations with latitude and season (3/3)

Sun, 08 May 2022 00:00:00 +0000

It is time to conclude this series, but not before making some closing arguments.

Resolution

It is possible to increase the resolution of the plot by decreasing the length of the step for the different dimensions: latitude, longitude and days in the year. For instance, the values (lat_step = 5, lon_step = 1, year_step = 10) result in the following plot 1.

Points in the sphere (N) = num_lat_pts \(\times\) num_lon_pts = 1776
Days in the year = 37

Figure 1: Figure 1: Daylength by latitude and day in the year for ( lat_step = 5, lon_step = 1, year_step = 10)

Is there a better way of generating the grid?

While it is possible to smooth the contours by increasing the number of points in the grid at the expense of computation and rendering time, something struck me: the resolution around the poles is higher than at the Equator.

The number of points in each parallel is constant irrespective of the length of the parallel, being the Equator the largest parallel and the closer to the Poles, the shorter.

In the first post of this series the construction method of the grid is analogous to sampling the angles \(\theta\) [0,\(\pi\)] and \(\phi\) [0,\(2\pi\)] at equal distances as per the step parameters, lat_step and lon_step respectively. This results in a grid of a number of points equal to latitude points \(\times\) longitude points.

The figure 2 shows the points as a function of the angles \(\theta\) and \(\phi\) and then plotted on the unit sphere. While the points are equidistributed in the \(\phi\)-\(\theta\) plane, that is not the case on the unit sphere.

 1m <- list(
 2  l = 0,
 3  r = 0,
 4  b = 0,
 5  t = 0,
 6  pad = 4
 7)
 8
 9lat_step <- 5
10lat_pts <- seq(from =0, to = pi, by = pi/(180/lat_step))
11num_lat_pts <- length(lat_pts)
12lon_step <- 1
13lon_pts <- seq(from = 0, to = 2*pi, by = pi/24)
14num_lon_pts <- length(lon_pts)
15dfgridr <- data.frame(x = rep(lon_pts, num_lat_pts), y = rep(lat_pts, each=num_lon_pts))
16fig_rect <- plot_ly(width = 400)
17fig_rect <- fig_rect %>% add_trace(data = dfgridr, x = ~x , y = ~y ,type ='scatter', mode='markers', marker = list(size = 3))
18
19scene = list(camera = list(eye = list(x = 0, y = 2, z = 0))) 
20fig_sph <- plot_ly(width = 800)
21fig_sph <- fig_sph %>% add_trace(data = coor_lat_lon, x = coor_lat_lon[,'x'], y = coor_lat_lon[,'y'], z = coor_lat_lon[,'z'], type ='scatter3d', mode='markers', marker = list(size = 2))
22
23fig <- subplot(fig_rect, fig_sph, widths = c(0.4,0.5)) %>%
24  layout(title = 'Points distribution', scene = list(camera = list(eye = list(x = 0, y = 2, z = 0)), domain = list(x = c(0.5, 1), y = c(0,1))), showlegend = F) %>%
25  config(displayModeBar = FALSE, scrollZoom = FALSE)  %>%  
26  layout(xaxis = list(title = 'φ [0,2π]',
27                      zeroline = F,
28                      showgrid = F
29                     ),
30         yaxis = list(title = 'θ [0,π]',
31                      zeroline = F,
32                      showgrid = F))
33fig

Figure 2: Points distribution in φ-θ plane and on the unit sphere

Warning

There is a nasty issue in plotly subplot when rendering together 2D and 3D plots. Check 2d and 3d plots overlap when using 'subplot' #579 for a workaround

This raises the question of whether it is possible to distribute N points evenly on a sphere. A quick search online shows that there is extensive literature on this matter ((https://mathoverflow.net/users/10893/cpj), n.d.) (Simon 2015) (Markus Deserno 2004).

Two simple algorithms for this purpose are described in (Markus Deserno 2004). The “Regular placement” was selected over the “Random placement” as it is based on circles of latitude at constant intevals which simplifies the plotting. The chosen algorithm provides an approximated solution (not optimal) though, with the number of points placed close to N.

The following code chunk shows the implementation of the algorithm.

 1distEventlyOnSphereNOrSoPoints <- function (N) {
 2  eq_points <- vector(mode = 'list', length = N - 5) 
 3  count <- 0
 4  a <- 4*pi/N
 5  d <- sqrt(a)
 6  m_theta <- round(pi/d)
 7  d_theta = pi / m_theta
 8  d_phi = a/d_theta
 9  for (m in 0:(m_theta -1)) {
10    theta = pi*(m+0.5) / m_theta
11    m_phi = round ( 2 * pi* sin(theta)/d_phi)
12    for (n in 0:(m_phi -1)) {
13      phi = 2*pi*n / m_phi
14      count <- count + 1
15      eq_points[[count]] <- matrix(c(sin(theta)*cos(phi), sin(theta)* sin(phi), cos(theta), theta, phi, log(tan(pi/4 + (pi/2 - theta)/2))), 1)
16    }
17  }
18  return(eq_points)
19}

As the number of points is not known in advance the list is pre-allocated with N - 5. For each point the algorithm calculates x, y ,z, \(\theta\), \(\phi\), y_mercator_proj.

 1N <- num_lat_pts * num_lon_pts
 2eq_points <- distEventlyOnSphereNOrSoPoints(N)
 3
 4eq_mat <- matrix(unlist(eq_points),nrow=length(eq_points), byrow=TRUE)
 5eq_df <- data.frame(x=eq_mat[,1], y= eq_mat[,2], z=eq_mat[,3], theta=eq_mat[,4], phi=eq_mat[,5], x_mercator_proj=eq_mat[,5], y_mercator_proj=eq_mat[,6])
 6
 7fig_sph2 <- plot_ly(data=eq_df, x=~x,y=~y,z=~z, type='scatter3d',mode='markers',  marker = list(size = 2), width = 800)
 8
 9fig_rect2 <- plot_ly(width = 400)
10fig_rect2 <- fig_rect2 %>% add_trace(data = eq_df, x = ~phi , y = ~theta ,type ='scatter', mode='markers', marker = list(size = 3))
11fig_rect2 <- fig_rect2 
12
13fig2 <- subplot(fig_rect2, fig_sph2) %>%
14  layout(title = 'Points distribution', scene = list(camera = list(eye = list(x = 0, y = 2, z = 0)),domain = list(x = c(0.5, 1), y = c(0,1))), showlegend = F)  %>%
15  config(displayModeBar = FALSE, scrollZoom = FALSE) %>%  layout(
16        xaxis = list(title = 'φ [0,2π]',
17                      zeroline = F,
18                      showgrid = F
19                     ),
20         yaxis = list(title = 'θ [0,π]',
21                      zeroline = F,
22                      showgrid = F))
23fig2

Figure 3: Points distribution in φ-θ plane and on a unit sphere

A simple fuction is implemented to calculate the latitude in degrees [-90,90] from \(\theta\) [0,\(\pi\)].

1toLatitude <- function(theta) {
2  
3  latitude <- round(sin(pi/2 - theta) * 90,0)
4  return(latitude)
5}

And once we have the new grid, the code presented in the previous posts can be used to:

Tilt the rotational axis

1coor_eq_tilt <- t(rot_tilt_x %*% t(data.matrix(eq_df[1:3])))
2colnames(coor_eq_tilt) <- c('x', 'y', 'z')
3scene = list(camera = list(eye = list(x = -2, y = 0, z = 0)))
4fig_eq_tilt <- plot_ly() %>% config(displayModeBar = FALSE,  scrollZoom = FALSE)
5fig_eq_tilt <- fig_eq_tilt %>% add_trace(data = coor_eq_tilt, x = coor_eq_tilt[,'x'], y = coor_eq_tilt[,'y'], z = coor_eq_tilt[,'z'], type ='scatter3d', mode='markers', marker = list(size = 2)) %>% layout(scene = scene)
6fig_eq_tilt

Figure 4: Tilted axis

Calculate the relative orientation towards the Sun on different days of the year

 1df2 <- data.frame()
 2list_of_df2_i <- vector(mode = 'list', length = num_year_pts) 
 3rot_year_acc <- rot_year_offset
 4for (i_day in 1:num_year_pts) {
 5    coor_eq_tilt_year <- t( rot_year_acc %*% t(coor_eq_tilt))
 6    rot_year_acc <-  rot_year %*% rot_year_acc
 7    dim(coor_eq_tilt_year)
 8    colnames( coor_eq_tilt_year) <- c('xp', 'yp', 'zp')
 9    list_of_df2_i[[i_day]] <- data.frame(xp=coor_eq_tilt_year[,'xp'], yp=coor_eq_tilt_year[,'yp'], zp=coor_eq_tilt_year[,'zp'],  day =  rep(year_pts[i_day], nrow(coor_eq_tilt_year)), theta =  eq_df$theta)
10    
11}
12df2 <- rbindlist(list_of_df2_i)

Calculate the daytime

Now the number of points on each parallel is no longer constant. When calculating the daylight hours the number of points on each parallel can be easily calculated in the summarize using n().

1df2 <- df2 %>% mutate(latitude = toLatitude(theta))
2df2 <- df2%>% mutate(daynight = is_day_or_night(yp))
3hdnl2 <- df2 %>% group_by(latitude, day) %>% summarize(day_hours = round(sum(daynight == 'day')  * 24 / n(),1))
4cast_hdnl2 <- acast(hdnl2, latitude~day, value.var ='day_hours' )

Plot the daytime / nighttime

 1figcon2 <- plot_ly(width = 900, height = 650, z= cast_hdnl2, type='contour',
 2                  autocontour = F,
 3                  colors = viridis_pal(direction = 1, option = 'cividis')(16),
 4                  contours = list(
 5                    start =1,
 6                    end =  24,
 7                    size = 1,
 8                    showlabels = TRUE
 9                  ),
10                  line = list(smoothing = 1)
11                  )  %>%  config(displayModeBar = FALSE, scrollZoom = FALSE)
12figcon2 <- figcon2 %>% colorbar(title = '# daylight hours',  orientation = 'h', x = 0.5, y = -0.2 )
13
14n_lat <- length(unique(hdnl2$latitude))
15labels <- rep('', n_lat)
16labels[seq(1,n_lat,1)] <-unique(hdnl2$latitude)[seq(1,n_lat,1)]
17labels <- as.character(labels)
18
19figcon2 <- figcon2 %>%
20  layout(
21        yaxis = list (
22            tickvals = seq( from = 0, to = (n_lat - 1) , by  = 1),
23            ticktext = labels,
24            title = 'Latitude'
25        ),
26           xaxis = list (
27             tickvals = seq( from = 0, to = (num_year_pts - 1) , by  = 1),
28             ticktext = colnames(cast_hdnl),
29            title = 'Day in the year'
30        ),
31        margin = m
32      )
33figcon2

Figure 5: Daylength by latitude and day in the year for (N = 1776)

This plot has an even resolution, however I have to admit it doesn´t look prettier.

The figure 6 shows a plot with a much higher resolution N = 20000 that looks much better.

Figure 6: Figure 6: Daylength by latitude and day in the year ( N = 20000 , year_step = 10)

What have I achieved?

Visuals

The inspiration for this series came after a short dicussion on how an Equinox manifests itself. A quick search in Wikipedia brought me to the below figure 7 that dispelled all my doubts … or almost.

In fairness, I was slightly wrong. So, in order to restore my wounded pride, I decided to build my own plot, step by step, starting from the fact that I knew that the tilt of the rotational axis was the cause behind.

Figure 7: Figure 7: Cmglee, CC BY-SA 3.0 https://creativecommons.org/licenses/by-sa/3.0, via Wikimedia Commons

In addition, I have included as much visual support (figures, tables) as possible so that it can be easily followed.

This objective has been achieved (and my pride restored).

Code

Special care has been given to the code snippets presented in these posts. It took longer than expected and I still feel a little bit rusty but, overall, I am satisfied with the results and these posts represent the standards of whatever I produce next. Of course, secretly I am aiming to lift the standards over time.

Please feel free to criticise or suggest alternatives in the comments. I think I can handle some criticism…

The tables and most of the figures are generated at “compilation time” from the Rmd file.

Again found an issue with rmarkdown support, in particular with the styling of the code. I followed the workaround proposed by albersonmiranda in this thread that allows to render the code nicely but requires duplicating the code: one chunk for rendering and other chunk for running.

This objective has been achieved.

Maths

Extra effort has been also made so that this blog supports Mathjax (Cervone 2012). Formulas and mathematical expressions are used when appropriate. However, I refrain from copying mathematical formulas that I do not understand to some extent.

This objective has been achieved.

Give credit when due

This is a work in progress. I am a usual Wikipedia reader. In fact, I think Wikipedia is one of the most ambitious and greatest collective projects of the mankind. And - as you may have noticed - I use it profusely as a source and frequently cite its articles, when I probably shouldn’t be citing Wikipedia but extending my research to the sources and cite the final point of reference (Wikipedia contributors 2022).

References

Cervone, Davide. 2012. “MathJax: A Platform for Mathematics on the Web.” Notices of the AMS 59 (2): 312–16.

(https://mathoverflow.net/users/10893/cpj), CPJ. n.d. “Distributing Points Evenly on a Sphere.” MathOverflow. https://mathoverflow.net/q/212550.

Markus Deserno. 2004. “How to Generate Equidistributed Points on the Surface of a Sphere”.” 2004. https://www.cmu.edu/biolphys/deserno/pdf/sphere_equi.pdf.

Simon, Cory. 2015. “Generating Uniformly Distributed Numbers on a Sphere.” Mathemathinking. http://corysimon.github.io/articles/uniformdistn-on-sphere/.

Wikipedia contributors. 2022. “Wikipedia:citing Wikipedia — Wikipedia, the Free Encyclopedia.” https://en.wikipedia.org/w/index.php?title=Wikipedia:Citing_Wikipedia&oldid=1074620051.

Daytime length variations with latitude and season (2/3)

Thu, 21 Apr 2022 00:00:00 +0000

In the previous post of this series:

a simple grid consisting of points on the surface of a sphere was built step by step to approximate Earth.
the basics of matrix rotations were reviewed to obtain:
- the tilt of the rotational axis.
- the changes in the orientation of the tilt relative to the Sun as Earth revolves around it over the year.

The closing figure in the first post is copied here as it summarizes visually all the relevant results and describes the starting point on top of which this post will build the calculation of the daytime by latitude througthout the year. This post will also cover how to prepare the data so that it can be easily plotted.

Figure 1: Orientation of the rotational axis relative to the Sun over a year

Daytime calculation

As already anticipated, the simple model that emerges from approximating Earth as a sphere, the Earth’s orbit around the Sun as a circumference and sunlight as parallel, simplifies by a great deal the calculation of the daytime.

At any time, half of the Earth is illuminated by the Sun and the other half is at night. During a day (24 hours), every point completes a rotation around the tilted axis, subject to experience the daynight cycle. It is beyond the scope of this model to calculate the location of a point at a particular time, meaning whether a point at a given latitude is on the illuminated area or not at a specific time. For this reason, how the surface is splitted in two halves (bright and dark) is irrelevant as long as the plane cutting the sphere in half is perpedincular to the Earth’s orbit and the sunlight. For simplicity’s sake, all points laying on the negative y-axis are considered illuminated and the those laying on the positive at dark.

The following function determines whether it is day or night based on the y-coordinate.

1is_day_or_night <- function(y) {
2    daynight <- y < 0 
3    daynight[daynight] <- 'day'
4    daynight[daynight==FALSE] <- 'night'
5    return(daynight)
6}

Now, the revolution of Earth around the Sun results in changes in the orientation of the tilted axis. These changes impact on how long the points at different latitudes are on the illuminated or the dark half as Earth spins about its axis.

The function is applied to each point in the grid. The grid comprises all the points representing the Earth’s surface (latitude, longitude) on different days in the year. There are as many spheres as days are used to sample the Earth’s orbit around the Sun.

1library(knitr)
2df <- df %>% mutate(daynight = is_day_or_night(yp))
3kable(head(df,5), caption = 'First 5 rows of the grid of points and measures')

Table 1: First 5 rows of the grid of points and measures
xp	yp	zp	lon_pt	day	latitude	daynight
0.0512145	-0.3944778	-0.9174771	1	1	-90	day
0.0512145	-0.3944778	-0.9174771	2	1	-90	day
0.0512145	-0.3944778	-0.9174771	3	1	-90	day
0.0512145	-0.3944778	-0.9174771	4	1	-90	day
0.0512145	-0.3944778	-0.9174771	5	1	-90	day

Note

An offset was added in the previous post so that the relative orientation on the day 1 coincides with the orientation on January 1st, winter in the northern hemisphere. As a result, the North Pole is away from the Sun.

1scene = list(camera = list(eye = list(x = 2, y = 0, z = 0)))
2fig3d <- plot_ly() %>%  config(displayModeBar = FALSE, scrollZoom = FALSE)
3fig3d <- fig3d %>% add_trace(data = df, x = ~xp, y = ~yp, z = ~zp, frame = ~ day,  color =~ daynight,type ='scatter3d', mode='markers', size=1, colors = c('#FFEA46FF','#00204DFF') ) %>% layout(scene = scene)
4fig3d

Figure 2: Bright and dark halves due to the orientation of the tilted axis over a year

Assuming that the change in the Earth’s orbit in 24 hours is negligible when compared to the rotation about its axis over the same time, then the calculation can be simplified even further by taking a snapshot at any time on a given day and count how many points at each latitude are illuminated and how many points are not.

The total number of points at a particular latitude corresponds to a 24-hour cycle. The proportion of points on the illuminated area represent the daytime and the proportion of points on the dark area, the nightime. For any given latitude, daytime and nightime always add up to 24 hours.

The following code groups the points by latitude and day in the year, counts the number of points that are “day” and turns the count into the number of daylight hours.

1hdnl <- df %>% group_by(latitude, day) %>% summarize(day_hours = (sum(daynight == 'day')  * 24 / num_lon_pts))

Table 2: First 5 rows of daylight hours by latitude and day in the year
latitude	day	day_hours
-90	1	24
-90	16	24
-90	31	24
-90	46	24
-90	61	24

Data preparation

Now the calculations are complete and it is just a matter of reshaping the data so that the daytime can be easily plotted by latitude and day in the year.

From the previous table 2 with columns (latitude, day, day_hour), the data are casted into a table 3 with a row for each latitude and a column for each day representing the axis orientation in Earth’s orbit around the Sun with value, the number of daylight hours on that day.

1cast_hdnl <- acast(hdnl, latitude~day, value.var ='day_hours' )
2kable(head(cast_hdnl,5), caption = 'First 3 rows of casted daylight hours by latitude and day in the year')

Table 3: First 3 rows of casted daylight hours by latitude and day in the year
	1	16	31	46	61	76	91	106	121	136	151	166	181	196	211	226	241	256	271	286	301	316	331	346	361
-90	24.0	24.0	24.0	24.0	24.0	24.0	0.0	0	0.0	0.0	0	0	0.0	0.0	0.0	0.0	0.0	0.0	24.0	24.0	24	24.0	24.0	24.0	24.0
-80	24.0	24.0	24.0	24.0	20.5	14.5	10.0	5	0.0	0.0	0	0	0.0	0.0	0.0	0.0	0.0	8.5	13.0	18.0	24	24.0	24.0	24.0	24.0
-70	24.0	24.0	21.0	18.0	15.5	13.5	11.0	9	6.5	4.0	0	0	0.0	0.0	2.5	5.5	8.0	10.5	12.5	15.0	17	19.5	24.0	24.0	24.0
-60	18.5	17.5	16.5	15.5	14.5	12.5	11.5	10	9.0	7.5	6	6	5.5	6.0	7.0	8.5	9.5	11.0	12.0	13.5	15	16.5	17.5	18.5	18.5
-50	16.5	15.5	15.0	14.5	13.5	12.5	11.5	11	10.0	9.0	8	8	8.0	8.5	8.5	9.5	10.5	11.0	12.0	13.0	14	14.5	15.5	16.0	16.0

Daytime visualisation

The 3 dimensions (latitude, day and day_hours) are represented in a countour plot using plotly (Sievert 2020).

The latitude is represented in the y-axis, the day in the x-axis and the day_hours are represented by the slices coloured according to their value.

 1m <- list(
 2  l = 0,
 3  r = 0,
 4  b = 0,
 5  t = 0,
 6  pad = 4
 7)
 8
 9figcon <- plot_ly(width = 900, height = 700, z= cast_hdnl, type='contour',
10                  autocontour = F,
11                  colors = viridis_pal(direction = 1, option = 'cividis')(16),
12                  contours = list(
13                    start =1,
14                    end =  24,
15                    size = 1,
16                    showlabels = TRUE
17                  ),
18                  line = list(smoothing = 0.85)
19                  )  %>%  config(displayModeBar = FALSE, scrollZoom = FALSE)
20figcon <- figcon %>% colorbar(title = '# daylight hours')
21labels <- lat_pts
22labels[labels %% 10 != 0] <- ''
23labels <- as.character(labels)
24figcon <- figcon %>%
25  layout(
26        yaxis = list (
27            tickvals = seq( from = 0, to = (num_lat_pts - 1) , by  = 1),
28            ticktext = labels,
29            title = 'Latitude'
30        ),
31           xaxis = list (
32             tickvals = seq( from = 0, to = (num_year_pts - 1) , by  = 1),
33             ticktext = colnames(cast_hdnl),
34            title = 'Day in the year'
35        )
36      )
37figcon <- figcon %>% layout(margin = m)
38figcon

Figure 3: Daylength by latitude and day in the year (lat_step = 10, lon_step =1, year_step = 15)

The contour plot allows to quickly recognise a few well-known facts:

The 6-month daynight cicle on both poles. For the North Pole, 6-month night in Winter and 6 month-day in Summer. In the South Pole the other way around. This is the cause of a breathtaking sight, the midnight sun (Wikipedia, n.d.).
The day- and nighttime at the Equator are approx. 12 hours throughout the year.
In the Spring and Autumn equinoxes, the day- and nighttime are approx. 12 hours at any latitude on Earth.

References

Sievert, Carson. 2020. Interactive Web-Based Data Visualization with r, Plotly, and Shiny. Chapman; Hall/CRC. https://plotly-r.com.

Wikipedia. n.d. “Midnight Sun.” https://en.wikipedia.org/wiki/Midnight_sun.